codice:
procedure TRedirector.ReadStdOutput;
var
BytesRead: DWord;
Buffer: Pointer;
begin
GetMem(Buffer, FAvailable);
try
if not ReadFile(FPipeOutput.hRead, Buffer^, FAvailable, BytesRead, nil) then
begin
FThread.Terminate;
WinError('Error reading STDOUT pipe : ');
end;
if Assigned(FOnData) then
FOnData(Self, Buffer, BytesRead);
finally
FreeMem(Buffer);
end;
end;
procedure TRedirector.ReadStdError;
var
BytesRead: DWord;
Buffer: Pointer;
begin
GetMem(Buffer, FAvailable);
try
if not ReadFile(FPipeError.hRead, Buffer^, FAvailable, BytesRead, nil) then
begin
FThread.Terminate;
WinError('Error reading STDERR pipe : ');
end;
if Assigned(FOnErrorData) then
FOnErrorData(Self, Buffer, BytesRead);
finally
FreeMem(Buffer);
end;
end;
procedure TRedirector.ProcessTerminated;
begin
FThread.Terminate;
ClosePipes;
CloseHandle(FProcessInfo.hProcess);
CloseHandle(FProcessInfo.hThread);
FillChar(FProcessInfo, SizeOf(FProcessInfo), 0);
if Assigned(FOnTerminated) then FOnTerminated(Self); //-- moved from 2nd line to last line! (hdo, 2001-09-02)
end;
////////////////////////////////////////////////////////////////////////////////
// Public methods
////////////////////////////////////////////////////////////////////////////////
procedure TRedirector.Terminate(dwExitCode: Integer);
begin
if Running
then
TerminateProcess(ProcessHandle, dwExitCode)
else
Error('Cannot Terminate an inactive process');
end;
procedure TRedirector.Execute;
var
StartupInfo: TStartupInfo;
szExecutable, szCommandline, szDirectory: PChar;
liPriorityClass: Integer;
begin
if Running then Error('Process is already active');
if Trim(CommandLine) = '' then Error('No commandline to run');
FLastData := false;
try
CreatePipes;
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.wShowWindow := FShowWindow;
StartupInfo.hStdInput := FPipeInput.hRead;
StartupInfo.hStdOutput := FPipeOutput.hWrite;
StartupInfo.hStdError := FPipeError.hWrite;
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
if Trim(Executable) = '' then
szExecutable := nil
else
szExecutable := PChar(FExecutable);
if Trim(Commandline) = '' then
szCommandline := nil
else
szCommandline := PChar(FCommandline);
if Trim(Directory) = '' then
szDirectory := nil
else
szDirectory := PChar(FDirectory);
liPriorityClass := 0;
case FInitialPriority of
pcIdle: liPriorityClass := IDLE_PRIORITY_CLASS;
pcNormal: liPriorityClass := NORMAL_PRIORITY_CLASS;
pcHigh: liPriorityClass := HIGH_PRIORITY_CLASS;
pcRealtime: liPriorityClass := REALTIME_PRIORITY_CLASS;
end;
if CreateProcess(szExecutable, szCommandline, nil, nil, true,
(CREATE_DEFAULT_ERROR_MODE and Integer(FDefaultErrorMode))
or (CREATE_SUSPENDED and Integer(FStartSuspended) or liPriorityClass),
Environment, szDirectory, StartupInfo, FProcessInfo)
then
begin
FThread := TRedirectorThread.Create(Self);
end
else
WinError('Error creating process : ');
except
on Exception do
begin
ClosePipes;
CloseHandle(FProcessInfo.hProcess);
CloseHandle(FProcessInfo.hThread);
FillChar(FProcessInfo, SizeOf(FProcessInfo), 0);
raise;
end;
end;
end;
procedure TRedirector.SendData(Buffer: Pointer; BufferSize: Integer);
var
BytesWritten: DWord;
begin
if not Running then Error('Can''t send data to an inactive process');
if not WriteFile(FPipeInput.hWrite, Buffer^, BufferSize, BytesWritten, nil)
then WinError('Error writing to STDIN pipe : ');
end;
procedure TRedirector.SendText(s: string);
begin
SendData(PChar(s), Length(s));
end;
destructor TRedirector.Destroy;
begin
if Running and KillOnDestroy then
begin
FOnTerminated := nil;
FThread.Terminate;
Terminate(0);
end;
inherited Destroy;
end;
constructor TRedirectorThread.Create(ARedirector: TRedirector);
begin
FRedirector := ARedirector;
inherited Create(false);
end;
procedure TRedirectorThread.Execute;
var
Idle: Boolean;
begin
FreeOnTerminate := true;
repeat
Idle := true;
//-- check for StdOutout-Pipe
if PeekNamedPipe(FRedirector.FPipeOutput.hRead, nil, 0, nil,
@FRedirector.FAvailable, nil) and (FRedirector.FAvailable > 0) then
begin
Synchronize(FRedirector.ReadStdOutput);
Idle := false;
end;
//-- check for StdErr-Pipe
if PeekNamedPipe(FRedirector.FPipeError.hRead, nil, 0, nil,
@FRedirector.FAvailable, nil) and (FRedirector.FAvailable > 0) then
begin
Synchronize(FRedirector.ReadStdError);
Idle := false;
end;
//-- check if process terminated
if Idle and (WaitForSingleObject(FRedirector.ProcessHandle,
100) = WAIT_OBJECT_0) then
begin
FRedirector.FLastData := true;
//-- process has finished, read pipes until they are empty
repeat
Idle := true;
//-- check for StdOutout-Pipe a last time
if PeekNamedPipe(FRedirector.FPipeOutput.hRead, nil, 0, nil,
@FRedirector.FAvailable, nil) and (FRedirector.FAvailable > 0) then
begin
Synchronize(FRedirector.ReadStdOutput);
Idle := false;
end;
//-- check for StdErr-Pipe a last time
if PeekNamedPipe(FRedirector.FPipeError.hRead, nil, 0, nil,
@FRedirector.FAvailable, nil) and (FRedirector.FAvailable > 0) then
begin
Synchronize(FRedirector.ReadStdError);
Idle := false;
end;
until Idle;
//-- self-destruct
if not Terminated then Synchronize(FRedirector.ProcessTerminated);
end;
until Terminated and Idle;
end;
end.
Salva il tutto in un file redirect.pas ed usa i metodi della classe TRedirector.
Rispondi quotando
