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.