Как перенаправить двоичный вывод gbak в поток Delphi?

Мой первый ответ эффективен, когда вы хотите объединить stdout и stderr. Однако, если вам нужно хранить их отдельно, этот подход бесполезен. И теперь я вижу, из более внимательного прочтения вашего вопроса и ваших комментариев, что вы действительно хотите разделить два потока вывода.

Теперь не совсем просто расширить мой первый ответ, чтобы охватить это. Проблема в том, что в коде используется блокирующий ввод-вывод. А если нужно обслуживать две трубы, тут явный конфликт. Широко используемым решением в Windows является асинхронный ввод-вывод, известный в мире Windows как перекрывающийся ввод-вывод. Однако реализовать асинхронный ввод-вывод намного сложнее, чем блокирующий ввод-вывод.

Итак, я собираюсь предложить альтернативный подход, который по-прежнему использует блокирующий ввод-вывод. Если мы хотим обслуживать несколько каналов и использовать блокирующий ввод-вывод, то очевидный вывод состоит в том, что нам нужен один поток для каждого канала. Это легко реализовать — намного проще, чем асинхронный вариант. Мы можем использовать почти идентичный код, но переместить блокирующие циклы чтения в потоки. Мой пример, переработанный таким образом, теперь выглядит так:

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes, Windows;

type
  TProcessOutputPipe = class
  private
    Frd: THandle;
    Fwr: THandle;
  public
    constructor Create;
    destructor Destroy; override;
    property rd: THandle read Frd;
    property wr: THandle read Fwr;
    procedure CloseWritePipe;
  end;

constructor TProcessOutputPipe.Create;
const
  PipeSecurityAttributes: TSecurityAttributes = (
    nLength: SizeOf(TSecurityAttributes);
    bInheritHandle: True
  );
begin
  inherited;
  Win32Check(CreatePipe(Frd, Fwr, @PipeSecurityAttributes, 0));
  Win32Check(SetHandleInformation(Frd, HANDLE_FLAG_INHERIT, 0));//don't inherit read handle of pipe
end;

destructor TProcessOutputPipe.Destroy;
begin
  CloseHandle(Frd);
  if Fwr<>0 then
    CloseHandle(Fwr);
  inherited;
end;

procedure TProcessOutputPipe.CloseWritePipe;
begin
  CloseHandle(Fwr);
  Fwr := 0;
end;

type
  TReadPipeThread = class(TThread)
  private
    FPipeHandle: THandle;
    FStream: TStream;
  protected
    procedure Execute; override;
  public
    constructor Create(PipeHandle: THandle; Stream: TStream);
  end;

constructor TReadPipeThread.Create(PipeHandle: THandle; Stream: TStream);
begin
  inherited Create(False);
  FPipeHandle := PipeHandle;
  FStream := Stream;
end;

procedure TReadPipeThread.Execute;
var
  Buffer: array [0..4096-1] of Byte;
  BytesRead: DWORD;
begin
  while ReadFile(FPipeHandle, Buffer, SizeOf(Buffer), BytesRead, nil) and (BytesRead<>0) do begin
    FStream.WriteBuffer(Buffer, BytesRead);
  end;
end;

function ReadOutputFromExternalProcess(const ApplicationName, CommandLine: string; stdout, stderr: TStream): DWORD;
var
  stdoutPipe, stderrPipe: TProcessOutputPipe;
  stdoutThread, stderrThread: TReadPipeThread;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  lpApplicationName: PChar;
  ModfiableCommandLine: string;
