source: trunk/DosCommand.pas

Last change on this file was 1, checked in by george, 17 years ago
  • Přidáno: Verze 1.0
  • Přidáno: Pomocné komponenty a ikony.
  • Přidáno: Skript pro sestavení instalačního programu a instalační programy jednotlivých verzí.
File size: 29.2 KB
Line 
1{
2this component let you execute a dos program (exe, com or batch file) and catch
3the 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
6the 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 :
232002-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
104unit DosCommand;
105
106interface
107
108uses
109 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
110 Dialogs;
111
112type
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 // ‚±‚ê(«)‚Í•s—v‚Å‚Í‚È‚¢‚©HB
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
257procedure Register;
258
259implementation
260
261type TCharBuffer = array[0..MaxInt - 1] of Char;
262
263const 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);
264const 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
268constructor TProcessTimer.Create(AOwner: TComponent);
269begin
270 inherited Create(AOwner);
271 Enabled := False; //timer is off
272 OnTimer := MyTimer;
273end;
274
275//------------------------------------------------------------------------------
276
277procedure TProcessTimer.MyTimer(Sender: TObject);
278begin
279 Inc(FSinceBeginning);
280 Inc(FSinceLastOutput);
281end;
282
283//------------------------------------------------------------------------------
284
285procedure TProcessTimer.Beginning;
286begin
287 Interval := 1000; //time is in sec
288 FSinceBeginning := 0; //this is the beginning
289 FSinceLastOutput := 0;
290 Enabled := True; //set the timer on
291end;
292
293//------------------------------------------------------------------------------
294
295procedure TProcessTimer.NewOutput;
296begin
297 FSinceLastOutput := 0; //a new output has been caught
298end;
299
300//------------------------------------------------------------------------------
301
302procedure TProcessTimer.Ending;
303begin
304 Enabled := False; //set the timer off
305end;
306
307//------------------------------------------------------------------------------
308
309procedure TDosThread.FExecute;
310const
311 MaxBufSize = 1024;
312var
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
329begin //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 // ƒXƒŒƒbƒh‚Ì exitcode ‚É“ü‚ê‚é‚ׂ«HB
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 // Ž€‚ñ‚Å‚¢‚Ä‚àƒpƒCƒv‚̃f[ƒ^‚Í—LŒøB
407 GetExitCodeProcess(pi.hProcess, Exit_Code); //while the process is running
408 // o—̓pƒCƒv‚©‚ç 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;
574end;
575
576//------------------------------------------------------------------------------
577
578procedure TDosThread.Execute;
579begin
580 try
581 FExecute;
582 except
583 on E: TCreatePipeError do Application.ShowException(E);
584 on E: TCreateProcessError do Application.ShowException(E);
585 end;
586end;
587
588//------------------------------------------------------------------------------
589
590procedure TDosThread.AddString_SHARED(Str: string; OutType: TOutputType);
591begin
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;
600end;
601
602procedure TDosThread.AddString;
603begin
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);
630end;
631
632
633//------------------------------------------------------------------------------
634
635 //
636 // AOwner:TDosCommand ‚ðˆê‚‚¾‚¯Žó‚¯Žæ‚Á‚½‚Ù‚¤‚ª‚æ‚¢B
637 //
638constructor TDosThread.Create( AOwner: TDosCommand );
639begin
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); // ‚½‚¾‚¿‚ÉŽÀsB
658end;
659
660//------------------------------------------------------------------------------
661
662constructor TDosCommand.Create(AOwner: TComponent);
663begin
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;
678end;
679
680//------------------------------------------------------------------------------
681
682procedure TDosCommand.SetOutputLines_SHARED(Value: TStrings);
683begin
684 Sync.beginWrite ; try
685 if (FOutputLines_SHARED <> Value) then begin
686 FOutputLines_SHARED := Value;
687 end;
688 finally Sync.EndWrite ; end;
689end;
690
691//------------------------------------------------------------------------------
692
693procedure TDosCommand.Execute;
694begin
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;
703end;
704
705//------------------------------------------------------------------------------
706
707 //
708 // WaitFor ‚ł͐eƒXƒŒƒbƒh‚ªŽ~‚Ü‚Á‚Ä‚µ‚Ü‚¤H
709 //
710 // Apollo ‚Å‚Í‹N“®’†‚É[‚˜]‚ŏI—¹‚µ‚Ä‚àAmainloop ‚ðI—¹‚µ‚È‚¢B
711 //
712 //
713
714function TDosCommand.Execute2: Integer;
715begin
716 Execute;
717 while Self.Active do
718 Application.ProcessMessages;
719 Result := FExitCode;
720end;
721
722//------------------------------------------------------------------------------
723
724procedure TDosCommand.Stop;
725begin
726 if (FThread <> nil) then
727 begin
728 FThread.FreeOnTerminate := true;
729 FThread.Terminate; //terminate the process
730 FThread := nil;
731 end;
732end;
733
734//------------------------------------------------------------------------------
735
736procedure TDosCommand.SendLine(Value: string; Eol: Boolean);
737//const
738 //EolCh: array[Boolean] of Char = (' ', '_');
739var
740 i, sp, L: Integer;
741 Str: String;
742begin
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;
788end;
789
790//------------------------------------------------------------------------------
791
792destructor TDosCommand.Destroy;
793begin
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;
800end;
801
802function TDosCommand.GetPrompting:boolean;
803begin
804 //result := Active ; // and ( FTimer.FSinceLastOutput > 3 );
805 result := Active and (( FTimer.FSinceLastOutput > 3 ) or FThread.FLineBeginned);
806end;
807
808function TDosCommand.GetActive:boolean;
809begin
810 result := ( FThread <> nil ) and ( FThread.FActive ) and (not FThread.Terminated);
811end;
812
813function TDosCommand.GetSinceLastOutput:integer;
814begin
815 result := -1;
816 if GetActive then result := FTimer.FSinceLastOutput;
817end;
818
819function TDosCommand.GetSinceBeginning:integer;
820begin
821 result := -1;
822 if GetActive then result := FTimer.FSinceBeginning;
823end;
824
825//------------------------------------------------------------------------------
826procedure Register;
827begin
828 RegisterComponents('Samples', [TDosCommand]);
829 //RegisterComponents('RDE', [TDosCommand]);
830end;
831
832//------------------------------------------------------------------------------
833end.
834
Note: See TracBrowser for help on using the repository browser.