How to redirect binary gbak output to a Delphi stream?

Question

I want the Firebird backup tool gbak to write its output to a Delphi stream (with no intermediate file). There is a command line parameter to write to stdout rather than a f

Answer 1

I expect that your code is failing because it tries to put binary data through a text oriented stream. In any case, it's simple enough to solve your problem with a couple of Win32 API calls. I don't see any compelling reason to use third party components for just this task.

Here's what you need to do:

1. Create a pipe that you will use as a communication channel between the two processes.
2. Create the gbak process and arrange for its stdout to be the write end of the pipe.
3. Read from the read end of the pipe.

Here's a simple demonstration program:

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

Answer 2

My first answer is effective when you wish to merge stdout and stderr. However, if you need to keep these separate, that approach is no use. And I can now see, from a closer reading of your question, and your comments, that you do wish to keep the two output streams separate.

Now, it is not completely straightforward to extend my first answer to cover this. The problem is that the code there uses blocking I/O. And if you need to service two pipes, there is an obvious conflict. A commonly used solution in Windows is asynchronous I/O, known in the Windows world as overlapped I/O. However, asynchronous I/O is much more complex to implement than blocking I/O.

So, I'm going to propose an alternative approach that still uses blocking I/O. If we want to service multiple pipes, and we want to use blocking I/O then the obvious conclusion is that we need one thread for each pipe. This is easy to implement – much easier than the asynchronous option. We can use almost identical code but move the blocking read loops into threads. My example, re-worked in this way, now looks like this:

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

If you wish to add support for cancelling, then you would simply add in a call to TerminateProcess when the user cancelled. This would bring everything to a halt, and the function would return the exit code that you supplied to TerminateProcess. I'm hesitant right now to suggest a cancellation framework for you, but I think that the code in this answer is now pretty close to meeting your requirements.