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:

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.
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;

The application 'Not responding' heavily suggest `Application.ProcessMessages()` isn't getting called. So your inner loop is that one that doesn't exit. Without the ability to debug the program, my best theory would be that ReadFile returns false and in this case sets dRead to Dword(-1), which is > than CReadBuffer (Though I wouldn't really expect ReadFile to modify dRead on failure). Now, that only remotely makes sense if you compile without range check, because otherwise `pBuffer[dRead] := #0;` would raise an exception. You really need to debug this youself. — Ken Bourassa, May 03 '22 at 17:35
@KenBourassa `ReadFile()` should never set `dRead` to `Dword(-1)`. `ReadFile()` will set `dRead` to `0` before any reading occurs, and then update `dRead` only if the read is successful. This is documented behavior. But you are right that the "Not responding" is due to `ProcessMessages()` not being called, more likely because `ReadFile()` is blocked waiting for more data that will not arrive, because the pipe is not being closed correctly when the child terminates. — Remy Lebeau, May 03 '22 at 17:56
It always makes me wonder why one would call a commandline utility written in another language, then scrape and parse the output. Downloading files is as task that you could easily do in Delphi directly... — Remko, May 04 '22 at 11:16
Yes, I certainly can and I did. Spend some time with Go & it’s fabulous Go routines, and you’ll quickly learn that when it comes to concurrent downloads, Go is easily magnitudes faster than Delphi with its heavyweight threads. — tua, May 05 '22 at 12:52

Remy Lebeau · Answer 1 · 2022-05-03T18:06:11.413

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).

Program hangs/Issue with WaitForSingleObject/CreateProcess in Delphi

1 Answers1