Salva il tutto in un file redirect.pas ed usa i metodi della classe TRedirector.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.

Rispondi quotando