123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281 |
- unit ProcessUnit;
- interface
- uses
- HandleWaitThreadUnit, FileReadToBufferThreadUnit,
- Windows, Classes;
- type
- TRedirect = class;
- TProcessConsole = class(TObject)
- private
- FTitle: string;
- FProcessInfo: TProcessInformation;
- FStdOut: TRedirect;
- FStdErr: TRedirect;
- FWaitThread: THandleWaitThread;
- FPriorityClass: DWord;
- function GetLastOutText: string;
- function GetLastErrText: string;
- function GetRunning: Boolean;
- function GetLastErrSize: Integer;
- function GetLastOutSize: Integer;
- protected
- property StdOut: TRedirect read FStdOut;
- property StdErr: TRedirect read FStdErr;
- property ProcessInfo: TProcessInformation read FProcessInfo;
- property WaitThread: THandleWaitThread read FWaitThread;
- public
- constructor Create;
- destructor Destroy; override;
- procedure StartProcess(const ProgramFile, Parameters, HomeDir: string);
- procedure KillProcess;
- procedure KillProcessAndWait;
- procedure WaitForTermination;
- property Running: Boolean read GetRunning;
- property LastOutText: string read GetLastOutText;
- property LastErrText: string read GetLastErrText;
- property LastOutSize: Integer read GetLastOutSize;
- property LastErrSize: Integer read GetLastErrSize;
- published
- property Title: string read FTitle write FTitle;
- property PriorityClass: DWord read FPriorityClass write FPriorityClass;
- end;
- TRedirect = class(TObject)
- private
- FProgramOutputHandle: HFile;
- FPipe: HFile;
- FThread: TFileReadToBufferThread;
- FStream: TMemoryStream;
- FFinish: Boolean;
- function GetText: string;
- function GetOutputSize: Integer;
- public
- constructor Create;
- destructor Destroy; override;
- procedure Clear;
- procedure Finish;
- property Stream: TMemoryStream read FStream;
- property Thread: TFileReadToBufferThread read FThread;
- property Pipe: HFile read FPipe;
- property ProgramOutputHandle: HFile read FProgramOutputHandle;
- property Text: string read GetText;
- property OutputSize: Integer read GetOutputSize;
- end;
- implementation
- uses
- SysUtils, UtilsWin;
- { TProcessConsole }
- constructor TProcessConsole.Create;
- begin
- inherited;
- FStdOut := TRedirect.Create;
- FStdErr := TRedirect.Create;
- Title := 'Console';
- PriorityClass := HIGH_PRIORITY_CLASS;
- end;
- destructor TProcessConsole.Destroy;
- begin
- KillProcessAndWait;
- FStdErr.Free;
- FStdOut.Free;
- inherited;
- end;
- function TProcessConsole.GetLastErrSize: Integer;
- begin
- Result := StdErr.OutputSize;
- end;
- function TProcessConsole.GetLastErrText: string;
- begin
- Result := StdErr.Text;
- end;
- function TProcessConsole.GetLastOutSize: Integer;
- begin
- Result := StdOut.OutputSize;
- end;
- function TProcessConsole.GetLastOutText: string;
- begin
- Result := StdOut.Text;
- end;
- function TProcessConsole.GetRunning: Boolean;
- var
- T: TThread;
- begin
- if Assigned (WaitThread) then begin
- Result := not WaitThread.HasTerminated;
- if not Result then begin
- T := FWaitThread;
- FWaitThread := nil;
- T.Free;
- with FProcessInfo do begin
- CloseHandle (hProcess);
- CloseHandle (hThread);
- hProcess := 0;
- hThread := 0;
- end;
- StdOut.Finish;
- StdErr.Finish;
- end;
- end else
- Result := False;
- end;
- procedure TProcessConsole.KillProcess;
- begin
- if Running then begin
- TerminateProcess (ProcessInfo.hProcess, 1);
- if Assigned (WaitThread) then
- WaitThread.Terminate;
- end;
- end;
- procedure TProcessConsole.KillProcessAndWait;
- begin
- KillProcess;
- WaitForTermination;
- end;
- procedure TProcessConsole.StartProcess(const ProgramFile, Parameters, HomeDir: string);
- var
- StartupInfo: TStartupInfo;
- CommandLine: string;
- HomeDirPC: PChar;
- begin
- if Running then
- raise EFOpenError.Create ('Another process is still running')
- else begin
- StdOut.Clear;
- StdErr.Clear;
- FillChar (StartupInfo, SizeOf (StartupInfo), 0);
- with StartupInfo do begin
- cb := SizeOf (StartupInfo);
- lpTitle := PChar (Title);
- wShowWindow := sw_Hide;
- hStdOutput := StdOut.ProgramOutputHandle;
- hStdError := StdErr.ProgramOutputHandle;
- dwFlags := StartF_UseShowWindow or StartF_UseStdHandles;
- end;
- if Length (ProgramFile) > 0 then
- CommandLine := '"' + ProgramFile + '" ' + Parameters
- else
- CommandLine := Parameters;
- if Length (HomeDir) > 0 then
- HomeDirPC := PChar (HomeDir)
- else
- HomeDirPC := nil;
- if CreateProcess (nil, PChar (CommandLine), nil, nil, True, PriorityClass, nil, HomeDirPC, StartupInfo, FProcessInfo) then begin
- FWaitThread := THandleWaitThread.Create (ProcessInfo.hProcess);
- end else
- raise EFOpenError.Create ('Could not start process');
- end;
- end;
- procedure TProcessConsole.WaitForTermination;
- begin
- if Assigned (WaitThread) then
- WaitThread.WaitFor;
- end;
- { TRedirect }
- procedure TRedirect.Clear;
- begin
- FFinish := False;
- Thread.Lock.BeginWrite;
- Stream.Clear;
- Thread.Lock.EndWrite;
- end;
- constructor TRedirect.Create;
- var
- Attr: TSecurityAttributes;
- TempPipe: HFile;
- begin
- inherited;
- FillChar (Attr, SizeOf (Attr), 0);
- with Attr do begin
- nLength := SizeOf (Attr);
- lpSecurityDescriptor := nil;
- bInheritHandle := True;
- end;
- CreatePipe (TempPipe, FProgramOutputHandle, @Attr, 0);
- DuplicateHandle (GetCurrentProcess, TempPipe, GetCurrentProcess, @FPipe, 0, False, Duplicate_Close_Source or Duplicate_Same_Access);
- FStream := TMemoryStream.Create;
- FThread := TFileReadToBufferThread.Create (Pipe, Stream);
- end;
- destructor TRedirect.Destroy;
- begin
- if Assigned (Thread) then
- Thread.Terminate;
- Finish;
- CloseHandle (FProgramOutputHandle);
- if Assigned (Thread) then begin
- Thread.WaitFor;
- FThread.Free;
- end;
- if Assigned (Stream) then
- FStream.Free;
- CloseHandle (FPipe);
- inherited;
- end;
- procedure TRedirect.Finish;
- const
- B: Byte = 0;
- var
- BW: Cardinal;
- begin
- if not FFinish then begin
- FFinish := True;
- WriteFile (ProgramOutputHandle, B, 1, BW, nil);
- end;
- end;
- function TRedirect.GetOutputSize: Integer;
- begin
- Thread.Lock.BeginRead;
- Result := Stream.Size;
- Thread.Lock.EndRead;
- end;
- function TRedirect.GetText: string;
- var
- Finished: Boolean;
- begin
- if FFinish then begin
- repeat
- Thread.Lock.BeginRead;
- with Stream do
- Finished := (Size > 0) and (PChar(Memory) [Size - 1] = #0);
- Thread.Lock.EndRead;
- if not Finished then
- Sleep (100);
- until Finished;
- Result := AnsiString (PChar (Stream.Memory));
- end else begin
- Thread.Lock.BeginWrite;
- with Stream do begin
- Size := Size + 1;
- PChar(Memory) [Size - 1] := #0;
- Result := AnsiString (PChar (Memory));
- Size := Size - 1;
- end;
- Thread.Lock.EndWrite;
- end;
- end;
- end.
|