Thursday, 13 December 2012

Capturing console output with Delphi 2010/XE (revised)

Following my previous post (Capturing console output with Delphi 2010/XE) and with all the great comments received on it, I have decided to publish the new solution provided by Lübbe Onken which solves the hanging issue when capturing the output for different kind of commands like ping, netstat, etc. The problem occurs on the last ReadFile which this solution will fix.
Here I'm summarizing Lübbe Onken comments on this issue:
"The current implementation assumes that if the external process is not finished yet, there must be something available to be read from the read pipe. This is not necessarily the case. If we use PeekNamedPipe to check for available data before entering the internal repeat loop, everything is fine.
I also put the CloseHandle into try ... finally and moved Application.ProcessMessages behind the internal read loop, because IMHO the screen update is better handled after processing the callback than before. But this is just cosmetic."

Here you can find the source code:
//Anonymous procedure approach by Lars Fosdal
type
    TArg<T> = reference to procedure(const Arg: T);

procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
const
  CReadBuffer = 2400;
var
  saSecurity: TSecurityAttributes;
  hRead: THandle;
  hWrite: THandle;
  suiStartup: TStartupInfo;
  piProcess: TProcessInformation;
  pBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dRead: DWORD;
  dRunning: DWORD;
  dAvailable: DWORD;
begin
  saSecurity.nLength := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle := true;
  saSecurity.lpSecurityDescriptor := nil;
  if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
      FillChar(suiStartup, SizeOf(TStartupInfo), #0);
      suiStartup.cb := SizeOf(TStartupInfo);
      suiStartup.hStdInput := hRead;
      suiStartup.hStdOutput := hWrite;
      suiStartup.hStdError := hWrite;
      suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      suiStartup.wShowWindow := SW_HIDE;
      if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity, @saSecurity, true, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup,
        piProcess) then
        try
          repeat
            dRunning := WaitForSingleObject(piProcess.hProcess, 100);
            PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
            if (dAvailable > 0) then
              repeat
                dRead := 0;
                ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
                pBuffer[dRead] := #0;
                OemToCharA(pBuffer, dBuffer);
                CallBack(dBuffer);
              until (dRead < CReadBuffer);
            Application.ProcessMessages;
          until (dRunning <> WAIT_TIMEOUT);
        finally
          CloseHandle(piProcess.hProcess);
          CloseHandle(piProcess.hThread);
        end;
    finally
      CloseHandle(hRead);
      CloseHandle(hWrite);
    end;
end;


usage:
    CaptureConsoleOutput('java -version', '', 
                procedure(const Line: PAnsiChar) 
                begin
                    Memo1.Lines.Add(String(Line)); 
                end
     );

I want to say thanks to everyone who spend time looking at this issue and for making the community work and grow.
Jordi