begin
  if ApplicationName='' then
    lpApplicationName := nil
  else
    lpApplicationName := PChar(ApplicationName);
  ModfiableCommandLine := CommandLine;
  UniqueString(ModfiableCommandLine);

  stdoutPipe := nil;
  stderrPipe := nil;
  stdoutThread := nil;
  stderrThread := nil;
  try
    stdoutPipe := TProcessOutputPipe.Create;
    stderrPipe := TProcessOutputPipe.Create;

    ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
    StartupInfo.cb := SizeOf(StartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo.wShowWindow := SW_HIDE;
    StartupInfo.hStdOutput := stdoutPipe.wr;
    StartupInfo.hStdError := stderrPipe.wr;
    Win32Check(CreateProcess(lpApplicationName, PChar(ModfiableCommandLine), nil, nil, True,
      CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo));

    stdoutPipe.CloseWritePipe;//so that the process is able to terminate
    stderrPipe.CloseWritePipe;//so that the process is able to terminate

    stdoutThread := TReadPipeThread.Create(stdoutPipe.rd, stdout);
    stderrThread := TReadPipeThread.Create(stderrPipe.rd, stderr);
    stdoutThread.WaitFor;
    stderrThread.WaitFor;

    Win32Check(WaitForSingleObject(ProcessInfo.hProcess, INFINITE)=WAIT_OBJECT_0);
    Win32Check(GetExitCodeProcess(ProcessInfo.hProcess, Result));
  finally
    stderrThread.Free;
    stdoutThread.Free;
    stderrPipe.Free;
    stdoutPipe.Free;
  end;
end;

procedure Test;
var
  stdout, stderr: TFileStream;
  ExitCode: DWORD;
begin
  stdout := TFileStream.Create('C:\Desktop\stdout.txt', fmCreate);
  try
    stderr := TFileStream.Create('C:\Desktop\stderr.txt', fmCreate);
    try
      ExitCode := ReadOutputFromExternalProcess('', 'cmd /c dir /s C:\Windows\system32', stdout, stderr);
    finally
      stderr.Free;
    end;
  finally
    stdout.Free;
  end;
end;

begin
  Test;
end.

Если вы хотите добавить поддержку отмены, вам нужно просто добавить вызов TerminateProcess при отмене пользователем. Это остановит все, и функция вернет код выхода, который вы предоставили TerminateProcess. Сейчас я не решаюсь предложить вам структуру отмены, но я думаю, что код в этом ответе теперь довольно близок к удовлетворению ваших требований.

Я ожидаю, что ваш код не работает, потому что он пытается передать двоичные данные через текстовый поток. В любом случае достаточно просто решить вашу проблему с помощью пары вызовов Win32 API. Я не вижу веских причин использовать сторонние компоненты только для этой задачи.

Вот что вам нужно сделать:

1. Создайте канал, который вы будете использовать в качестве канала связи между двумя процессами.
2. Создайте процесс gbak и сделайте так, чтобы его стандартный вывод был концом канала для записи.
3. Читать с читаемого конца канала.

Вот простая демонстрационная программа:

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes, Windows;

procedure ReadOutputFromExternalProcess(const ApplicationName, CommandLine: string; Stream: TStream);
const
  PipeSecurityAttributes: TSecurityAttributes = (
    nLength: SizeOf(PipeSecurityAttributes);
    bInheritHandle: True
  );
var
  hstdoutr, hstdoutw: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  lpApplicationName: PChar;
  ModfiableCommandLine: string;
  Buffer: array [0..4096-1] of Byte;
  BytesRead: DWORD;
begin
  if ApplicationName='' then begin
    lpApplicationName := nil;
  end else begin
    lpApplicationName := PChar(ApplicationName);
  end;

  ModfiableCommandLine := CommandLine;
  UniqueString(ModfiableCommandLine);

  Win32Check(CreatePipe(hstdoutr, hstdoutw, @PipeSecurityAttributes, 0));
  Try
    Win32Check(SetHandleInformation(hstdoutr, HANDLE_FLAG_INHERIT, 0));//don't inherit read handle of pipe
    ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
    StartupInfo.cb := SizeOf(StartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo.wShowWindow := SW_HIDE;
    StartupInfo.hStdOutput := hstdoutw;
    StartupInfo.hStdError := hstdoutw;
    if not CreateProcess(
      lpApplicationName,
      PChar(ModfiableCommandLine),
      nil,
      nil,
      True,
      CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
      nil,
      nil,
      StartupInfo,
      ProcessInfo
    ) then begin
      RaiseLastOSError;
    end;
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(hstdoutw);//close the write end of the pipe so that the process is able to terminate
    hstdoutw := 0;
    while ReadFile(hstdoutr, Buffer, SizeOf(Buffer), BytesRead, nil) and (BytesRead<>0) do begin
      Stream.WriteBuffer(Buffer, BytesRead);
    end;
  Finally
    CloseHandle(hstdoutr);
    if hstdoutw<>0 then begin
      CloseHandle(hstdoutw);
    end;
  End;
end;

procedure Test;
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create('C:\Desktop\out.txt', fmCreate);
  Try
    ReadOutputFromExternalProcess('', 'cmd /c dir /s C:\Windows\system32', Stream);
  Finally
    Stream.Free;
  End;
end;

begin
  Test;
end.