Capture coloured console output from multiple sources - delphi

Question

I wrote a console application that is able to execute multiple commands on the command line in parallel.
Primarily I did this out of interest and because the build processes of the software projects I am working on make excessive use of the command line.
Currently, before I create a child process in a worker thread, I create an anonymous pipe in order to capture all the output the child process creates during its lifetime.
After the child process terminates, the worker thread pushes the captured content to the waiting main process that then prints it out.
Here's my process creations and capturing:
procedure ReadPipe(const ReadHandle: THandle; const Output: TStream);
var
Buffer: TMemoryStream;
BytesRead, BytesToRead: DWord;
begin
Buffer := TMemoryStream.Create;
try
BytesRead := 0;
BytesToRead := 0;
if PeekNamedPipe(ReadHandle, nil, 0, nil, #BytesToRead, nil) then
begin
if BytesToRead > 0 then
begin
Buffer.Size := BytesToRead;
ReadFile(ReadHandle, Buffer.Memory^, Buffer.Size, BytesRead, nil);
if Buffer.Size <> BytesRead then
begin
Buffer.Size := BytesRead;
end;
if Buffer.Size > 0 then
begin
Output.Size := Output.Size + Buffer.Size;
Output.WriteBuffer(Buffer.Memory^, Buffer.Size);
end;
end;
end;
finally
Buffer.Free;
end;
end;
function CreateProcessWithRedirectedOutput(const AppName, CMD, DefaultDir: PChar; out CapturedOutput: String): Cardinal;
const
TIMEOUT_UNTIL_NEXT_PIPEREAD = 100;
var
SecurityAttributes: TSecurityAttributes;
ReadHandle, WriteHandle: THandle;
StartupInfo: TStartupInfo;
ProcessInformation: TProcessInformation;
ProcessStatus: Cardinal;
Output: TStringStream;
begin
Result := 0;
CapturedOutput := '';
Output := TStringStream.Create;
try
SecurityAttributes.nLength := SizeOf(SecurityAttributes);
SecurityAttributes.lpSecurityDescriptor := nil;
SecurityAttributes.bInheritHandle := True;
if CreatePipe(ReadHandle, WriteHandle, #SecurityAttributes, 0) then
begin
try
FillChar(StartupInfo, Sizeof(StartupInfo), 0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.hStdOutput := WriteHandle;
StartupInfo.hStdError := WriteHandle;
StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
StartupInfo.dwFlags := STARTF_USESTDHANDLES;
if CreateProcess(AppName, CMD,
#SecurityAttributes, #SecurityAttributes,
True, NORMAL_PRIORITY_CLASS,
nil, DefaultDir,
StartupInfo, ProcessInformation)
then
begin
try
repeat
ProcessStatus := WaitForSingleObject(ProcessInformation.hProcess, TIMEOUT_UNTIL_NEXT_PIPEREAD);
ReadPipe(ReadHandle, Output);
until ProcessStatus <> WAIT_TIMEOUT;
if not Windows.GetExitCodeProcess(ProcessInformation.hProcess, Result) then
begin
Result := GetLastError;
end;
finally
Windows.CloseHandle(ProcessInformation.hProcess);
Windows.CloseHandle(ProcessInformation.hThread);
end;
end
else
begin
Result := GetLastError;
end;
finally
Windows.CloseHandle(ReadHandle);
Windows.CloseHandle(WriteHandle);
end;
end
else
begin
Result := GetLastError;
end;
CapturedOutput := Output.DataString;
finally
Output.Free;
end;
end;
My problem now:
This method doesn't preserve potential coloring of the captured output!
I came accross this topic Capture coloured console output into WPF application but that didn't help me out, as I don't receive any color data through the anonymous pipe, just plain old text.
I experimented with inheriting the console of the main process to the child processes via CreateFile with 'CONOUT$', but while the colors are indeed preserved, you probably can guess that its pure mayhem if more than one process prints out its contents into one and the same console.
My next approach was to create additional console buffers with CreateConsoleScreenBuffer for each child process and read the contents with ReadConsole, but that wasn't successful as ReadConsole returns with System Error 6 (ERROR_INVALID_HANDLE).
ConsoleHandle := CreateConsoleScreenBuffer(
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
#SecurityAttributes,
CONSOLE_TEXTMODE_BUFFER,
nil);
//...
StartupInfo.hStdOutput := ConsoleHandle;
StartupInfo.hStdError := ConsoleHandle;
//...
ConsoleOutput := TMemoryStream.Create
ConsoleOutput.Size := MAXWORD;
ConsoleOutput.Position := 0;
ReadConsole(ConsoleHandle, ConsoleOutput.Memory, ConsoleOutput.Size, CharsRead, nil) // Doesn't read anything and returns with System Error Code 6.
I also read up on virtual terminal sequences and AllocConsole, AttachConsole and FreeConsole, but can't quite wrap my head around it for my use case.
What is the right/best way to preserve/receive coloring information of the console output of a child process?

Answer 1

I was on the right track with CreateConsoleScreenBuffer and giving each thread its own console screen buffer.
The problem was ReadConsole which doesn't do what I expected.
I now got it working with ReadConsoleOutput.
It should be noted however, that this method is the legacy way of doing it.
If you want to do it the "new way" you should probably use Pseudo Console Sessions.
Its support starts with Windows 10 1809 and Windows Server 2019.
It should also be noted, that the method of reading the output of a process/program via console screen buffer has its flaws and two distinct disadvantages compared to anonymous pipes:
The console screen buffer can't get full and block the process/program, but if the end of it is reached, new lines will push the current first line out of the buffer.
Output from processes/programs that spam their std output in a fast fashion will most likely lead to loss of information, as you won't be able to read, clear and move the cursor in the console screen buffer fast enough.
I try to circumvent both by increasing the console screen buffers y size component to its maximum possible size (I found it to be MAXSHORT - 1) and just wait until the process/program has finished.
That's good enough for me, as I don't need to analyze or process the colored output, but just display it in a console window, which is itself limited to MAXSHORT - 1 lines.
In every other scenario I will be using pipes and advise everyone else to do so too!
Here is a short version without any error handling that can be executed in parallel without interference (provided the TStream object is owned by the thread or thread-safe):
procedure CreateProcessWithConsoleCapture(const aAppName, aCMD, aDefaultDir: PChar;
const CapturedOutput: TStream);
const
CONSOLE_SCREEN_BUFFER_SIZE_Y = MAXSHORT - 1;
var
SecurityAttributes: TSecurityAttributes;
ConsoleHandle: THandle;
StartupInfo: TStartupInfo;
ProcessInformation: TProcessInformation;
CharsRead: Cardinal;
BufferSize, Origin: TCoord;
ConsoleScreenBufferInfo: TConsoleScreenBufferInfo;
Buffer: array of TCharInfo;
ReadRec: TSmallRect;
begin
SecurityAttributes.nLength := SizeOf(SecurityAttributes);
SecurityAttributes.lpSecurityDescriptor := Nil;
SecurityAttributes.bInheritHandle := True;
ConsoleHandle := CreateConsoleScreenBuffer(
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
#SecurityAttributes,
CONSOLE_TEXTMODE_BUFFER,
nil);
try
GetConsoleScreenBufferInfo(ConsoleHandle, ConsoleScreenBufferInfo);
BufferSize.X := ConsoleScreenBufferInfo.dwSize.X;
BufferSize.Y := CONSOLE_SCREEN_BUFFER_SIZE_Y;
SetConsoleScreenBufferSize(ConsoleHandle, BufferSize);
Origin.X := 0;
Origin.Y := 0;
FillConsoleOutputCharacter(ConsoleHandle, #0, BufferSize.X * BufferSize.Y, Origin, CharsRead);
SetStdHandle(STD_OUTPUT_HANDLE, ConsoleHandle);
FillChar(StartupInfo, Sizeof(StartupInfo), 0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.hStdOutput := ConsoleHandle;
StartupInfo.hStdError := ConsoleHandle;
StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_FORCEOFFFEEDBACK;
CreateProcess(aAppName, aCMD,
#SecurityAttributes, #SecurityAttributes,
True, NORMAL_PRIORITY_CLASS,
nil, aDefaultDir,
StartupInfo, ProcessInformation);
try
WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
GetConsoleScreenBufferInfo(ConsoleHandle, ConsoleScreenBufferInfo);
BufferSize.X := ConsoleScreenBufferInfo.dwSize.X;
BufferSize.Y := ConsoleScreenBufferInfo.dwCursorPosition.Y;
if ConsoleScreenBufferInfo.dwCursorPosition.X > 0 then
begin
Inc(BufferSize.Y);
end;
ReadRec.Left := 0;
ReadRec.Top := 0;
ReadRec.Right := BufferSize.X - 1;
ReadRec.Bottom := BufferSize.Y - 1;
SetLength(Buffer, BufferSize.X * BufferSize.Y);
ReadConsoleOutput(ConsoleHandle, #Buffer[0], BufferSize, Origin, ReadRec);
CharsRead := SizeOf(TCharInfo) * (ReadRec.Right - ReadRec.Left + 1) * (ReadRec.Bottom - ReadRec.Top + 1);
if CharsRead > 0 then
begin
CapturedOutput.Size := CapturedOutput.Size + CharsRead;
CapturedOutput.WriteBuffer(Buffer[0], CharsRead);
end;
finally
CloseHandle(ProcessInformation.hProcess);
CloseHandle(ProcessInformation.hThread);
end;
finally
CloseHandle(ConsoleHandle);
end;
end;