delphi - Execute DOS program and get output dynamically

Question

I need to execute a 'DOS' program (console app) and to retrieve its output dynamically (it will be also nice to be able to end the DOS program whenever I want because the DOS program may run for hours).

I have this this function, but it sometimes (rarely) freezes. I need a new function or to fix the one below.

procedure ExecuteAndGetOutDyn(CONST ACommand, AParameters: String; AMemo: TMemo);
CONST
  CReadBuffer = 128*KB;  //original was 2400bytes
VAR
  SecurityAttrib: TSecurityAttributes;
  hRead: THandle;
  hWrite: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  pBuffer: array[0..CReadBuffer] of AnsiChar;
  dRead: DWord;
  dRunning: DWord;
  WasOK: Boolean;
begin
  SecurityAttrib.nLength := SizeOf(TSecurityAttributes);
  SecurityAttrib.bInheritHandle := True;
  SecurityAttrib.lpSecurityDescriptor := nil;

  if CreatePipe(hRead, hWrite, @SecurityAttrib, 0) then
   begin
    FillChar(StartupInfo, SizeOf(TStartupInfo), #0);
    StartupInfo.cb         := SizeOf(TStartupInfo);
    StartupInfo.hStdInput  := hRead;
    StartupInfo.hStdOutput := hWrite;
    StartupInfo.hStdError  := hWrite;
    StartupInfo.dwFlags    := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow:= SW_HIDE;

    if CreateProcess(NIL, PChar(ACommand + ' ' + AParameters), @SecurityAttrib, @SecurityAttrib, True, NORMAL_PRIORITY_CLASS, NIL, NIL, StartupInfo, ProcessInfo) then
     begin
      REPEAT
        dRunning:= WaitForSingleObject(ProcessInfo.hProcess, 100);
        Application.ProcessMessages;
        REPEAT
          dRead := 0;
          WasOK := Windows.ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, NIL);
          if NOT WasOK then mesajerror('Cannot read console output.');
          pBuffer[dRead] := #0;

          OemToAnsi(pBuffer, (pBuffer));
          AMemo.Lines.Add(String(pBuffer));
        UNTIL (dRead < CReadBuffer) OR NOT WasOK;
      UNTIL (dRunning <> WAIT_TIMEOUT) { OR Abort};
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
     end;

    CloseHandle(hRead);
    CloseHandle(hWrite);
   end;
end;

---

The big problem is that there are no certain conditions under which the procedure freezes. I just call the ExecuteAndGetOutDyn and SOMETIMES it freezes after the 'DOS' program finishes. I will post the conditions in which the freeze appears as soon as I discover them.

Answer 1

One obvious problem is your pipe. You have a single pipe and you arrange that the child process stdout writes to one end, and the child process stdin reads from the other. That's no good. Why would you want the process to read its input from its own output? And at the same time the parent process reads from the pipe. You've got two processes trying to read this pipe. I can't imagine that ends well.

You need two pipes. One for the child's stdin. The parent writes to it, the child reads from it. And the other pipe for the child's stdout. The child writes to it, the parent reads.

Or if you don't want the child process to have any stdin, then create a single pipe, connect write end to child process stdout and let the parent process read from the read end.

Another problem is that if the process has terminated, and you've already read all of its contents, the call to ReadFile will block indefinitely. You need to make sure that the pipe contains something before attempting to read from it. I'd use GetFileSizeEx for that.

Personally I'd be inclined to do all of this inside a thread to avoid the call to ProcessMessages.

You should also always check API return values for errors. That is not done for the calls to WaitForSingleObject and ReadFile.

I propose something along these lines:

program DynamicStdOutCapture;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Math,
  Winapi.Windows;

function GetFileSizeEx(hFile: THandle; var FileSize: Int64): BOOL; stdcall;
  external kernel32;

procedure Execute(const Command: string; const Parameters: string;
  const Timeout: DWORD; const Output: TProc<string>);

const
  InheritHandleSecurityAttributes: TSecurityAttributes =
    (nLength: SizeOf(TSecurityAttributes); bInheritHandle: True);

var
  hReadStdout, hWriteStdout: THandle;
  si: TStartupInfo;
  pi: TProcessInformation;
  WaitRes, BytesRead: DWORD;
  FileSize: Int64;
  AnsiBuffer: array [0 .. 1024 - 1] of AnsiChar;

begin
  Win32Check(CreatePipe(hReadStdout, hWriteStdout,
    @InheritHandleSecurityAttributes, 0));
  try
    si := Default (TStartupInfo);
    si.cb := SizeOf(TStartupInfo);
    si.dwFlags := STARTF_USESTDHANDLES;
    si.hStdOutput := hWriteStdout;
    si.hStdError := hWriteStdout;
    Win32Check(CreateProcess(nil, PChar(Command + ' ' + Parameters), nil, nil,
      True, CREATE_NO_WINDOW, nil, nil, si, pi));
    try
      while True do
      begin
        WaitRes := WaitForSingleObject(pi.hProcess, Timeout);
        Win32Check(WaitRes <> WAIT_FAILED);
        while True do
        begin
          Win32Check(GetFileSizeEx(hReadStdout, FileSize));
          if FileSize = 0 then
          begin
            break;
          end;
          Win32Check(ReadFile(hReadStdout, AnsiBuffer, SizeOf(AnsiBuffer) - 1,
            BytesRead, nil));
          if BytesRead = 0 then
          begin
            break;
          end;
          AnsiBuffer[BytesRead] := #0;
          OemToAnsi(AnsiBuffer, AnsiBuffer);
          if Assigned(Output) then
          begin
            Output(string(AnsiBuffer));
          end;
        end;
        if WaitRes = WAIT_OBJECT_0 then
        begin
          break;
        end;
      end;
    finally
      CloseHandle(pi.hProcess);
      CloseHandle(pi.hThread);
    end;
  finally
    CloseHandle(hReadStdout);
    CloseHandle(hWriteStdout);
  end;
end;

procedure DoOutput(Text: string);
begin
  Write(Text);
end;

procedure Main;
begin
  Execute('ping', 'stackoverflow.com -t', 100, DoOutput);
end;

begin
  try
    Main;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.