Monday, 4 July 2011

Capturing console output with Delphi 2010/XE

This new method supersedes the previous one using TDosCommand. It's been tested and it works with Delphi 2010 and Delphi XE, so it's worth to give it a try. It's really easy to use and I'm preparing a little tool with it.

//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;
begin
    saSecurity.nLength := SizeOf(TSecurityAttributes);
    saSecurity.bInheritHandle := True;
    saSecurity.lpSecurityDescriptor := nil;

    if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    begin
        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
        begin
            repeat
                dRunning := WaitForSingleObject(piProcess.hProcess, 100);
                Application.ProcessMessages();
                repeat
                    dRead := 0;
                    ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
                    pBuffer[dRead] := #0;

                    //OemToAnsi(pBuffer, pBuffer);
                    //Unicode support by Lars Fosdal
                    OemToCharA(pBuffer, dBuffer);
                    CallBack(dBuffer);
                until (dRead < CReadBuffer);
            until (dRunning <> WAIT_TIMEOUT);
            CloseHandle(piProcess.hProcess);
            CloseHandle(piProcess.hThread);
        end;
        CloseHandle(hRead);
        CloseHandle(hWrite);
    end;
end;


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


With all the help I got from Lars, I've released a version of the function for test purposes. You can download the app from here (Thundax Output).

Example:

Updated 13/12/2012:
Check out the latest algorithm in the most updated and revised post:


Related links:

