unit UnitRedirect;
// This is an example application to demonstrate the use of pipes
// to redirect the input/output of a console application.
// The function "Sto_RedirectedExecute" was written by Martin Stoeckli
// and is part of the site:
// http://www.martinstoeckli.ch/delphi/
//
interface
uses Windows, Classes;
/// <summary>
/// Runs a console application and captures the stdoutput and
/// stderror.</summary>
/// <param name="CmdLine">The commandline contains the full path to
/// the executable and the necessary parameters. Don't forget to
/// quote filenames with "" if the path contains spaces.</param>
/// <param name="Output">Receives the console stdoutput.</param>
/// <param name="Error">Receives the console stderror.</param>
/// <param name="Input">Send to stdinput of the process.</param>
/// <param name="Wait">[milliseconds] Maximum of time to wait,
/// until application has finished. After reaching this timeout,
/// the application will be terminated and False is returned as
/// result.</param>
/// <returns>True if process could be started and did not reach the
/// timeout.</returns>
function Sto_RedirectedExecute(const CmdLine: String;
var Output, Error: String; const Input: String = '';
const Wait: DWORD = 3600000): Boolean;
implementation
type
TStoReadPipeThread = class(TThread)
protected
FPipe: THandle;
FContent: TStringStream;
function Get_Content: String;
procedure Execute; override;
public
constructor Create(const Pipe: THandle);
destructor Destroy; override;
property Content: String read Get_Content;
end;
TStoWritePipeThread = class(TThread)
protected
FPipe: THandle;
FContent: TStringStream;
procedure Execute; override;
public
constructor Create(const Pipe: THandle; const Content: String);
destructor Destroy; override;
end;
constructor TStoReadPipeThread.Create(const Pipe: THandle);
begin
FPipe := Pipe;
FContent := TStringStream.Create('');
inherited Create(True);
end;
destructor TStoReadPipeThread.Destroy;
begin
FContent.Free;
inherited Destroy;
end;
procedure TStoReadPipeThread.Execute;
const
BLOCK_SIZE = 4096;
var
iBytesRead: DWORD;
myBuffer: array[0..BLOCK_SIZE-1] of Byte;
begin
repeat
// try to read from pipe
if ReadFile(FPipe, myBuffer, BLOCK_SIZE, iBytesRead, nil) then
FContent.Write(myBuffer, iBytesRead);
// a process may write less than BLOCK_SIZE, even if not at the end
// of the output, so checking for < BLOCK_SIZE would block the pipe.
until (iBytesRead = 0);
end;
function TStoReadPipeThread.Get_Content: String;
begin
Result := FContent.DataString;
end;
{ TStoWritePipeThread }
constructor TStoWritePipeThread.Create(const Pipe: THandle;
const Content: String);
begin
FPipe := Pipe;
FContent := TStringStream.Create(Content);
inherited Create(True);
end;
destructor TStoWritePipeThread.Destroy;
begin
if (FPipe <> 0) then
CloseHandle(FPipe);
FContent.Free;
inherited Destroy;
end;
procedure TStoWritePipeThread.Execute;
const
BLOCK_SIZE = 4096;
var
iBytesToWrite: DWORD;
iBytesWritten: DWORD;
myBuffer: array[0..BLOCK_SIZE-1] of Byte;
begin
iBytesToWrite := FContent.Read(myBuffer, BLOCK_SIZE);
while (iBytesToWrite > 0) do
begin
WriteFile(FPipe, myBuffer, iBytesToWrite, iBytesWritten, nil);
iBytesToWrite := FContent.Read(myBuffer, BLOCK_SIZE);
end;
// close our handle to let the other process know, that
// there won't be any more data.
CloseHandle(FPipe);
FPipe := 0;
end;
function Sto_RedirectedExecute(const CmdLine: String;
var Output, Error: String; const Input: String = '';
const Wait: DWORD = 3600000): Boolean;
var
mySecurityAttributes: SECURITY_ATTRIBUTES;
myStartupInfo: STARTUPINFO;
myProcessInfo: PROCESS_INFORMATION;
hPipeInputRead, hPipeInputWrite: THandle;
hPipeOutputRead, hPipeOutputWrite: THandle;
hPipeErrorRead, hPipeErrorWrite: THandle;
myWriteInputThread: TStoWritePipeThread;
myReadOutputThread: TStoReadPipeThread;
myReadErrorThread: TStoReadPipeThread;
iWaitRes: Integer;
sCmdLine: String;
begin
// prepare security structure
ZeroMemory(@mySecurityAttributes, SizeOf(SECURITY_ATTRIBUTES));
mySecurityAttributes.nLength := SizeOf(SECURITY_ATTRIBUTES);
mySecurityAttributes.bInheritHandle := TRUE;
// create pipe to set stdinput
hPipeInputRead := 0;
hPipeInputWrite := 0;
if (Input <> '') then
CreatePipe(hPipeInputRead, hPipeInputWrite, @mySecurityAttributes, 0);
// create pipes to get stdoutput and stderror
CreatePipe(hPipeOutputRead, hPipeOutputWrite, @mySecurityAttributes, 0);
CreatePipe(hPipeErrorRead, hPipeErrorWrite, @mySecurityAttributes, 0);
// prepare startupinfo structure
ZeroMemory(@myStartupInfo, SizeOf(STARTUPINFO));
myStartupInfo.cb := Sizeof(STARTUPINFO);
// hide application
myStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
myStartupInfo.wShowWindow := SW_HIDE;
// assign pipes
myStartupInfo.dwFlags := myStartupInfo.dwFlags or STARTF_USESTDHANDLES;
myStartupInfo.hStdInput := hPipeInputRead;
myStartupInfo.hStdOutput := hPipeOutputWrite;
myStartupInfo.hStdError := hPipeErrorWrite;
// since CreateProcess can map to the unicode version
// "CreateProcessW" we cannot pass a literal string anymore.
sCmdLine := CmdLine;
UniqueString(sCmdLine);
// start the process
Result := CreateProcess(nil, PChar(sCmdLine), nil, nil, True,
CREATE_NEW_CONSOLE, nil, nil, myStartupInfo, myProcessInfo);
// close the ends of the pipes, now used by the process
CloseHandle(hPipeInputRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorWrite);
// could process be started ?
if Result then
begin
myWriteInputThread := nil;
if (hPipeInputWrite <> 0) then
myWriteInputThread := TStoWritePipeThread.Create(hPipeInputWrite, Input);
myReadOutputThread := TStoReadPipeThread.Create(hPipeOutputRead);
myReadErrorThread := TStoReadPipeThread.Create(hPipeErrorRead);
try
// start threads for reading the output pipes
if (myWriteInputThread <> nil) then
myWriteInputThread.Execute;
myReadOutputThread.Execute;
myReadErrorThread.Execute;
// wait unitl there is no more data to receive, or the timeout is reached
iWaitRes := WaitForSingleObject(myProcessInfo.hProcess, Wait);
// timeout reached ?
if (iWaitRes = WAIT_TIMEOUT) then
begin
Result := False;
TerminateProcess(myProcessInfo.hProcess, UINT(ERROR_CANCELLED));
end;
// return output
Output := myReadOutputThread.Content;
Error := myReadErrorThread.Content;
finally
myWriteInputThread.Free;
myReadOutputThread.Free;
myReadErrorThread.Free;
CloseHandle(myProcessInfo.hThread);
CloseHandle(myProcessInfo.hProcess);
end;
end;
// close our ends of the pipes
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeErrorRead);
end;
end.
¤ Dauer der Verarbeitung: 0.27 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
