1 | {
|
---|
2 | this component let you execute a dos program (exe, com or batch file) and catch
|
---|
3 | the ouput in order to put it in a memo or in a listbox, ...
|
---|
4 | you can also send inputs.
|
---|
5 | the cool thing of this component is that you do not need to wait the end of
|
---|
6 | the program to get back the output. it comes line by line.
|
---|
7 |
|
---|
8 |
|
---|
9 | *********************************************************************
|
---|
10 | ** maxime_collomb@yahoo.fr **
|
---|
11 | ** **
|
---|
12 | ** for this component, i just translated C code **
|
---|
13 | ** from Community.borland.com **
|
---|
14 | ** (http://www.vmlinux.org/jakov/community.borland.com/10387.html) **
|
---|
15 | ** **
|
---|
16 | ** if you have a good idea of improvement, please **
|
---|
17 | ** let me know (maxime_collomb@yahoo.fr). **
|
---|
18 | ** if you improve this component, please send me a copy **
|
---|
19 | ** so i can put it on www.torry.net. **
|
---|
20 | *********************************************************************
|
---|
21 |
|
---|
22 | History :
|
---|
23 | 2002-02-23 : tk
|
---|
24 |
|
---|
25 |
|
---|
26 | ---------
|
---|
27 | 18-05-2001 : version 2.0
|
---|
28 | - Now, catching the beginning of a line is allowed (usefull if the
|
---|
29 | prog ask for an entry) => the method OnNewLine is modified
|
---|
30 | - Now can send inputs
|
---|
31 | - Add a couple of FreeMem for sa & sd [thanks Gary H. Blaikie]
|
---|
32 | 07-05-2001 : version 1.2
|
---|
33 | - Sleep(1) is added to give others processes a chance
|
---|
34 | [thanks Hans-Georg Rickers]
|
---|
35 | - the loop that catch the outputs has been re-writen by
|
---|
36 | Hans-Georg Rickers => no more broken lines
|
---|
37 | 30-04-2001 : version 1.1
|
---|
38 | - function IsWinNT() is changed to
|
---|
39 | (Win32Platform = VER_PLATFORM_WIN32_NT) [thanks Marc Scheuner]
|
---|
40 | - empty lines appear in the redirected output
|
---|
41 | - property OutputLines is added to redirect output directly to a
|
---|
42 | memo, richedit, listbox, ... [thanks Jean-Fabien Connault]
|
---|
43 | - a timer is added to offer the possibility of ending the process
|
---|
44 | after XXX sec. after the beginning or YYY sec after the last
|
---|
45 | output [thanks Jean-Fabien Connault]
|
---|
46 | - managing process priorities flags in the CreateProcess
|
---|
47 | thing [thanks Jean-Fabien Connault]
|
---|
48 | 20-04-2001 : version 1.0 on www.torry.net
|
---|
49 | *******************************************************************
|
---|
50 | How to use it :
|
---|
51 | ---------------
|
---|
52 | - just put the line of command in the property 'CommandLine'
|
---|
53 | - execute the process with the method 'Execute'
|
---|
54 | - if you want to stop the process before it has ended, use the method 'Stop'
|
---|
55 | - if you want the process to stop by itself after XXX sec of activity,
|
---|
56 | use the property 'MaxTimeAfterBeginning'
|
---|
57 | - if you want the process to stop after XXX sec without an output,
|
---|
58 | use the property 'MaxTimeAfterLastOutput'
|
---|
59 | - to directly redirect outputs to a memo or a richedit, ...
|
---|
60 | use the property 'OutputLines'
|
---|
61 | (DosCommand1.OutputLnes := Memo1.Lines;)
|
---|
62 | - you can access all the outputs of the last command with the property 'Lines'
|
---|
63 | - you can change the priority of the process with the property 'Priority'
|
---|
64 | value of Priority must be in [HIGH_PRIORITY_CLASS, IDLE_PRIORITY_CLASS,
|
---|
65 | NORMAL_PRIORITY_CLASS, REALTIME_PRIORITY_CLASS]
|
---|
66 | - you can have an event for each new line and for the end of the process
|
---|
67 | with the events 'procedure OnNewLine(Sender: TObject; NewLine: string;
|
---|
68 | OutputType: TOutputType);' and 'procedure OnTerminated(Sender: TObject);'
|
---|
69 | - you can send inputs to the dos process with 'SendLine(Value: string;
|
---|
70 | Eol: Boolean);'. Eol is here to determine if the program have to add a
|
---|
71 | CR/LF at the end of the string.
|
---|
72 | *******************************************************************
|
---|
73 | How to call a dos function (win 9x/Me) :
|
---|
74 | ----------------------------------------
|
---|
75 |
|
---|
76 | Example : Make a dir :
|
---|
77 | ----------------------
|
---|
78 | - if you want to get the result of a 'c:\dir /o:gen /l c:\windows\*.txt'
|
---|
79 | for example, you need to make a batch file
|
---|
80 | --the batch file : c:\mydir.bat
|
---|
81 | @echo off
|
---|
82 | dir /o:gen /l %1
|
---|
83 | rem eof
|
---|
84 | --in your code
|
---|
85 | DosCommand.CommandLine := 'c:\mydir.bat c:\windows\*.txt';
|
---|
86 | DosCommand.Execute;
|
---|
87 |
|
---|
88 | Example : Format a disk (win 9x/Me) :
|
---|
89 | -------------------------
|
---|
90 | --a batch file : c:\myformat.bat
|
---|
91 | @echo off
|
---|
92 | format %1
|
---|
93 | rem eof
|
---|
94 | --in your code
|
---|
95 | var diskname: string;
|
---|
96 | --
|
---|
97 | DosCommand1.CommandLine := 'c:\myformat.bat a:';
|
---|
98 | DosCommand1.Execute; //launch format process
|
---|
99 | DosCommand1.SendLine('', True); //equivalent to press enter key
|
---|
100 | DiskName := 'test';
|
---|
101 | DosCommand1.SendLine(DiskName, True); //enter the name of the volume
|
---|
102 | *******************************************************************}
|
---|
103 |
|
---|
104 | unit DosCommand;
|
---|
105 |
|
---|
106 | interface
|
---|
107 |
|
---|
108 | uses
|
---|
109 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
|
---|
110 | Dialogs;
|
---|
111 |
|
---|
112 | type
|
---|
113 | TCreatePipeError = class(Exception); //exception raised when a pipe cannot be created
|
---|
114 | TCreateProcessError = class(Exception); //exception raised when the process cannot be created
|
---|
115 | TOutputType = (otEntireLine, otBeginningOfLine); //to know if the newline is finished.
|
---|
116 | TReturnCode = (rcCRLF, rcLF);
|
---|
117 |
|
---|
118 | TProcessTimer = class(TTimer) //timer for stopping the process after XXX sec
|
---|
119 | private
|
---|
120 | FSinceBeginning: Integer;
|
---|
121 | FSinceLastOutput: Integer;
|
---|
122 | procedure MyTimer(Sender: TObject);
|
---|
123 | public
|
---|
124 | constructor Create(AOwner: TComponent); override;
|
---|
125 | procedure Beginning; //call this at the beginning of a process
|
---|
126 | procedure NewOutput; //call this when a new output is received
|
---|
127 | procedure Ending; //call this when the process is terminated
|
---|
128 | property SinceBeginning: Integer read FSinceBeginning;
|
---|
129 | property SinceLastOutput: Integer read FSinceLastOutput;
|
---|
130 | end;
|
---|
131 |
|
---|
132 | TNewLineEvent = procedure(Sender: TObject; NewLine: string; OutputType: TOutputType) of object;
|
---|
133 | // ±ê(«)ÍsvÅÍÈ¢©HB
|
---|
134 | TTerminateEvent = procedure(Sender: TObject; ExitCode: LongWord) of object;
|
---|
135 |
|
---|
136 | TShowWindow = (swHIDE, swMAXIMIZE, swMINIMIZE, swRESTORE, swSHOW, swSHOWDEFAULT, swSHOWMAXIMIZED, swSHOWMINIMIZED, swSHOWMINNOACTIVE, swSHOWNA, swSHOWNOACTIVATE, swSHOWNORMAL);
|
---|
137 | TCreationFlag = (fCREATE_DEFAULT_ERROR_MODE, fCREATE_NEW_CONSOLE, fCREATE_NEW_PROCESS_GROUP, fCREATE_SEPARATE_WOW_VDM, fCREATE_SHARED_WOW_VDM, fCREATE_SUSPENDED, fCREATE_UNICODE_ENVIRONMENT, fDEBUG_PROCESS, fDEBUG_ONLY_THIS_PROCESS, fDETACHED_PROCESS);
|
---|
138 |
|
---|
139 | TDosThreadStatus = ( dtsAllocatingMemory , dtsAllocateMemoryFail ,
|
---|
140 | dtsCreatingPipes , dtsCreatePipesFail ,
|
---|
141 | dtsCreatingProcess , dtsCreateProcessFail ,
|
---|
142 | dtsRunning , dtsRunningError ,
|
---|
143 | dtsSuccess,
|
---|
144 | dtsUserAborted,
|
---|
145 | dtsTimeOut );
|
---|
146 |
|
---|
147 | TDosCommand = class;
|
---|
148 |
|
---|
149 | TDosThread = class(TThread) //the thread that is waiting for outputs through the pipe
|
---|
150 | private
|
---|
151 | FOwner: TDosCommand;
|
---|
152 | FCommandLine: string;
|
---|
153 | FTimer: TProcessTimer;
|
---|
154 | FMaxTimeAfterBeginning: Integer;
|
---|
155 | FMaxTimeAfterLastOutput: Integer;
|
---|
156 | FOnNewLine: TNewLineEvent;
|
---|
157 | FOnTerminated: TTerminateEvent;
|
---|
158 | FCreatePipeError: TCreatePipeError;
|
---|
159 | FCreateProcessError: TCreateProcessError;
|
---|
160 | FPriority: Integer;
|
---|
161 | FShowWindow: TShowWindow;
|
---|
162 | FCreationFlag: TCreationFlag;
|
---|
163 | //
|
---|
164 | FProcessInfo_SHARED: ^PROCESS_INFORMATION;
|
---|
165 | FOutputStr: String;
|
---|
166 | FOutputType: TOutputType;
|
---|
167 | procedure FExecute;
|
---|
168 | protected
|
---|
169 | procedure Execute; override; //call this to create the process
|
---|
170 | procedure AddString;
|
---|
171 | procedure AddString_SHARED(Str: string; OutType: TOutputType);
|
---|
172 | public
|
---|
173 | InputLines_SHARED: TstringList;
|
---|
174 | FLineBeginned: Boolean;
|
---|
175 | FActive: Boolean;
|
---|
176 | constructor Create( AOwner: TDosCommand );
|
---|
177 | end;
|
---|
178 |
|
---|
179 | TDosCommand = class(TComponent) //the component to put on a form
|
---|
180 | private
|
---|
181 | FTimer: TProcessTimer;
|
---|
182 | FThread: TDosThread;
|
---|
183 | FThreadStatus: TDosThreadStatus;
|
---|
184 | FCommandLine: string;
|
---|
185 | FLines_SHARED: TStringList;
|
---|
186 | FInputLines_SHARED: TStringList;
|
---|
187 | FOutputLines_SHARED: TStrings;
|
---|
188 | FInputToOutput: Boolean;
|
---|
189 | FOnNewLine: TNewLineEvent;
|
---|
190 | FOnTerminated: TTerminateEvent;
|
---|
191 | FMaxTimeAfterBeginning: Integer;
|
---|
192 | FMaxTimeAfterLastOutput: Integer;
|
---|
193 | FPriority: Integer; //[HIGH_PRIORITY_CLASS, IDLE_PRIORITY_CLASS,
|
---|
194 | // NORMAL_PRIORITY_CLASS, REALTIME_PRIORITY_CLASS]
|
---|
195 | FShowWindow: TShowWindow;
|
---|
196 | FCreationFlag: TCreationFlag;
|
---|
197 | FExitCode: Integer;
|
---|
198 | //
|
---|
199 | //
|
---|
200 | FProcessInfo_SHARED: PROCESS_INFORMATION;
|
---|
201 | FReturnCode: TReturnCode;
|
---|
202 | FOutputReturnCode: TReturnCode;
|
---|
203 | FSync :TMultiReadExclusiveWriteSynchronizer;
|
---|
204 |
|
---|
205 | function GetPrompting:boolean;
|
---|
206 | function GetActive:boolean;
|
---|
207 | function GetSinceBeginning: Integer;
|
---|
208 | function GetSinceLastOutput:integer;
|
---|
209 | procedure SetOutputLines_SHARED(Value: TStrings);
|
---|
210 | protected
|
---|
211 | { Déclarations protégées }
|
---|
212 | public
|
---|
213 | constructor Create(AOwner: TComponent); override;
|
---|
214 | destructor Destroy; override; //++ tk
|
---|
215 | procedure Execute; //the user call this to execute the command
|
---|
216 | function Execute2: Integer; //the user call this to execute the command
|
---|
217 | procedure Stop; //the user can stop the process with this method
|
---|
218 | procedure SendLine(Value: string; Eol: Boolean); //add a line in the input pipe
|
---|
219 | property OutputLines: TStrings read FOutputLines_SHARED write SetOutputLines_SHARED;
|
---|
220 | //can be Lines_SHARED of a memo, a richedit, a listbox, ...
|
---|
221 | property Lines: TStringList read FLines_SHARED;
|
---|
222 | //if the user want to access all the outputs of a process, he can use this property
|
---|
223 | property Priority: Integer read FPriority write FPriority; //priority of the process
|
---|
224 | property Active: Boolean read GetActive;
|
---|
225 | property Prompting:boolean read GetPrompting;
|
---|
226 | property SinceBeginning: Integer read GetSinceBeginning;
|
---|
227 | property SinceLastOutput:integer read GetSinceLastOutput;
|
---|
228 |
|
---|
229 | property ExitCode: Integer read FExitCode write FExitCode;
|
---|
230 | //
|
---|
231 | //
|
---|
232 | property ProcessInfo:PROCESS_INFORMATION read FProcessInfo_SHARED;
|
---|
233 | property ThreadStatus:TDosThreadStatus read FThreadStatus write FThreadStatus;
|
---|
234 | property Sync: TMultiReadExclusiveWriteSynchronizer read FSync;
|
---|
235 | published
|
---|
236 | property CommandLine: string read FCommandLine write FCommandLine;
|
---|
237 | //command to execute
|
---|
238 | property OnNewLine: TNewLineEvent read FOnNewLine write FOnNewLine;
|
---|
239 | //event for each new line that is received through the pipe
|
---|
240 | property OnTerminated: TTerminateEvent read FOnTerminated write FOnTerminated;
|
---|
241 | //event for the end of the process (normally, time out or by user (DosCommand.Stop;))
|
---|
242 | property InputToOutput: Boolean read FInputToOutput write FInputToOutput;
|
---|
243 | //check it if you want that the inputs appear also in the outputs
|
---|
244 | property MaxTimeAfterBeginning: Integer read FMaxTimeAfterBeginning
|
---|
245 | write FMaxTimeAfterBeginning; //maximum time of execution
|
---|
246 | property MaxTimeAfterLastOutput: Integer read FMaxTimeAfterLastOutput
|
---|
247 | write FMaxTimeAfterLastOutput; //maximum time of execution without an output
|
---|
248 | property ShowWindow : TShowWindow read FShowWindow write FShowWindow;
|
---|
249 | // window type
|
---|
250 | property CreationFlag : TCreationFlag read FCreationFlag write FCreationFlag;
|
---|
251 | // window type
|
---|
252 | property ReturnCode: TReturnCode read FReturnCode write FReturnCode;
|
---|
253 | property OutputReturnCode: TReturnCode read FOutputReturnCode;
|
---|
254 | //==
|
---|
255 | end;
|
---|
256 |
|
---|
257 | procedure Register;
|
---|
258 |
|
---|
259 | implementation
|
---|
260 |
|
---|
261 | type TCharBuffer = array[0..MaxInt - 1] of Char;
|
---|
262 |
|
---|
263 | const ShowWindowValues : array [0..11] of Integer = (SW_HIDE, SW_MAXIMIZE, SW_MINIMIZE, SW_RESTORE, SW_SHOW, SW_SHOWDEFAULT, SW_SHOWMAXIMIZED, SW_SHOWMINIMIZED, SW_SHOWMINNOACTIVE, SW_SHOWNA, SW_SHOWNOACTIVATE, SW_SHOWNORMAL);
|
---|
264 | const CreationFlagValues : array [0..9] of Integer = (CREATE_DEFAULT_ERROR_MODE, CREATE_NEW_CONSOLE, CREATE_NEW_PROCESS_GROUP, CREATE_SEPARATE_WOW_VDM, CREATE_SHARED_WOW_VDM, CREATE_SUSPENDED, CREATE_UNICODE_ENVIRONMENT, DEBUG_PROCESS, DEBUG_ONLY_THIS_PROCESS, DETACHED_PROCESS);
|
---|
265 |
|
---|
266 | //------------------------------------------------------------------------------
|
---|
267 |
|
---|
268 | constructor TProcessTimer.Create(AOwner: TComponent);
|
---|
269 | begin
|
---|
270 | inherited Create(AOwner);
|
---|
271 | Enabled := False; //timer is off
|
---|
272 | OnTimer := MyTimer;
|
---|
273 | end;
|
---|
274 |
|
---|
275 | //------------------------------------------------------------------------------
|
---|
276 |
|
---|
277 | procedure TProcessTimer.MyTimer(Sender: TObject);
|
---|
278 | begin
|
---|
279 | Inc(FSinceBeginning);
|
---|
280 | Inc(FSinceLastOutput);
|
---|
281 | end;
|
---|
282 |
|
---|
283 | //------------------------------------------------------------------------------
|
---|
284 |
|
---|
285 | procedure TProcessTimer.Beginning;
|
---|
286 | begin
|
---|
287 | Interval := 1000; //time is in sec
|
---|
288 | FSinceBeginning := 0; //this is the beginning
|
---|
289 | FSinceLastOutput := 0;
|
---|
290 | Enabled := True; //set the timer on
|
---|
291 | end;
|
---|
292 |
|
---|
293 | //------------------------------------------------------------------------------
|
---|
294 |
|
---|
295 | procedure TProcessTimer.NewOutput;
|
---|
296 | begin
|
---|
297 | FSinceLastOutput := 0; //a new output has been caught
|
---|
298 | end;
|
---|
299 |
|
---|
300 | //------------------------------------------------------------------------------
|
---|
301 |
|
---|
302 | procedure TProcessTimer.Ending;
|
---|
303 | begin
|
---|
304 | Enabled := False; //set the timer off
|
---|
305 | end;
|
---|
306 |
|
---|
307 | //------------------------------------------------------------------------------
|
---|
308 |
|
---|
309 | procedure TDosThread.FExecute;
|
---|
310 | const
|
---|
311 | MaxBufSize = 1024;
|
---|
312 | var
|
---|
313 | pBuf: ^TCharBuffer; //i/o buffer
|
---|
314 | iBufSize: Cardinal;
|
---|
315 | app_spawn: PChar;
|
---|
316 | si: STARTUPINFO;
|
---|
317 | sa: PSECURITYATTRIBUTES; //security information for pipes
|
---|
318 | sd: PSECURITY_DESCRIPTOR;
|
---|
319 | pi: PROCESS_INFORMATION;
|
---|
320 | newstdin, newstdout, read_stdout, write_stdin: THandle; //pipe handles
|
---|
321 | Exit_Code: LongWord; //process exit code
|
---|
322 | bread: LongWord; //bytes read
|
---|
323 | avail: LongWord; //bytes available
|
---|
324 | Str, Last: string;
|
---|
325 | PStr: PChar;
|
---|
326 | I, II: LongWord;
|
---|
327 | eol, EndCR:boolean; // tk
|
---|
328 |
|
---|
329 | begin //FExecute
|
---|
330 | try /// for free self
|
---|
331 |
|
---|
332 | FOwner.ThreadStatus := dtsAllocatingMemory;
|
---|
333 | GetMem(sa, sizeof(SECURITY_ATTRIBUTES));
|
---|
334 | if (Win32Platform = VER_PLATFORM_WIN32_NT) then begin //initialize security descriptor (Windows NT)
|
---|
335 | GetMem(sd, sizeof(SECURITY_DESCRIPTOR));
|
---|
336 | InitializeSecurityDescriptor(sd, SECURITY_DESCRIPTOR_REVISION);
|
---|
337 | SetSecurityDescriptorDacl(sd, true, nil, false);
|
---|
338 | sa.lpSecurityDescriptor := sd;
|
---|
339 | end else begin
|
---|
340 | sa.lpSecurityDescriptor := nil;
|
---|
341 | sd := nil;
|
---|
342 | end;
|
---|
343 | sa.nLength := sizeof(SECURITY_ATTRIBUTES);
|
---|
344 | sa.bInheritHandle := true; //allow inheritable handles
|
---|
345 | iBufSize := MaxBufSize;
|
---|
346 | pBuf := AllocMem(iBufSize); // Reserve and init Buffer
|
---|
347 | try /// memory allocated
|
---|
348 |
|
---|
349 | FOwner.ThreadStatus := dtsCreatingPipes;
|
---|
350 | if not (CreatePipe(newstdin, write_stdin, sa, 0)) then //create stdin pipe
|
---|
351 | begin
|
---|
352 | raise FCreatePipeError;
|
---|
353 | Exit;
|
---|
354 | end;
|
---|
355 | if not (CreatePipe(read_stdout, newstdout, sa, 0)) then //create stdout pipe
|
---|
356 | begin
|
---|
357 | CloseHandle(newstdin);
|
---|
358 | CloseHandle(write_stdin);
|
---|
359 | raise FCreateProcessError; // æÉ raise µÄÍÈçÈ¢B
|
---|
360 | Exit;
|
---|
361 | end;
|
---|
362 | try /// handles for pipes
|
---|
363 |
|
---|
364 | FOwner.ThreadStatus := dtsCreatingProcess;
|
---|
365 | GetStartupInfo(si); //set startupinfo for the spawned process
|
---|
366 | {The dwFlags member tells CreateProcess how to make the process.
|
---|
367 | STARTF_USESTDHANDLES validates the hStd* members. STARTF_USESHOWWINDOW
|
---|
368 | validates the wShowWindow member.}
|
---|
369 | si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
|
---|
370 | si.wShowWindow := ShowWindowValues[Ord(FShowWindow)]; //SW_SHOW; //SW_HIDE; //SW_SHOWMINIMIZED;
|
---|
371 | si.hStdOutput := newstdout;
|
---|
372 | si.hStdError := newstdout; //set the new handles for the child process
|
---|
373 | si.hStdInput := newstdin;
|
---|
374 | app_spawn := PChar(FCommandLine);
|
---|
375 | //spawn the child process
|
---|
376 | if not (CreateProcess(nil,
|
---|
377 | app_spawn,
|
---|
378 | nil,
|
---|
379 | nil,
|
---|
380 | TRUE,
|
---|
381 | {CREATE_NEW_CONSOLE}{DETACHED_PROCESS}
|
---|
382 | CreationFlagValues[Ord(FCreationFlag)] or FPriority,
|
---|
383 | nil,
|
---|
384 | nil,
|
---|
385 | si,
|
---|
386 | pi)) then
|
---|
387 | begin
|
---|
388 | // áOðó¯æéꪳ¢B
|
---|
389 | // XbhÌ exitcode Éüêé׫HB
|
---|
390 | FCreateProcessError := TCreateProcessError.Create(string(app_spawn)
|
---|
391 | + ' doesn''t exist.');
|
---|
392 | raise FCreateProcessError;
|
---|
393 | Exit;
|
---|
394 | end;
|
---|
395 | FTimer.Beginning; //turn the timer on
|
---|
396 | Exit_Code := STILL_ACTIVE;
|
---|
397 | try /// handles of process
|
---|
398 |
|
---|
399 | FOwner.ThreadStatus := dtsRunning;
|
---|
400 | Last := ''; // Buffer to save last output without finished with CRLF
|
---|
401 | FLineBeginned := False;
|
---|
402 | EndCR := False;
|
---|
403 |
|
---|
404 | repeat //main program loop
|
---|
405 | // ¶«Ä¢êÎ STILL_ACTIVE ñÅ¢êÎI¹R[hª½¾¿ÉÔéB
|
---|
406 | // ñÅ¢ÄàpCvÌf[^ÍLøB
|
---|
407 | GetExitCodeProcess(pi.hProcess, Exit_Code); //while the process is running
|
---|
408 | // oÍpCv©ç pBuf ÉæèÞB
|
---|
409 | PeekNamedPipe(read_stdout, pBuf, iBufSize, @bread, @avail, nil);
|
---|
410 | //check to see if there is any data to read from stdout
|
---|
411 | // oͪ êÎ
|
---|
412 | if (bread <> 0) then begin
|
---|
413 | if (iBufSize < avail) then begin // If BufferSize too small then rezize
|
---|
414 | iBufSize := avail;
|
---|
415 | ReallocMem(pBuf, iBufSize);
|
---|
416 | end;
|
---|
417 | FillChar(pBuf^, iBufSize, #0); //empty the buffer
|
---|
418 | ReadFile(read_stdout, pBuf^, iBufSize, bread, nil); //read the stdout pipe
|
---|
419 | Str := Last; //take the begin of the line (if exists)
|
---|
420 | i := 0;
|
---|
421 | while ((i < bread) and not (Terminated)) do
|
---|
422 | begin
|
---|
423 | case pBuf^[i] of
|
---|
424 | #0: Inc(i);
|
---|
425 | #10, #13:
|
---|
426 | begin
|
---|
427 | Inc(i);
|
---|
428 | if not (EndCR and (pBuf^[i - 1] = #10)) then
|
---|
429 | begin
|
---|
430 | if (i < bread) and (pBuf^[i - 1] = #13) and (pBuf^[i] = #10) then
|
---|
431 | begin
|
---|
432 | Inc(i);
|
---|
433 | FOwner.FOutputReturnCode := rcCRLF;
|
---|
434 | //Str := Str + #13#10;
|
---|
435 | end
|
---|
436 | else
|
---|
437 | begin
|
---|
438 | FOwner.FOutputReturnCode := rcLF;
|
---|
439 | //Str := Str + #10;
|
---|
440 | end;
|
---|
441 | //so we don't test the #10 on the next step of the loop
|
---|
442 | //FTimer.NewOutput; //a new ouput has been caught
|
---|
443 | AddString_SHARED(Str, otEntireLine);
|
---|
444 | Str := '';
|
---|
445 | end;
|
---|
446 | end;
|
---|
447 | else
|
---|
448 | begin
|
---|
449 | Str := Str + pBuf^[i]; //add a character
|
---|
450 | Inc(i);
|
---|
451 | end;
|
---|
452 | end;
|
---|
453 | end;
|
---|
454 | EndCR := (pBuf^[i - 1] = #13);
|
---|
455 | Last := Str; // no CRLF found in the rest, maybe in the next output
|
---|
456 | if (Last <> '') then begin
|
---|
457 | AddString_SHARED(Last, otBeginningOfLine);
|
---|
458 | end;
|
---|
459 | // oͪ³¢êB
|
---|
460 | end
|
---|
461 | else
|
---|
462 | begin
|
---|
463 | //send Lines in input (if exist)
|
---|
464 | //FOwner.sync.beginWrite ;
|
---|
465 | try
|
---|
466 | while ((InputLines_SHARED.Count > 0) and not (Terminated)) do
|
---|
467 | begin
|
---|
468 | // enough size?
|
---|
469 | II := Length(InputLines_SHARED[0]);
|
---|
470 | if (iBufSize < II) then
|
---|
471 | iBufSize := II;
|
---|
472 | FillChar(pBuf^, iBufSize, #0); //clear the buffer
|
---|
473 | eol := (Pos(#13#10, InputLines_SHARED[0]) = II - 1) or (Pos(#10, InputLines_SHARED[0]) = II);
|
---|
474 | for I := 0 to II - 1 do
|
---|
475 | pBuf^[I]:=InputLines_SHARED[0][I + 1];
|
---|
476 | WriteFile(write_stdin, pBuf^, II, bread, nil); //send it to stdin
|
---|
477 | if FOwner.FInputToOutput then //if we have to output the inputs
|
---|
478 | begin
|
---|
479 | if FLineBeginned then
|
---|
480 | Last := Last + InputLines_SHARED[0]
|
---|
481 | else
|
---|
482 | Last := InputLines_SHARED[0];
|
---|
483 | if eol then
|
---|
484 | begin
|
---|
485 | AddString_SHARED(Last, otEntireLine);
|
---|
486 | Last := '';
|
---|
487 | end
|
---|
488 | else
|
---|
489 | AddString_SHARED(Last, otBeginningOfLine);
|
---|
490 | end;
|
---|
491 | InputLines_SHARED.Delete(0); //delete the line that has been send
|
---|
492 | end;
|
---|
493 | finally
|
---|
494 | //FOwner.sync.EndWrite ;
|
---|
495 | end;
|
---|
496 | end;
|
---|
497 |
|
---|
498 | Sleep(1); // Give other processes a chance
|
---|
499 |
|
---|
500 | if Exit_Code <> STILL_ACTIVE then begin
|
---|
501 | FOwner.ThreadStatus := dtsSuccess;
|
---|
502 | FOwner.FExitCode := Exit_Code;
|
---|
503 | //ReturnValue := Exit_Code;
|
---|
504 | break;
|
---|
505 | end;
|
---|
506 |
|
---|
507 | if Terminated then begin //the user has decided to stop the process
|
---|
508 | FOwner.ThreadStatus := dtsUserAborted;
|
---|
509 | break;
|
---|
510 | end;
|
---|
511 |
|
---|
512 | if ((FMaxTimeAfterBeginning < FTimer.FSinceBeginning)
|
---|
513 | and (FMaxTimeAfterBeginning > 0)) //time out
|
---|
514 | or ((FMaxTimeAfterLastOutput < FTimer.FSinceLastOutput)
|
---|
515 | and (FMaxTimeAfterLastOutput > 0))
|
---|
516 | then begin
|
---|
517 | FOwner.ThreadStatus := dtsTimeOut;
|
---|
518 | break;
|
---|
519 | end;
|
---|
520 |
|
---|
521 | until (Exit_Code <> STILL_ACTIVE); //process terminated (normally)
|
---|
522 |
|
---|
523 | if (Last <> '') then // If not empty flush last output
|
---|
524 | AddString_SHARED(Last, otBeginningOfLine);
|
---|
525 |
|
---|
526 | finally /// handles of process
|
---|
527 | if (Exit_Code = STILL_ACTIVE) then
|
---|
528 | TerminateProcess(pi.hProcess, 0);
|
---|
529 | FTimer.Ending; //turn the timer off
|
---|
530 | CloseHandle(pi.hThread);
|
---|
531 | CloseHandle(pi.hProcess);
|
---|
532 | end;
|
---|
533 | finally /// handles for pipes
|
---|
534 | CloseHandle(newstdin); //clean stuff up
|
---|
535 | CloseHandle(newstdout);
|
---|
536 | CloseHandle(read_stdout);
|
---|
537 | CloseHandle(write_stdin);
|
---|
538 | end;
|
---|
539 | finally /// memory(1)
|
---|
540 | FreeMem(pBuf);
|
---|
541 | if (Win32Platform = VER_PLATFORM_WIN32_NT) then
|
---|
542 | FreeMem(sd);
|
---|
543 | FreeMem(sa);
|
---|
544 | end;
|
---|
545 | finally /// free self
|
---|
546 | if Assigned(FOnTerminated) then
|
---|
547 | FOnTerminated(FOwner, Exit_Code);
|
---|
548 | case FOwner.ThreadStatus of
|
---|
549 | dtsAllocatingMemory:
|
---|
550 | begin
|
---|
551 | FOwner.ThreadStatus := dtsAllocateMemoryFail ;
|
---|
552 | FOwner.FExitCode := GetLastError;
|
---|
553 | end;
|
---|
554 | dtsCreatingPipes:
|
---|
555 | begin
|
---|
556 | FOwner.ThreadStatus := dtsCreatePipesFail ;
|
---|
557 | FOwner.FExitCode := GetLastError;
|
---|
558 | end;
|
---|
559 | dtsCreatingProcess:
|
---|
560 | begin
|
---|
561 | FOwner.ThreadStatus := dtsCreateProcessFail ;
|
---|
562 | FOwner.FExitCode := GetLastError;
|
---|
563 | end;
|
---|
564 | dtsRunning:
|
---|
565 | begin
|
---|
566 | FOwner.ThreadStatus := dtsRunningError ;
|
---|
567 | FOwner.FExitCode := GetLastError;
|
---|
568 | end;
|
---|
569 | end;
|
---|
570 | FreeOnTerminate := true;
|
---|
571 | FActive := False;
|
---|
572 | terminate;
|
---|
573 | end;
|
---|
574 | end;
|
---|
575 |
|
---|
576 | //------------------------------------------------------------------------------
|
---|
577 |
|
---|
578 | procedure TDosThread.Execute;
|
---|
579 | begin
|
---|
580 | try
|
---|
581 | FExecute;
|
---|
582 | except
|
---|
583 | on E: TCreatePipeError do Application.ShowException(E);
|
---|
584 | on E: TCreateProcessError do Application.ShowException(E);
|
---|
585 | end;
|
---|
586 | end;
|
---|
587 |
|
---|
588 | //------------------------------------------------------------------------------
|
---|
589 |
|
---|
590 | procedure TDosThread.AddString_SHARED(Str: string; OutType: TOutputType);
|
---|
591 | begin
|
---|
592 | try
|
---|
593 | FOwner.Lines.Add(str); // ??
|
---|
594 | FTimer.NewOutput; //a new ouput has been caught
|
---|
595 | FOutputStr := Str;
|
---|
596 | FOutputType := OutType;
|
---|
597 | Synchronize(AddString);
|
---|
598 | except
|
---|
599 | end;
|
---|
600 | end;
|
---|
601 |
|
---|
602 | procedure TDosThread.AddString;
|
---|
603 | begin
|
---|
604 | if Assigned(FOwner.OutputLines) then
|
---|
605 | begin
|
---|
606 | FOwner.OutputLines.BeginUpdate;
|
---|
607 | try
|
---|
608 | if FOwner.OutputLines.Count = 0 then
|
---|
609 | begin
|
---|
610 | if (FOutputType = otEntireLine) then
|
---|
611 | FOwner.OutputLines.Add(FOutputStr)
|
---|
612 | else
|
---|
613 | FOwner.OutputLines.Text := FOutputStr;
|
---|
614 | end
|
---|
615 | else
|
---|
616 | begin
|
---|
617 | // change the way to add by last addstring type
|
---|
618 | if FLineBeginned then
|
---|
619 | FOwner.OutputLines[FOwner.OutputLines.Count - 1] := FOutputStr
|
---|
620 | else
|
---|
621 | FOwner.OutputLines.Add(FOutputStr);
|
---|
622 | end;
|
---|
623 | finally
|
---|
624 | FOwner.OutputLines.EndUpdate;
|
---|
625 | end;
|
---|
626 | end;
|
---|
627 | FLineBeginned := (FOutputType = otBeginningOfLine);
|
---|
628 | if Assigned(FOnNewLine) then
|
---|
629 | FOnNewLine(FOwner, FOutputStr, FOutputType);
|
---|
630 | end;
|
---|
631 |
|
---|
632 |
|
---|
633 | //------------------------------------------------------------------------------
|
---|
634 |
|
---|
635 | //
|
---|
636 | // AOwner:TDosCommand ð꾯ó¯æÁ½Ù¤ªæ¢B
|
---|
637 | //
|
---|
638 | constructor TDosThread.Create( AOwner: TDosCommand );
|
---|
639 | begin
|
---|
640 | FOwner := AOwner;
|
---|
641 | FCommandline := FOwner.CommandLine; // copy. not shared;
|
---|
642 | InputLines_SHARED := FOwner.FInputLines_SHARED;
|
---|
643 | InputLines_SHARED.Clear;
|
---|
644 | //FInputToOutput := FOwner.InputToOutput;
|
---|
645 | FOnNewLine := FOwner.FOnNewLine;
|
---|
646 | FOnTerminated := FOwner.FOnTerminated;
|
---|
647 | FTimer := FOwner.FTimer; // can access private!!
|
---|
648 | FMaxTimeAfterBeginning := FOwner.FMaxTimeAfterBeginning;
|
---|
649 | FMaxTimeAfterLastOutput := FOwner.FMaxTimeAfterLastOutput;
|
---|
650 | FPriority := FOwner.FPriority;
|
---|
651 | FShowWindow := FOwner.FShowWindow;
|
---|
652 | FCreationFlag := FOwner.FCreationFlag;
|
---|
653 | FLineBeginned := False;
|
---|
654 | FProcessInfo_SHARED := @FOwner.FProcessInfo_SHARED;
|
---|
655 | FActive := True;
|
---|
656 |
|
---|
657 | inherited Create(False); // ½¾¿ÉÀsB
|
---|
658 | end;
|
---|
659 |
|
---|
660 | //------------------------------------------------------------------------------
|
---|
661 |
|
---|
662 | constructor TDosCommand.Create(AOwner: TComponent);
|
---|
663 | begin
|
---|
664 | inherited;
|
---|
665 | FLines_SHARED := TStringList.Create;
|
---|
666 | FLines_SHARED.Clear;
|
---|
667 | FInputLines_SHARED := TStringList.Create;
|
---|
668 | FInputLines_SHARED.Clear;
|
---|
669 | FSync := TMultiReadExclusiveWriteSynchronizer.Create;
|
---|
670 |
|
---|
671 | FCommandLine := '';
|
---|
672 | FTimer := nil;
|
---|
673 | FMaxTimeAfterBeginning := 0;
|
---|
674 | FMaxTimeAfterLastOutput := 0;
|
---|
675 | FPriority := NORMAL_PRIORITY_CLASS;
|
---|
676 | FShowWindow := swHide;
|
---|
677 | FCreationFlag := fCREATE_NEW_CONSOLE;
|
---|
678 | end;
|
---|
679 |
|
---|
680 | //------------------------------------------------------------------------------
|
---|
681 |
|
---|
682 | procedure TDosCommand.SetOutputLines_SHARED(Value: TStrings);
|
---|
683 | begin
|
---|
684 | Sync.beginWrite ; try
|
---|
685 | if (FOutputLines_SHARED <> Value) then begin
|
---|
686 | FOutputLines_SHARED := Value;
|
---|
687 | end;
|
---|
688 | finally Sync.EndWrite ; end;
|
---|
689 | end;
|
---|
690 |
|
---|
691 | //------------------------------------------------------------------------------
|
---|
692 |
|
---|
693 | procedure TDosCommand.Execute;
|
---|
694 | begin
|
---|
695 | if (FCommandLine <> '') then
|
---|
696 | begin
|
---|
697 | Stop;
|
---|
698 | if (FTimer = nil) then //create the timer (first call to execute)
|
---|
699 | FTimer := TProcessTimer.Create(self);
|
---|
700 | FLines_SHARED.Clear; //clear old outputs
|
---|
701 | FThread := TDosThread.Create( Self );
|
---|
702 | end;
|
---|
703 | end;
|
---|
704 |
|
---|
705 | //------------------------------------------------------------------------------
|
---|
706 |
|
---|
707 | //
|
---|
708 | // WaitFor ÅÍeXbhª~ÜÁĵܤH
|
---|
709 | //
|
---|
710 | // Apollo ÅÍN®É[]ÅI¹µÄàAmainloop ðI¹µÈ¢B
|
---|
711 | //
|
---|
712 | //
|
---|
713 |
|
---|
714 | function TDosCommand.Execute2: Integer;
|
---|
715 | begin
|
---|
716 | Execute;
|
---|
717 | while Self.Active do
|
---|
718 | Application.ProcessMessages;
|
---|
719 | Result := FExitCode;
|
---|
720 | end;
|
---|
721 |
|
---|
722 | //------------------------------------------------------------------------------
|
---|
723 |
|
---|
724 | procedure TDosCommand.Stop;
|
---|
725 | begin
|
---|
726 | if (FThread <> nil) then
|
---|
727 | begin
|
---|
728 | FThread.FreeOnTerminate := true;
|
---|
729 | FThread.Terminate; //terminate the process
|
---|
730 | FThread := nil;
|
---|
731 | end;
|
---|
732 | end;
|
---|
733 |
|
---|
734 | //------------------------------------------------------------------------------
|
---|
735 |
|
---|
736 | procedure TDosCommand.SendLine(Value: string; Eol: Boolean);
|
---|
737 | //const
|
---|
738 | //EolCh: array[Boolean] of Char = (' ', '_');
|
---|
739 | var
|
---|
740 | i, sp, L: Integer;
|
---|
741 | Str: String;
|
---|
742 | begin
|
---|
743 | // Sync.BeginWrite ;
|
---|
744 | try
|
---|
745 | if (FThread <> nil) then
|
---|
746 | begin
|
---|
747 | if Eol then
|
---|
748 | begin
|
---|
749 | if FReturnCode = rcCRLF then
|
---|
750 | Value := Value + #13#10
|
---|
751 | else
|
---|
752 | Value := Value + #10;
|
---|
753 | end;
|
---|
754 | { L := Length(Value);
|
---|
755 | i := 1;
|
---|
756 | sp := i;
|
---|
757 | while i <= L do
|
---|
758 | begin
|
---|
759 | case Value[i] of
|
---|
760 | #13:
|
---|
761 | begin
|
---|
762 | if (i < L) and (Value[i + 1] = #10) then
|
---|
763 | Inc(i);
|
---|
764 | Str := Copy(Value, sp, i - sp + 1);
|
---|
765 | FInputLines_SHARED.Add(Str);
|
---|
766 | Inc(i);
|
---|
767 | sp := i;
|
---|
768 | end;
|
---|
769 | #10:
|
---|
770 | begin
|
---|
771 | Str := Copy(Value, sp, i - sp + 1);
|
---|
772 | FInputLines_SHARED.Add(Str);
|
---|
773 | Inc(i);
|
---|
774 | sp := i;
|
---|
775 | end;
|
---|
776 | else
|
---|
777 | Inc(i);
|
---|
778 | end;
|
---|
779 | end;
|
---|
780 | Str := Copy(Value, sp, i - sp + 1);
|
---|
781 | FInputLines_SHARED.Add(Str);
|
---|
782 | }
|
---|
783 | FInputLines_SHARED.Add(Value);
|
---|
784 | //FThread.InputLines_SHARED.Add(EolCh[Eol] + Value);
|
---|
785 | end;
|
---|
786 | finally
|
---|
787 | end;
|
---|
788 | end;
|
---|
789 |
|
---|
790 | //------------------------------------------------------------------------------
|
---|
791 |
|
---|
792 | destructor TDosCommand.Destroy;
|
---|
793 | begin
|
---|
794 | if FThread <> nil then Stop;
|
---|
795 | if FTimer <> nil then FTimer.free;
|
---|
796 | FSync.Free;
|
---|
797 | FInputLines_SHARED.free;
|
---|
798 | FLines_SHARED.free;
|
---|
799 | inherited;
|
---|
800 | end;
|
---|
801 |
|
---|
802 | function TDosCommand.GetPrompting:boolean;
|
---|
803 | begin
|
---|
804 | //result := Active ; // and ( FTimer.FSinceLastOutput > 3 );
|
---|
805 | result := Active and (( FTimer.FSinceLastOutput > 3 ) or FThread.FLineBeginned);
|
---|
806 | end;
|
---|
807 |
|
---|
808 | function TDosCommand.GetActive:boolean;
|
---|
809 | begin
|
---|
810 | result := ( FThread <> nil ) and ( FThread.FActive ) and (not FThread.Terminated);
|
---|
811 | end;
|
---|
812 |
|
---|
813 | function TDosCommand.GetSinceLastOutput:integer;
|
---|
814 | begin
|
---|
815 | result := -1;
|
---|
816 | if GetActive then result := FTimer.FSinceLastOutput;
|
---|
817 | end;
|
---|
818 |
|
---|
819 | function TDosCommand.GetSinceBeginning:integer;
|
---|
820 | begin
|
---|
821 | result := -1;
|
---|
822 | if GetActive then result := FTimer.FSinceBeginning;
|
---|
823 | end;
|
---|
824 |
|
---|
825 | //------------------------------------------------------------------------------
|
---|
826 | procedure Register;
|
---|
827 | begin
|
---|
828 | RegisterComponents('Samples', [TDosCommand]);
|
---|
829 | //RegisterComponents('RDE', [TDosCommand]);
|
---|
830 | end;
|
---|
831 |
|
---|
832 | //------------------------------------------------------------------------------
|
---|
833 | end.
|
---|
834 |
|
---|