Redirect stdout stream from console application (CreateProcess)

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.