Program hangs/Issue with WaitForSingleObject/CreateProcess in Delphi

Question

I am executing an executable written in Go from Delphi (which downloads files from a URL list) and am capturing its console output in a TMemo on a Delphi form.

The last two lines in Go's main function are:

    fmt.Println(fmt.Sprintf("Requested %d URLs in %f seconds", uc-1, duration))
    os.Exit(0)

This line does appear in Delphi's memo, so I assume that the Go executable cleanly exits with a code of 0. I need to resolve two issues with my code:

1. After Go has issued a few thousand HTTP GETs (it outputs requested URLs one by one to the console) it has to 'wait for some stragglers'. During that time, my Delphi app displays the infamous 'Not responding' in the caption bar and Task Manager.

2. Even though the Go executable seems to cleanly exit, my Done() procedure never gets reached - it appears that Delphi never leaves the loop..? What am I doing wrong?

As always, any form of help is greatly appreciated!

procedure Tform_Main.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
 const
   CReadBuffer = 65536;
 var
   saSecurity: TSecurityAttributes;
   hRead:      THandle;
   hWrite:     THandle;
   suiStartup: TStartupInfo;
   piProcess:  TProcessInformation;
   pBuffer:    Array[0..CReadBuffer] of AnsiChar;
   dRead:      DWord;
   dRunning:   DWord;

 begin
 (*
   ACommand:      ex. {GoGetter.exe}
   AParameters:   ex. {C:\temp\downloads\ c:\temp\urls.txt 1}
 *)
   saSecurity.nLength              := SizeOf(TSecurityAttributes);
   saSecurity.bInheritHandle       := True;
   saSecurity.lpSecurityDescriptor := nil;
   try
     if CreatePipe(hRead, hWrite, @saSecurity, 0) then
     begin
       Screen.Cursor := crHourglass;
       Application.ProcessMessages;
       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);
             AMemo.Lines.Text := AMemo.Lines.Text + String(pBuffer);
             SendMessage(AMemo.Handle, WM_VSCROLL, SB_BOTTOM, 0);
           until (dRead < CReadBuffer);
         until (dRunning <> WAIT_TIMEOUT);
       end;
     end;
     Done(); // writes a 'finished' message to the memo, resets the screen cursor & re-enables the start button
   finally
     CloseHandle(piProcess.hProcess);
     CloseHandle(piProcess.hThread);
     CloseHandle(hRead);
     CloseHandle(hWrite);
   end;
end;

Answer 1

Don't assign your hRead handle to the child process's hStdInput. You are not sending any data to the child process. Don't let the child process inherit your hRead handle at all. Use SetHandleInformation() to remove the HANDLE_FLAG_INHERIT flag from it.

And, you need to close your hWrite handle after the child process has inherited it, otherwise the pipe will remain open after the child process has terminated. You are not writing anything to the child process, so you don't need to leave your original hWrite handle open. When the child process terminates, its inherited hWrite handle will be closed, thus breaking the pipe, allowing ReadFile() to stop waiting for further data.

See How to read output from cmd.exe using CreateProcess() and CreatePipe() for more details about the use of pipe handles during I/O redirection.

Then, you can remove the outer repeat loop altogether. Just loop on ReadFile() until it fails, then call WaitForSingleObject() on the hProcess handle before cleaning up.

And just an FYI, using AMemo.Lines.Text := AMemo.Lines.Text + String(pBuffer); is a very inefficient way to append strings to a TMemo, especially over a long time.

Try something more like this instead:

procedure Tform_Main.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
const
  CReadBuffer = 65536;
var
  saSecurity: TSecurityAttributes;
  hRead:      THandle;
  hWrite:     THandle;
  suiStartup: TStartupInfo;
  piProcess:  TProcessInformation;
  pBuffer:    array[0..CReadBuffer] of AnsiChar;
  dRead:      DWord;
begin
  (*
   ACommand:      ex. {GoGetter.exe}
   AParameters:   ex. {C:\temp\downloads\ c:\temp\urls.txt 1}
  *)
  saSecurity.nLength              := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle       := True;
  saSecurity.lpSecurityDescriptor := nil;

  if CreatePipe(hRead, hWrite, @saSecurity, 0) then
  try
    SetHandleInformation(hRead, HANDLE_FLAG_INHERIT, 0);

    ZeroMemory(@suiStartup, SizeOf(suiStartup));
    suiStartup.cb          := SizeOf(TStartupInfo);
    suiStartup.hStdInput   := GetStdHandle(STD_INPUT_HANDLE);
    suiStartup.hStdOutput  := hWrite;
    suiStartup.hStdError   := hWrite;
    suiStartup.dwFlags     := STARTF_USESTDHANDLES;

    Screen.Cursor := crHourglass;
    Application.ProcessMessages;

    try
      if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity, @saSecurity, True, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
                       nil, nil, suiStartup, piProcess) then
      try
        CloseHandle(piProcess.hThread);

        CloseHandle(hWrite);
        hWrite := INVALID_HANDLE_VALUE;

        repeat
          Application.ProcessMessages();
          if (not ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil)) or (dRead = 0) then
            Break;
          pBuffer[dRead] := #0;
          OemToAnsi(pBuffer, pBuffer);
          AMemo.SelStart := AMemo.GetTextLen();
          AMemo.SelLength := 0;
          AMemo.SelText := String(pBuffer);
          SendMessage(AMemo.Handle, WM_VSCROLL, SB_BOTTOM, 0);
        until False;

        WaitForSingleObject(piProcess.hProcess, INFINITE);
      finally
        CloseHandle(piProcess.hProcess);
      end;
    finally
      Done();
    end;
  finally
    CloseHandle(hRead);
    if hWrite <> INVALID_HANDLE_VALUE then
      CloseHandle(hWrite);
  end;
end;

Then, consider moving this code into a separate worker thread so you don't block your main UI thread anymore. Then you won't need ProcessMessages() anymore. Otherwise, if you really want to call ProcessMessages() inside the loop, use a named pipe instead of an anonymous pipe, then you can read asynchronously using OVERLAPPED I/O (see Overlapped I/O on anonymous pipe).