ProcessUnit.pas 7.1 KB

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