Delphi 从多个源捕获彩色控制台输出

我编写了一个控制台应用程序，可以在命令行上并行执行多个命令。
我这样做主要是出于兴趣，因为我正在从事的软件项目的构建过程过度使用了命令行

目前，在工作线程中创建子进程之前，我会创建一个匿名管道，以捕获子进程在其生命周期内创建的所有输出。
子进程终止后，工作线程将捕获的内容推送到等待的主进程，然后主进程将其打印出来

以下是我的创建和捕获过程：

    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;

我也阅读了和，和，但对于我的用例，我不能完全理解它

---

保存/接收子进程控制台输出的颜色信息的正确/最佳方法是什么？

我使用并为每个线程提供其自己的控制台屏幕缓冲区的方法是正确的。
问题是哪个没有达到我的预期。
我现在可以使用它了。

然而，应该注意的是，这种方法是传统的方法。 如果你想用“新方法”做这件事，你可能应该使用。
它的支持始于Windows 10 1809和Windows Server 2019

还应注意，与匿名管道相比，通过控制台屏幕缓冲区读取进程/程序输出的方法有其缺陷和两个明显的缺点：

控制台屏幕缓冲区无法满并阻止进程/程序，但如果到达其末尾，新行将把当前的第一行推出缓冲区

快速发送std输出的进程/程序的输出极有可能导致信息丢失，因为您无法足够快地读取、清除和移动控制台屏幕缓冲区中的光标

我试图通过将控制台屏幕缓冲区y大小组件增加到其最大可能大小（我发现它是

MAXSHORT-1

）来规避这两种情况，然后等待进程/程序完成。
这对我来说已经足够好了，因为我不需要分析或处理彩色输出，只需要在控制台窗口中显示它，而控制台窗口本身仅限于

MAXSHORT-1

行。
在其他任何情况下，我都会使用管道，并建议其他人也这样做

这是一个没有任何错误处理的简短版本，可以在不受干扰的情况下并行执行（前提是TStream对象由线程或线程安全拥有）：

---

@J。。。谢谢你的意见。我编辑了问题并删除了不必要的信息。我希望现在好多了。我还将深入研究SetConsoleMode及其周围环境。这并不是对您问题的回答，但我想指出一个常见问题，人们在代码中读取子进程的输出。他们使用WaitForSingleObject之类的工具来尝试确定生成的子进程何时退出。这对你的问题没有帮助；我只是想摆脱

ReadPipe

/

MsgWait

一次一个bug。您的链接“将彩色控制台输出捕获到WPF应用程序”描述问题和解决方案-您必须解释控制/转义码，并单独跟踪每个流的当前属性设置，因为属性在更改之前一直适用。@Brian我的问题是：输出的位和字节中没有控制/转义码。正如我在问题中所写的那样，我只收到普通的旧文本。@Ianboy，我需要考虑一下。我不喜欢ReadFile的阻塞特性。这就是为什么我在阅读之前会定期循环并查看管道中的内容。这会给线程带来一些开销，并可能会给子进程带来延迟，但会让我完全控制线程。如果我理解正确，我的设计决策仍将导致子进程能够完成。在某个时刻，子进程将写入所有内容，我将读取所有内容，WaitForSingleObject将返回除WAIT_TIMEOUT之外的内容。还是我错过了什么？

    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.

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;