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 file. I then use the Execute
method in JEDI's JclSysUtils
to launch gbak and process that output.
It looks like this:
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;
The problem is that the output file is way too small to contain that actual backup. Still I see elements of the file's content. I tried different stream types, but that doesn't seem to make a difference. What could be going wrong here?
To be clear: other solutions are welcome as well. Most of all, I need something reliable. That's why I went with JEDI in the first place, not to reinvent such a thing. Then, it would be nice, if it would be not too complicated.
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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With