ProcessUnit.pas 6.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281
  1. unit ProcessUnit;
  2. interface
  3. uses
  4. HandleWaitThreadUnit, FileReadToBufferThreadUnit,
  5. Windows, Classes;
  6. type
  7. TRedirect = class;
  8. TProcessConsole = class(TObject)
  9. private
  10. FTitle: string;
  11. FProcessInfo: TProcessInformation;
  12. FStdOut: TRedirect;
  13. FStdErr: TRedirect;
  14. FWaitThread: THandleWaitThread;
  15. FPriorityClass: DWord;
  16. function GetLastOutText: string;
  17. function GetLastErrText: string;
  18. function GetRunning: Boolean;
  19. function GetLastErrSize: Integer;
  20. function GetLastOutSize: Integer;
  21. protected
  22. property StdOut: TRedirect read FStdOut;
  23. property StdErr: TRedirect read FStdErr;
  24. property ProcessInfo: TProcessInformation read FProcessInfo;
  25. property WaitThread: THandleWaitThread read FWaitThread;
  26. public
  27. constructor Create;
  28. destructor Destroy; override;
  29. procedure StartProcess(const ProgramFile, Parameters, HomeDir: string);
  30. procedure KillProcess;
  31. procedure KillProcessAndWait;
  32. procedure WaitForTermination;
  33. property Running: Boolean read GetRunning;
  34. property LastOutText: string read GetLastOutText;
  35. property LastErrText: string read GetLastErrText;
  36. property LastOutSize: Integer read GetLastOutSize;
  37. property LastErrSize: Integer read GetLastErrSize;
  38. published
  39. property Title: string read FTitle write FTitle;
  40. property PriorityClass: DWord read FPriorityClass write FPriorityClass;
  41. end;
  42. TRedirect = class(TObject)
  43. private
  44. FProgramOutputHandle: HFile;
  45. FPipe: HFile;
  46. FThread: TFileReadToBufferThread;
  47. FStream: TMemoryStream;
  48. FFinish: Boolean;
  49. function GetText: string;
  50. function GetOutputSize: Integer;
  51. public
  52. constructor Create;
  53. destructor Destroy; override;
  54. procedure Clear;
  55. procedure Finish;
  56. property Stream: TMemoryStream read FStream;
  57. property Thread: TFileReadToBufferThread read FThread;
  58. property Pipe: HFile read FPipe;
  59. property ProgramOutputHandle: HFile read FProgramOutputHandle;
  60. property Text: string read GetText;
  61. property OutputSize: Integer read GetOutputSize;
  62. end;
  63. implementation
  64. uses
  65. SysUtils, UtilsWin;
  66. { TProcessConsole }
  67. constructor TProcessConsole.Create;
  68. begin
  69. inherited;
  70. FStdOut := TRedirect.Create;
  71. FStdErr := TRedirect.Create;
  72. Title := 'Console';
  73. PriorityClass := HIGH_PRIORITY_CLASS;
  74. end;
  75. destructor TProcessConsole.Destroy;
  76. begin
  77. KillProcessAndWait;
  78. FStdErr.Free;
  79. FStdOut.Free;
  80. inherited;
  81. end;
  82. function TProcessConsole.GetLastErrSize: Integer;
  83. begin
  84. Result := StdErr.OutputSize;
  85. end;
  86. function TProcessConsole.GetLastErrText: string;
  87. begin
  88. Result := StdErr.Text;
  89. end;
  90. function TProcessConsole.GetLastOutSize: Integer;
  91. begin
  92. Result := StdOut.OutputSize;
  93. end;
  94. function TProcessConsole.GetLastOutText: string;
  95. begin
  96. Result := StdOut.Text;
  97. end;
  98. function TProcessConsole.GetRunning: Boolean;
  99. var
  100. T: TThread;
  101. begin
  102. if Assigned (WaitThread) then begin
  103. Result := not WaitThread.HasTerminated;
  104. if not Result then begin
  105. T := FWaitThread;
  106. FWaitThread := nil;
  107. T.Free;
  108. with FProcessInfo do begin
  109. CloseHandle (hProcess);
  110. CloseHandle (hThread);
  111. hProcess := 0;
  112. hThread := 0;
  113. end;
  114. StdOut.Finish;
  115. StdErr.Finish;
  116. end;
  117. end else
  118. Result := False;
  119. end;
  120. procedure TProcessConsole.KillProcess;
  121. begin
  122. if Running then begin
  123. TerminateProcess (ProcessInfo.hProcess, 1);
  124. if Assigned (WaitThread) then
  125. WaitThread.Terminate;
  126. end;
  127. end;
  128. procedure TProcessConsole.KillProcessAndWait;
  129. begin
  130. KillProcess;
  131. WaitForTermination;
  132. end;
  133. procedure TProcessConsole.StartProcess(const ProgramFile, Parameters, HomeDir: string);
  134. var
  135. StartupInfo: TStartupInfo;
  136. CommandLine: string;
  137. HomeDirPC: PChar;
  138. begin
  139. if Running then
  140. raise EFOpenError.CreateFmt ('Another process is still running', [])
  141. else begin
  142. StdOut.Clear;
  143. StdErr.Clear;
  144. FillChar (StartupInfo, SizeOf (StartupInfo), 0);
  145. with StartupInfo do begin
  146. cb := SizeOf (StartupInfo);
  147. lpTitle := PChar (Title);
  148. wShowWindow := sw_Hide;
  149. hStdOutput := StdOut.ProgramOutputHandle;
  150. hStdError := StdErr.ProgramOutputHandle;
  151. dwFlags := StartF_UseShowWindow or StartF_UseStdHandles;
  152. end;
  153. if Length (ProgramFile) > 0 then
  154. CommandLine := '"' + ProgramFile + '" ' + Parameters
  155. else
  156. CommandLine := Parameters;
  157. if Length (HomeDir) > 0 then
  158. HomeDirPC := PChar (HomeDir)
  159. else
  160. HomeDirPC := nil;
  161. if CreateProcess (nil, PChar (CommandLine), nil, nil, True, PriorityClass, nil, HomeDirPC, StartupInfo, FProcessInfo) then begin
  162. FWaitThread := THandleWaitThread.Create (ProcessInfo.hProcess);
  163. end else
  164. raise EFOpenError.CreateFmt ('Could not start process', []);
  165. end;
  166. end;
  167. procedure TProcessConsole.WaitForTermination;
  168. begin
  169. if Assigned (WaitThread) then
  170. WaitThread.WaitFor;
  171. end;
  172. { TRedirect }
  173. procedure TRedirect.Clear;
  174. begin
  175. FFinish := False;
  176. Thread.Lock.BeginWrite;
  177. Stream.Clear;
  178. Thread.Lock.EndWrite;
  179. end;
  180. constructor TRedirect.Create;
  181. var
  182. Attr: TSecurityAttributes;
  183. TempPipe: HFile;
  184. begin
  185. inherited;
  186. FillChar (Attr, SizeOf (Attr), 0);
  187. with Attr do begin
  188. nLength := SizeOf (Attr);
  189. lpSecurityDescriptor := nil;
  190. bInheritHandle := True;
  191. end;
  192. CreatePipe (TempPipe, FProgramOutputHandle, @Attr, 0);
  193. DuplicateHandle (GetCurrentProcess, TempPipe, GetCurrentProcess, @FPipe, 0, False, Duplicate_Close_Source or Duplicate_Same_Access);
  194. FStream := TMemoryStream.Create;
  195. FThread := TFileReadToBufferThread.Create (Pipe, Stream);
  196. end;
  197. destructor TRedirect.Destroy;
  198. begin
  199. if Assigned (Thread) then
  200. Thread.Terminate;
  201. Finish;
  202. CloseHandle (FProgramOutputHandle);
  203. if Assigned (Thread) then begin
  204. Thread.WaitFor;
  205. FThread.Free;
  206. end;
  207. if Assigned (Stream) then
  208. FStream.Free;
  209. CloseHandle (FPipe);
  210. inherited;
  211. end;
  212. procedure TRedirect.Finish;
  213. const
  214. B: Byte = 0;
  215. var
  216. BW: Cardinal;
  217. begin
  218. if not FFinish then begin
  219. FFinish := True;
  220. WriteFile (ProgramOutputHandle, B, 1, BW, nil);
  221. end;
  222. end;
  223. function TRedirect.GetOutputSize: Integer;
  224. begin
  225. Thread.Lock.BeginRead;
  226. Result := Stream.Size;
  227. Thread.Lock.EndRead;
  228. end;
  229. function TRedirect.GetText: string;
  230. var
  231. Finished: Boolean;
  232. begin
  233. if FFinish then begin
  234. repeat
  235. Thread.Lock.BeginRead;
  236. with Stream do
  237. Finished := (Size > 0) and (PChar(Memory) [Size - 1] = #0);
  238. Thread.Lock.EndRead;
  239. if not Finished then
  240. Sleep (100);
  241. until Finished;
  242. Result := AnsiString (PChar (Stream.Memory));
  243. end else begin
  244. Thread.Lock.BeginWrite;
  245. with Stream do begin
  246. Size := Size + 1;
  247. PChar(Memory) [Size - 1] := #0;
  248. Result := AnsiString (PChar (Memory));
  249. Size := Size - 1;
  250. end;
  251. Thread.Lock.EndWrite;
  252. end;
  253. end;
  254. end.