41 comments:

  1. Very interesting, thank you.
    Now a related question: how to interrupt long tasks that are being captured from console?
    i.e. say I want to interrupt traceroute www.google.com after the first few hops?

    ReplyDelete
    Replies
    1. Hi Fabio,

      Just add a boolean variable on the repeat to exit it:
      until (dRunning <> WAIT_TIMEOUT) or breakLoop;

      This will help you break the loop.

      Jordi

      Delete
  2. Replies
    1. You're welcome!. Thanks for your comments.

      Delete
  3. Finally I found working example. Thank you!

    ReplyDelete
  4. Thank you! Been looking for exactly this example. Tried a number of different console capture examples, some hanging as mentioned. None worked for use with the FireBird console app, GFIX. Works beautifully. For anyone else wanting to apply it to GFIX, just remember to disconnect from the database before running GFIX.
    Chuck Belanger

    ReplyDelete
    Replies
    1. You're welcome Charles. Great that it is useful!!
      Jordi

      Delete
  5. that's really interesting, with a smart way!
    I just receive this error:
    "ERROR: The target system must be running a 32 bit OS."
    (running XE on WIN7 x64)
    ...is there a way to solve it... or is it impossible?

    ReplyDelete
    Replies
    1. Hi Filippo,

      I can't get this error and I'm running it under Windows 7 64 bits as well.
      What are you trying to execute in the command line?

      Jordi

      Delete
  6. hola, supongamos que tengo que enviar un ctrl+c para cancelar la accion de algun programa, como lo podria hacer?
    saludos

    ReplyDelete
    Replies
    1. Hola,

      Si miras en los comenarios defino un breakLoop. Puedes marcarlo como true si pulsas las teclas cntrl+c y tener asi mas control en tu aplicación.
      Jordi

      Delete
  7. Thanks Jordi,
    it's definitively an interesting way!
    Does it functions under delphi 2007?

    ReplyDelete
    Replies
    1. Hi,

      It should work, but you will have to test it.
      The section that uses generics and anonymous methods won't work though.
      Jordi

      Delete
  8. hey, im usin it for ffmpeg and after ~10 minutes it crashes. Any idea?

    ReplyDelete
    Replies
    1. Hi, Could it be the ffmpeg is doing something else behind the scene? I have used this approach for batch files running multiple applications lasting for 40 min and it works like a charm. Never had any issue.
      Do you get any sort of error?

      Post it here and we'll have a look.

      Jordi

      Delete
  9. Hello,
    What a shame I so not know how to use it. Should I trat it as a component or prepere component somehow or maybe I shoulf just add it to my code in unit1(form 1)? Sorry for that, I am starting, but It would solve all my problems.
    Anja

    ReplyDelete
    Replies
    1. Hi Anja,

      Just put it in a form and run it.

      Jordi

      Delete
    2. Thank you for help, but one more question. Does it communicate with console or just capture the output. I mean do I need to prepare any connection with the console? Why in usage there is 'java -version'?
      Anja

      Delete
    3. Hi Anja,

      The methode creates a pipe with the console, so it captures everything is being dumped. You don't have to prepare anything, the method is sorting all those things for you. I'm using java -version because this command displays values in the console. Just type in your cmd -> java -version and you should get something similar to:

      java version "1.7.0_05"
      Java(TM) SE Runtime Environment (build 1.7.0_05-b05)
      Java HotSpot(TM) 64-Bit Server VM (build 23.1-b03, mixed mode)

      etc.

      I hope this sorts your issues.

      Jordi

      Delete
  10. I have already tried something like this. It is only a trying, cause I'd like to delete DosCommand in my original project and reprece it with this solution. Unfortunetelly nothing works. I do not know why, I am sure that I did something wrong. Could you take a look, please? It is a new project to text it(and also does not work):
    Source code:

    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls;

    type
    TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg);

    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    //Anonymous procedure approach by Lars Fosdal
    type
    TArg = reference to procedure(const Arg: T);

    procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg);
    const
    CReadBuffer = 2400;
    var
    saSecurity: TSecurityAttributes;
    hRead: THandle;
    hWrite: THandle;
    suiStartup: TStartupInfo;
    piProcess: TProcessInformation;
    pBuffer: array [0 .. CReadBuffer] of AnsiChar;
    dBuffer: array [0 .. CReadBuffer] of AnsiChar;
    dRead: DWORD;
    dRunning: DWORD;
    dAvailable: DWORD;
    begin
    saSecurity.nLength := SizeOf(TSecurityAttributes);
    saSecurity.bInheritHandle := true;
    saSecurity.lpSecurityDescriptor := nil;
    if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
    FillChar(suiStartup, SizeOf(TStartupInfo), #0);
    suiStartup.cb := SizeOf(TStartupInfo);
    suiStartup.hStdInput := hRead;
    suiStartup.hStdOutput := hWrite;
    suiStartup.hStdError := hWrite;
    suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    suiStartup.wShowWindow := SW_HIDE;
    if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity, @saSecurity, true, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup,
    piProcess) then
    try
    repeat
    dRunning := WaitForSingleObject(piProcess.hProcess, 100);
    PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
    if (dAvailable > 0) then
    repeat
    dRead := 0;
    ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
    pBuffer[dRead] := #0;
    OemToCharA(pBuffer, dBuffer);
    CallBack(dBuffer);
    until (dRead < CReadBuffer);
    Application.ProcessMessages;
    until (dRunning <> WAIT_TIMEOUT);
    finally
    CloseHandle(piProcess.hProcess);
    CloseHandle(piProcess.hThread);
    end;
    finally
    CloseHandle(hRead);
    CloseHandle(hWrite);
    end;
    end;


    procedure TForm1.Button1Click(Sender: TObject);
    begin
    CaptureConsoleOutput('java -version', TEdit1.Text,
    procedure(const Line: PAnsiChar)
    begin
    Memo1.Lines.Add(String(Line));
    end
    );
    end;

    end.


    ReplyDelete
    Replies
    1. Hi Anja,

      Everything looks OK. What version of delphi are you using? Check with other comments. Instead of typing java -version, try typing any other command you want to display in the memo.

      Regards,
      Jordi

      Delete
    2. Hello,
      first of all thank you for helping me. I am using delphi 2010. To be clear Embarcadero RAD Studio 2010. Previously I used Delphi 2007 and it is an environment I know much better. The problem as far as I can see is with two lines:
      unit Unit1;

      interface

      uses
      (...);

      type
      (...);
      procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg); //here is a problem cause I have not declared TArg<>

      When I try to declare it before the procedure itself I get information that ":" expected "<" found.
      Im getting confused. If you have any idea I will be grateful..
      Anja

      Delete
    3. Well,
      Thank you very much for help. I started program, there was only stupid mistake I repeat type formula 2 times. I will inform you about results of using it. Thank you very much.
      Anja

      Delete
    4. Hi Anja,

      Glad that you are sorting out your issues. Please let us know your results.

      Jordi

      Delete
  11. Yes... This worked 1000%...
    Thank very much...

    ReplyDelete
  12. Yes... This is worked very well...
    Thank you so much...

    ReplyDelete
  13. Wow this is great, working on my TOR console capture on Delphi XE2, i have search in many time, many of those hang in form, but i found this usefull here
    thank 4 all,...

    ReplyDelete
  14. It does not work for me, maybe someone has an advice for this.
    I have Windows7 64 and DelphiXE5

    First I tried java -version which makes the CreateProcess return false.

    Then I tried putting 'CMD /c '+command in the CreateProcess, which makes CreateProcess return true, but the message is that it cannot find java.

    I am trying this for quite some time and I run out of possible solutions.

    ReplyDelete
  15. I found what went wrong.

    I was trying to start 64bit Java from a 32 bit application. This does not work.

    ReplyDelete
  16. Excelente Jordi, buen trabajo.
    - Acabo de implementar para crear backups con rar.exe
    - El aplicativo es disparado por medio de un method con DataSnap y es perfecto sin problemas.

    Gracias.

    Startkill
    Lima-Perú

    ReplyDelete
  17. Hi, I am having trouble getting this to work. I am running DelphiXE. Any help you can offer most appreciated.

    I have a form, with a memo, an edit box, and a button. I get these error messages:

    [DCC Error] Unit1.pas(15): E2003 Undeclared identifier: 'TArg'
    [DCC Error] Unit1.pas(34): E2037 Declaration of 'CaptureConsoleOutput' differs from previous declaration
    [DCC Error] Unit1.pas(15): E2065 Unsatisfied forward or external declaration: 'TForm1.CaptureConsoleOutput'
    [DCC Fatal Error] Project1.dpr(5): F2063 Could not compile used unit 'Unit1.pas'

    Here is the full code:

    unit RunCmdLine;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls;

    type
    TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg);

    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    //Anonymous procedure approach by Lars Fosdal
    type
    TArg = reference to procedure(const Arg: T);

    procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg);
    const
    CReadBuffer = 2400;
    var
    saSecurity: TSecurityAttributes;
    hRead: THandle;
    hWrite: THandle;
    suiStartup: TStartupInfo;
    piProcess: TProcessInformation;
    pBuffer: array [0 .. CReadBuffer] of AnsiChar;
    dBuffer: array [0 .. CReadBuffer] of AnsiChar;
    dRead: DWORD;
    dRunning: DWORD;
    dAvailable: DWORD;
    begin
    saSecurity.nLength := SizeOf(TSecurityAttributes);
    saSecurity.bInheritHandle := true;
    saSecurity.lpSecurityDescriptor := nil;
    if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
    FillChar(suiStartup, SizeOf(TStartupInfo), #0);
    suiStartup.cb := SizeOf(TStartupInfo);
    suiStartup.hStdInput := hRead;
    suiStartup.hStdOutput := hWrite;
    suiStartup.hStdError := hWrite;
    suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    suiStartup.wShowWindow := SW_HIDE;
    if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity, @saSecurity, true, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup,
    piProcess) then
    try
    repeat
    dRunning := WaitForSingleObject(piProcess.hProcess, 100);
    PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
    if (dAvailable > 0) then
    repeat
    dRead := 0;
    ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
    pBuffer[dRead] := #0;
    OemToCharA(pBuffer, dBuffer);
    CallBack(dBuffer);
    until (dRead < CReadBuffer);
    Application.ProcessMessages;
    until (dRunning <> WAIT_TIMEOUT);
    finally
    CloseHandle(piProcess.hProcess);
    CloseHandle(piProcess.hThread);
    end;
    finally
    CloseHandle(hRead);
    CloseHandle(hWrite);
    end;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    CaptureConsoleOutput('java -version', Edit1.Text,
    procedure(const Line: PAnsiChar)
    begin
    Memo1.Lines.Add(String(Line));
    end
    );
    end;

    end.


    Thanks,
    Aaron

    ReplyDelete
    Replies
    1. Hi Aaron,

      You need to move the declaration of TArg on the first apparition of type.

      Regards,
      Jordi

      Delete