Redirect stdout stream from console application (CreateProcess) - stdout

Question

Recently I finally managed to redirect console application output to TMemo text field of another application using an example from Microsoft: https://learn.microsoft.com/en-us/windows/win32/procthread/creating-a-child-process-with-redirected-input-and-output
All the classical examples run a console executable, wait till it ends and then read its STDOUT. I would like to launch a long-running executable that is normally not intended to end, and get its STDOUT stream as soon as new characters become available.
I managed to modify this example so that a read-write part is a loop and runs in a thread (TProcessExecuterThread.Execute). Now I am in doubt whether I should use the thread at all.
Additionally, the host receives not the whole strings till CR-LF even if I get from a pipe one character after other (TProcessExecuterThread.ReadFromPipe).
Finally I am concerned what about ending the host. The guest should then receive a signal to terminate and after some timeout - should be killed. Where (not "how") is it better to organize this?
Here is the console guest application for the test:
{$APPTYPE CONSOLE}
program GuestApp;
uses System.SysUtils;
var i: Integer;
begin
Writeln('Ongoing console output:');
for i := 0 to 65535 do begin //while True do begin
if i mod 2 = 0 then Write('*');
Writeln(Format('Output line %d', [i]));
Sleep(500);
end;
end.
Here is the host application (sorry, it is not short):
unit Executer;
interface
uses Winapi.Windows, System.Classes, System.Generics.Collections;
type
TProcessExecuterThread = class(TThread)
private
FStdInQueue: TQueue<string>;
FhChildStdOutRd: THandle;
FhChildStdInWr: THandle;
FOnStdOutLog: TGetStrProc;
procedure ReadFromPipe();
procedure WriteToPipe();
procedure StdOutLog(msg: string);
protected
procedure Execute(); override;
property hChildStdOutRd: THandle read FhChildStdOutRd write FhChildStdOutRd;
property hChildStdInWr: THandle read FhChildStdInWr write FhChildStdInWr;
property OnstdOutLog: TGetStrProc read FOnStdOutLog write FOnStdOutLog;
end;
TProcessExecuter = class
private const
BUFSIZE = 4096;
private
FhChildStdInRd: THandle;
FhChildStdInWr: THandle;
FhChildStdOutRd: THandle;
FhChildStdOutWr: THandle;
FOnLog: TGetStrProc;
FOnStdOutLog: TGetStrProc;
FExThread: TProcessExecuterThread;
procedure CreateChildProcess(ACmdLine: string);
procedure ErrorExit(AFuncName: string);
procedure Log(msg: string);
procedure StdOutLog(const msg: string);
function KillProcess(dwProcID, Wait: DWORD): Integer;
public
constructor Create();
function RunRedirectedProcess(ACmdLine: string): Integer;
property OnLog: TGetStrProc read FOnLog write FOnLog;
property OnstdOutLog: TGetStrProc read FOnStdOutLog write FOnStdOutLog;
end;
implementation
uses System.SysUtils;
procedure TProcessExecuter.Log(msg: string);
begin
if Assigned(FOnLog) then FOnLog(msg);
end;
procedure TProcessExecuter.StdOutLog(const msg: string);
begin
if Assigned(FOnStdOutLog) then FOnStdOutLog(msg);
end;
// Format a readable error message, display a message box,
// and exit from the application.
procedure TProcessExecuter.ErrorExit(AFuncName: string);
var msg: string;
dw: DWORD;
begin
dw := GetLastError();
msg := Format('%s failed with error %d: %s', [AFuncName, dw, SysErrorMessage(dw)]);
Log(msg);
// ExitProcess(1);
end;
constructor TProcessExecuter.Create();
begin
FhChildStdInRd := 0;
FhChildStdInWr := 0;
FhChildStdOutRd := 0;
FhChildStdOutWr := 0;
FExThread := TProcessExecuterThread.Create();
FExThread.OnstdOutLog := StdOutLog;
end;
// Create a child process that uses the previously created pipes for STDIN and STDOUT.
procedure TProcessExecuter.CreateChildProcess(ACmdLine: string);
var
piProcInfo: TProcessInformation;
siStartInfo: TStartupInfo;
bSuccess: Boolean;
begin
try
bSuccess := False;
FillChar(piProcInfo, SizeOf(TProcessInformation), 0);
FillChar(siStartInfo, SizeOf(TStartupInfo), 0);
siStartInfo.cb := SizeOf(TStartupInfo);
siStartInfo.hStdError := FhChildStdOutWr;
siStartInfo.hStdOutput := FhChildStdOutWr;
siStartInfo.hStdInput := FhChildStdInRd;
siStartInfo.dwFlags := siStartInfo.dwFlags or STARTF_USESTDHANDLES;
bSuccess := CreateProcess(nil, PWideChar(ACmdLine), nil, nil, True, 0, nil, nil, siStartInfo, piProcInfo);
if not bSuccess then begin
ErrorExit('CreateProcess');
Exit;
end
else begin
CloseHandle(piProcInfo.hProcess);
CloseHandle(piProcInfo.hThread);
CloseHandle(FhChildStdOutWr);
CloseHandle(FhChildStdInRd);
end;
FExThread.hChildStdOutRd := FhChildStdOutRd;
FExThread.hChildStdInWr := FhChildStdInWr;
except
on ex: Exception do Log(ex.Message);
end;
end;
function TProcessExecuter.RunRedirectedProcess(ACmdLine: string): Integer;
var saAttr: SECURITY_ATTRIBUTES;
i: Integer;
begin
try
Log('->Start of parent execution.');
saAttr.nLength := SizeOf(SECURITY_ATTRIBUTES);
saAttr.bInheritHandle := True;
saAttr.lpSecurityDescriptor := 0;
if not CreatePipe(FhChildStdOutRd, FhChildStdOutWr, #saAttr, 0) then begin
ErrorExit('StdoutRd CreatePipe');
Exit;
end;
if not SetHandleInformation(FhChildStdOutRd, HANDLE_FLAG_INHERIT, 0) then begin
ErrorExit('Stdout SetHandleInformation');
Exit;
end;
if not CreatePipe(FhChildStdInRd, FhChildStdInWr, #saAttr, 0) then begin
ErrorExit('Stdin CreatePipe');
Exit;
end;
if not SetHandleInformation(FhChildStdInWr, HANDLE_FLAG_INHERIT, 0) then begin
ErrorExit('Stdin SetHandleInformation');
Exit;
end;
CreateChildProcess(ACmdLine);
//Read/write loop was here
Log('->End of parent execution.');
if not CloseHandle(FhChildStdInWr) then begin
ErrorExit('StdInWr CloseHandle');
Exit;
end;
Result := 0;
except
on ex: Exception do Log(ex.Message);
end;
end;
procedure TProcessExecuterThread.WriteToPipe();
var dwRead, dwWritten: DWORD;
chBuf: Pointer;
bSuccess: Boolean;
line: string;
bs: Integer;
begin
bSuccess := False;
while FStdInQueue.Count > 0 do begin
line := FStdInQueue.Dequeue();
bs := (Length(line) + 1) * SizeOf(WideChar);
GetMem(chBuf, bs);
try
StrPCopy(PWideChar(chBuf), line);
if not WriteFile(FhChildStdInWr, chBuf^, dwRead, dwWritten, nil) then break;
finally
FreeMem(chBuf, bs);
end;
end;
end;
procedure TProcessExecuterThread.ReadFromPipe();
const BUFSIZE = 1; //4096
var dwRead: DWORD;
//chBuf: array [0 .. BUFSIZE] of CHAR;
chBuf: array [0 .. BUFSIZE] of AnsiChar; // Currently only ANSI is possible
ch: AnsiChar;
bSuccess: Boolean;
begin
bSuccess := False;
while True do begin
//bSuccess := ReadFile(FhChildStdOutRd, chBuf, BUFSIZE, dwRead, nil);
bSuccess := ReadFile(FhChildStdOutRd, ch, 1, dwRead, nil);
if (not bSuccess) or (dwRead = 0) then
break;
//StdOutLog(chBuf);
StdOutLog(ch);
end;
end;
procedure TProcessExecuterThread.StdOutLog(msg: string);
begin
if Assigned(FOnStdOutLog) then
Synchronize(
procedure()
begin
FOnStdOutLog(msg);
end
);
end;
procedure TProcessExecuterThread.Execute;
begin
inherited;
FStdInQueue := TQueue<string>.Create();
try
while not Terminated do begin
WriteToPipe();
ReadFromPipe();
end;
finally
FreeAndNil(FStdInQueue);
end;
end;
end.