28 comments:

  1. Hola Jordi,
    el código se ejecuta correctamente en TurboDelphi.
    Saludos...
    Miguel Angel

    ReplyDelete
  2. Hola Miguel,

    Bueno saber que funciona con TurboDelphi!.

    Un Saludo
    Jordi

    ReplyDelete
  3. Nice! Two change suggestions:
    - Change AMemo:TMemo to AOutput:TStrings - that gives more flexibility
    - Use OEMtoCharBuff instead of OEMtoAnsi - that gives proper support for Unicode output.

    ReplyDelete
  4. Hi Lars,

    Thank you for your comment and for your suggestions. I'm taking into account one of them for the Unicode support.

    Thanks.
    Jordi

    ReplyDelete
  5. Thanks, and you're welcome!

    If you type dBuffer as Char, it is compatible with pre-unicode Delphi.
    var
    dBuffer : array [0 .. CReadBuffer] of Char;

    If you use TStrings as output, you can still call it with AMemo:
    CaptureConsoleOutput('java -version', '', Memo1.Lines);

    Or - you could be even more radical and use an anonymous procedure for each line - then the user has complete control of how to use the output.

    type
    TArg = reference to procedure(const Arg:T);

    procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg);

    ...

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

    ReplyDelete
  6. Google ate my brackets :/

    TArg<T> = reference to procedure(const Arg:T);

    procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg<pChar>);

    ReplyDelete
  7. Hi Lars,

    I love your radical approach using anonymous methods. I have gone for it!, but using PAnsiChar and OemToCharA(ANSI). After several trials with OEMtoCharBuff it turns out that the output was not displayed correctly.

    Regards,
    Jordi

    ReplyDelete
  8. Hi Jordi,
    Cool that you liked the anon.method approach. Anon.methods are incredibly potent, even if they have some limitations with regards to scope.

    On the Unicode side of things:

    I created a directory with a file named €.txt, and called your function with 'cmd /c dir c:\testdir'.
    €.txt showed up as ?.txt in the raw data from the pipe, so I figured there was something fishy.

    It turns out that cmd.exe have two output modes, and the default is to output AnsiChar. If I used the /u for Unicode switch: 'cmd /c dir c:\testdir' - all the pipe data were Unicode.

    This means that CaptureConsoleOutput should either always use 'cmd /u /c command arg1 arg 2' and a WideChar buffer, or you need to move the conversion out into the anon.method, and let the user figure out what kind of conversion to do.

    For security reasons, MS recommend using the OEMto...Buff/A/W which has a fixed length reference to avoid buffer overruns.

    ReplyDelete
  9. Correction:
    Unicode switch should read: 'cmd /u /c dir c:\testdir'

    ReplyDelete
  10. Hi Lars,

    I agree with you. After generating the €.txt file, if you try to do a 'dir c:\testfile' you'll see a ?.txt file from the console and that's what is picking up the pipe. I think that we should leave the user decide what are they going to use and modify the function according to that.

    Cheers,
    Jordi.

    ReplyDelete
  11. Check the picture, and you'll see the ?.txt file ;)

    ReplyDelete
  12. Sweet! Thank you for mentioning me, as well ;)

    It was a surprise to me that cmd actually is ANSI by default.

    Looking forward to see more godd stuff from you in the future!

    If you use Google+, you hook up with me here: http://plus.lars.fosdal.com

    ReplyDelete
  13. Hi Jordi

    the code is exactly what I was looking for to build a GUI front end to the commonly used commandline networking utilities such as ping, ipconfig etc. All worked well until Netstat was called and for some reason this hangs my application or takes an eternity to process. I have scrathed my head and various other parts of my anatomy trying to track down the problem, but to no avail. Running Windows 7 & XE2 with all updates in place. Any help would be most appreciated. I am still pretty much a Delphi Novice ;)

    ReplyDelete
    Replies
    1. Hi Bob,

      Sorry for the late response. I think it will not work for Netstat command. I've tried it out before and the applications hangs. I think it should be because of the pipe created and netstat command is doing something on background. I'll try to work on it and see if I can get anything different.

      Jordi

      Delete
  14. I'm trying to use this code to show the output of format command but after formatting is completed, application hangs.

    CaptureConsoleOutput('cmd /c echo y|format'+' '+drive+':'+'/FS:FAT32'+'/Q'+'/X'+'/V:'+label, '',
    procedure(const Line: PAnsiChar)
    begin
    Memo1.Lines.Add(String(Line));
    end
    );

    ReplyDelete
    Replies
    1. Hi,

      As I said before (replying to Bob) there are certain commands which will not work because of the pipe. I think the command you are trying to execute is creating a pipe and from the function it is impossible to get back to the previous execution. I'll give it a go and see if I find something.

      Jordi

      Delete
    2. Jordi, another one that hangs is pscp.exe (from the putty suite of utilities) if you copy more than one file at the same time you see progress and you get all the output until the last readfile once the command is finished where Readfile never returns

      Hope this helps shading some light
      Didier

      Delete
    3. Thanks Didier, I'll take it into account.

      Jordi

      Delete
  15. Hi Jordi,

    thanks for the nice code snippet. It was a good starting point for me to capture the output of an external process (fop in my case). However I ran across the same problem as others before, that the application would hang on the last ReadFile.
    I found a solution for this problem and I'd like to share it with the commmunity.

    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 you 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.
    Code attached. I hope it is readable after being formatted by blogspot...

    procedure TFormConsoleTest.CaptureConsoleOutput2(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;

    ReplyDelete
    Replies
    1. Thanks Lübbe.

      I will test it and I will add it to my post. If you give me your details I will reference you to the post.

      Jordi

      Delete
    2. Hi Jordi,

      do you mean my e-mail address? I haven't really ever used blogger, but I have just connected my g+ profile with blogger, so you should be able to find everything there.

      Cheers
      Lübbe

      Delete
  16. Hi Lübbe,

    Thanks for your help on this. I've tested it and it works perfectly. I have revised the post and published a new one where you are mentioned. Thanks again for helping the community.

    Here you can find the related article:
    Capturing console output revised

    Jordi

    ReplyDelete
    Replies
    1. Hi Jordi,

      thanks a lot. It was fun to solve this problem.

      Would it be possible for you to wrap the two very long lines so that they do not extend into the right side of your blog anymore?

      Cheers
      Lübbe

      Delete
    2. Thanks to you Lübbe,

      you did all the job. Now we have something pretty interesting and that works. I will upload it to my repository so everybody can download it and I'll try to fix the wrapping.

      Jordi

      Delete
  17. hi, how to send 'q' key to application using this? Im using this code for FFmpeg and for Xvid encoding need to close by 'q' key. Thanks for reply

    ReplyDelete
    Replies
    1. Hi,

      The code only allows reading. You will have to find another way of sending a command.

      Jordi

      Delete
  18. Hola Jordi, Me pregunto cual seria la utilidad de esta aplicación??? Para que me serviría?

    ReplyDelete
    Replies
    1. Hola Jorge,

      Pues serviria para poder mostrar o capturar la informacion de una utilidad que usara el command line. De esta manera puedes ver que esta haciendo la aplicacion.

      Jordi

      Delete