Program hangs/Issue with WaitForSingleObject/CreateProcess in Delphi - 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;

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