如何将二进制gbak输出重定向到Delphi流？

我希望Firebird备份工具gbak将其输出写入Delphi流（没有中间文件）。有一个命令行参数要写入标准输出，而不是文件。然后，我使用绝地的

JclSysUtils

中的

Execute

方法启动gbak并处理该输出

看起来是这样的：

procedure DoBackup;
var
  LBackupAbortFlag: Boolean;
  LBackupStream: TStringStream;
begin
  LBackupAbortFlag := False;
  LBackupStream := TStringStream.Create;
  try
    Execute('"C:\path to\gbak.exe" -b -t -v -user SYSDBA -pas "pw" <db> stdout',
      LBackupStream.WriteString, // Should process stdout (backup)
      SomeMemo.Lines.Append, // Should process stderr (log)
      True, // Backup is "raw"
      False, // Log is not
      @LBackupAbortFlag);
    LBackupStream.SaveToFile('C:\path to\output.fbk');
  finally
    LBackupStream.Free;
  end;
end;

{$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.

程序备份；
变量
LBackupAbortFlag：布尔值；
LBackupStream:TStringStream；
开始
LBackupAbortFlag:=False；
LBackupStream:=TStringStream.Create；
尝试
执行（''C:\path to\gbak.exe“-b-t-v-user SYSDBA-pas”pw“stdout”，
LBackupStream.WriteString，//应处理标准输出（备份）
SomeMemo.Lines.Append，//应处理stderr（日志）
True，//备份为“原始”
False，//日志不是
@LBackupAbortFlag）；
LBackupStream.SaveToFile（'C:\path to\output.fbk'）；
最后
lbackup.Free；
结束；
结束；

问题是输出文件太小，无法包含实际备份。我仍然可以看到文件内容的元素。我尝试了不同的流类型，但似乎没有什么不同。这里会出什么问题

更新

---

需要明确的是：也欢迎其他解决方案。最重要的是，我需要可靠的东西。这就是为什么我一开始就和绝地一起去，而不是重新发明这样的东西。如果不太复杂的话，那就好了。

我认为您的代码会失败，因为它试图通过面向文本的流来放置二进制数据。在任何情况下，只需几个Win32 API调用就可以解决您的问题。我看不出有任何令人信服的理由只为这项任务使用第三方组件

以下是您需要做的：

创建一个管道，用作两个进程之间的通信通道

创建gbak进程并将其标准输出安排为管道的写入端

从管道的读取端读取

下面是一个简单的演示程序：

{$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.

{$APPTYPE控制台}
使用
系统、类、窗口；
过程ReadOutputFromExternalProcess（常量应用程序名，命令行：字符串；流：TStream）；
常数
PipeSecurityAttributes:TSecurityAttributes=(
nLength:SizeOf（PipeSecurityAttributes）；
宾汉庄园：是的
);
变量
hstdoutr，hstdoutw:THandle；
StartupInfo:TStartupInfo；
ProcessInfo:TProcessInformation；
lpApplicationName:PChar；
ModfiableCommandLine：字符串；
缓冲区：字节数组[0..4096-1]；
拜特斯拉德：德沃德；
开始
如果ApplicationName=''，则开始
lpApplicationName:=nil；
结束，否则开始
lpApplicationName:=PChar（ApplicationName）；
结束；
ModfiableCommandLine:=命令行；
唯一字符串（ModfiableCommandLine）；
Win32Check（CreatePipe（hstdoutr，hstdoutw，@PipeSecurityAttributes，0））；
尝试
Win32Check（SetHandleInformation（hstdoutr，HANDLE\u FLAG\u INHERIT，0））//不继承管道的读取句柄
零内存（@StartupInfo，SizeOf（StartupInfo））；
StartupInfo.cb:=SizeOf（StartupInfo）；
StartupInfo.dwFlags:=STARTF_USESHOWWINDOW或STARTF_USESTDHANDLES；
StartupInfo.wShowWindow:=SW_HIDE；
StartupInfo.hst输出：=hst输出；
StartupInfo.hStdError:=hstdoutw；
如果不是，则创建进程(
lpApplicationName，
PChar（ModfiableCommandLine），
无
无
是的，
创建\u无\u窗口或普通\u优先级\u类，
无
无
StartupInfo，
ProcessInfo
)然后开始
赖斯·塞罗；
结束；
CloseHandle（ProcessInfo.hproces）；
CloseHandle（ProcessInfo.hThread）；
闭合手柄（hstdoutw）//关闭管道的写入端，以便进程能够终止
hstdoutw:=0；
而ReadFile（hstdoutr、Buffer、SizeOf（Buffer）、BytesRead、nil）和（BytesRead0）确实开始
Stream.WriteBuffer（缓冲区，字节读取）；
结束；
最后
闭合手柄（hstdoutr）；
如果HST输出为0，则开始
闭合手柄（hstdoutw）；
结束；
结束；
结束；
程序测试；
变量
流：TFileStream；
开始
Stream:=TFileStream.Create（'C:\Desktop\out.txt'，fmCreate）；
尝试
ReadOutputFromExternalProcess（“”，'cmd/c dir/s c:\Windows\system32'，Stream）；
最后
免费；
结束；
结束；
开始
试验；
结束。

当您希望合并stdout和stderr时，我的第一个答案是有效的。然而，如果您需要将这些分开，那么这种方法是没有用的。通过仔细阅读您的问题和评论，我现在可以看出，您确实希望将两个输出流分开

现在，扩展我的第一个答案来涵盖这一点并不完全简单。问题是那里的代码使用阻塞I/O。如果您需要为两个管道提供服务，则存在明显的冲突。Windows中常用的解决方案是异步I/O，在Windows世界中称为重叠I/O。但是，异步I/O的实现要比阻塞I/O复杂得多

因此，我将提出一种仍然使用阻塞I/O的替代方法。如果我们想要为多个管道提供服务，并且我们想要使用阻塞I/O，那么显而易见的结论是，每个管道需要一个线程。这很容易实现——比异步选项容易得多。我们可以使用几乎相同的代码，但将阻塞读取循环移动到线程中。我的示例以这种方式重新工作，现在看起来如下所示：

procedure DoBackup;
var
  LBackupAbortFlag: Boolean;
  LBackupStream: TStringStream;
begin
  LBackupAbortFlag := False;
  LBackupStream := TStringStream.Create;
  try
    Execute('"C:\path to\gbak.exe" -b -t -v -user SYSDBA -pas "pw" <db> stdout',
      LBackupStream.WriteString, // Should process stdout (backup)
      SomeMemo.Lines.Append, // Should process stderr (log)
      True, // Backup is "raw"
      False, // Log is not
      @LBackupAbortFlag);
    LBackupStream.SaveToFile('C:\path to\output.fbk');
  finally
    LBackupStream.Free;
  end;
end;

{$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.

{$APPTYPE控制台}
使用
系统、类、窗口；
类型
TProcessOutputPipe=class
私有的
Frd:THandle；
Fwr:THandle；
公众的
构造函数创建；
毁灭者毁灭；推翻
房地产rd:THandle read Frd；
属性wr:THandle read Fwr；
程序关闭；
结束；
构造函数TProcessOutputPipe.Create；
常数
PipeSecurityAttributes:TSecurityAttributes=(
nLength:SizeOf（t安全属性）；
宾汉庄园：是的
);
开始
继承；
Win32Check（CreatePipe（Frd，Fwr，@PipeSecurityAttributes，0））；
Win32Check（SetHandleInformation（Frd，HANDLE\u FLAG\u INHERIT，0））//别生气