1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
| {
this component let you execute a dos program (exe, com or batch file) and catch
the ouput in order to put it in a memo or in a listbox, ...
you can also send inputs.
the cool thing of this component is that you do not need to wait the end of
the program to get back the output. it comes line by line.
*********************************************************************
** maxime_collomb@yahoo.fr **
** **
** for this component, i just translated C code **
** from Community.borland.com **
** (http://www.vmlinux.org/jakov/community.borland.com/10387.html) **
** **
** if you have a good idea of improvement, please **
** let me know (maxime_collomb@yahoo.fr). **
** if you improve this component, please send me a copy **
** so i can put it on www.torry.net. **
*********************************************************************
History :
---------
18-05-2001 : version 2.0
- Now, catching the beginning of a line is allowed (usefull if the
prog ask for an entry) => the method OnNewLine is modified
- Now can send inputs
- Add a couple of FreeMem for sa & sd [thanks Gary H. Blaikie]
07-05-2001 : version 1.2
- Sleep(1) is added to give others processes a chance
[thanks Hans-Georg Rickers]
- the loop that catch the outputs has been re-writen by
Hans-Georg Rickers => no more broken lines
30-04-2001 : version 1.1
- function IsWinNT() is changed to
(Win32Platform = VER_PLATFORM_WIN32_NT) [thanks Marc Scheuner]
- empty lines appear in the redirected output
- property OutputLines is added to redirect output directly to a
memo, richedit, listbox, ... [thanks Jean-Fabien Connault]
- a timer is added to offer the possibility of ending the process
after XXX sec. after the beginning or YYY sec after the last
output [thanks Jean-Fabien Connault]
- managing process priorities flags in the CreateProcess
thing [thanks Jean-Fabien Connault]
20-04-2001 : version 1.0 on www.torry.net
*******************************************************************
How to use it :
---------------
- just put the line of command in the property 'CommandLine'
- execute the process with the method 'Execute'
- if you want to stop the process before it has ended, use the method 'Stop'
- if you want the process to stop by itself after XXX sec of activity,
use the property 'MaxTimeAfterBeginning'
- if you want the process to stop after XXX sec without an output,
use the property 'MaxTimeAfterLastOutput'
- to directly redirect outputs to a memo or a richedit, ...
use the property 'OutputLines'
(DosCommand1.OutputLnes := Memo1.Lines;)
- you can access all the outputs of the last command with the property 'Lines'
- you can change the priority of the process with the property 'Priority'
value of Priority must be in [HIGH_PRIORITY_CLASS, IDLE_PRIORITY_CLASS,
NORMAL_PRIORITY_CLASS, REALTIME_PRIORITY_CLASS]
- you can have an event for each new line and for the end of the process
with the events 'procedure OnNewLine(Sender: TObject; NewLine: string;
OutputType: TOutputType);' and 'procedure OnTerminated(Sender: TObject);'
- you can send inputs to the dos process with 'SendLine(Value: string;
Eol: Boolean);'. Eol is here to determine if the program have to add a
CR/LF at the end of the string.
*******************************************************************
How to call a dos function (win 9x/Me) :
----------------------------------------
Example : Make a dir :
----------------------
- if you want to get the result of a 'c:\dir /o:gen /l c:\windows\*.txt'
for example, you need to make a batch file
--the batch file : c:\mydir.bat
@echo off
dir /o:gen /l %1
rem eof
--in your code
DosCommand.CommandLine := 'c:\mydir.bat c:\windows\*.txt';
DosCommand.Execute;
Example : Format a disk (win 9x/Me) :
-------------------------
--a batch file : c:\myformat.bat
@echo off
format %1
rem eof
--in your code
var diskname: string;
--
DosCommand1.CommandLine := 'c:\myformat.bat a:';
DosCommand1.Execute; //launch format process
DosCommand1.SendLine('', True); //equivalent to press enter key
DiskName := 'test';
DosCommand1.SendLine(DiskName, True); //enter the name of the volume
*******************************************************************}
unit DosCommand;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls;
type
TCreatePipeError = class(Exception); //exception raised when a pipe cannot be created
TCreateProcessError = class(Exception); //exception raised when the process cannot be created
TOutputType = (otEntireLine, otBeginningOfLine); //to know if the newline is finished.
TProcessTimer = class(TTimer) //timer for stopping the process after XXX sec
private
FSinceBeginning: Integer;
FSinceLastOutput: Integer;
procedure MyTimer(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
procedure Beginning; //call this at the beginning of a process
procedure NewOutput; //call this when a new output is received
procedure Ending; //call this when the process is terminated
property SinceBeginning: Integer read FSinceBeginning;
property SinceLastOutput: Integer read FSinceLastOutput;
end;
TNewLineEvent = procedure(Sender: TObject; NewLine: string; OutputType: TOutputType) of object;
TDosThread = class(TThread) //the thread that is waiting for outputs through the pipe
private
FOwner: TObject;
FCommandLine: string;
FLines: TStringList;
FOutputLines: TStrings;
FInputToOutput: Boolean;
FTimer: TProcessTimer;
FMaxTimeAfterBeginning: Integer;
FMaxTimeAfterLastOutput: Integer;
FOnNewLine: TNewLineEvent;
FOnTerminated: TNotifyEvent;
FCreatePipeError: TCreatePipeError;
FCreateProcessError: TCreateProcessError;
FPriority: Integer;
procedure FExecute;
protected
procedure Execute; override; //call this to create the process
public
InputLines: TstringList;
constructor Create(AOwner: TObject; Cl: string; L: TStringList;
Ol: TStrings; t: TProcessTimer; mtab, mtalo: Integer; Onl: TNewLineEvent;
Ot: TNotifyEvent; p: Integer; ito: Boolean);
end;
TDosCommand = class(TComponent) //the component to put on a form
private
FOwner: TComponent;
FCommandLine: string;
FLines: TStringList;
FOutputLines: TStrings;
FInputToOutput: Boolean;
FOnNewLine: TNewLineEvent;
FOnTerminated: TNotifyEvent;
FThread: TDosThread;
FTimer: TProcessTimer;
FMaxTimeAfterBeginning: Integer;
FMaxTimeAfterLastOutput: Integer;
FPriority: Integer; //[HIGH_PRIORITY_CLASS, IDLE_PRIORITY_CLASS,
// NORMAL_PRIORITY_CLASS, REALTIME_PRIORITY_CLASS]
procedure SetOutputLines(Value: TStrings);
protected
{ Déclarations protégées }
public
constructor Create(AOwner: TComponent); override;
procedure Execute; //the user call this to execute the command
procedure Stop; //the user can stop the process with this method
procedure SendLine(Value: string; Eol: Boolean); //add a line in the input pipe
property OutputLines: TStrings read FOutputLines write SetOutputLines;
//can be lines of a memo, a richedit, a listbox, ...
property Lines: TStringList read FLines;
//if the user want to access all the outputs of a process, he can use this property
property Priority: Integer read FPriority write FPriority; //priority of the process
published
property CommandLine: string read FCommandLine write FCommandLine;
//command to execute
property OnNewLine: TNewLineEvent read FOnNewLine write FOnNewLine;
//event for each new line that is received through the pipe
property OnTerminated: TNotifyEvent read FOnTerminated write FOnTerminated;
//event for the end of the process (normally, time out or by user (DosCommand.Stop;))
property InputToOutput: Boolean read FInputToOutput write FInputToOutput;
//check it if you want that the inputs appear also in the outputs
property MaxTimeAfterBeginning: Integer read FMaxTimeAfterBeginning
write FMaxTimeAfterBeginning; //maximum time of execution
property MaxTimeAfterLastOutput: Integer read FMaxTimeAfterLastOutput
write FMaxTimeAfterLastOutput; //maximum time of execution without an output
end;
procedure Register;
implementation
type TCharBuffer = array[0..MaxInt - 1] of Char;
//------------------------------------------------------------------------------
constructor TProcessTimer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Enabled := False; //timer is off
OnTimer := MyTimer;
end;
//------------------------------------------------------------------------------
procedure TProcessTimer.MyTimer(Sender: TObject);
begin
Inc(FSinceBeginning);
Inc(FSinceLastOutput);
end;
//------------------------------------------------------------------------------
procedure TProcessTimer.Beginning;
begin
Interval := 1000; //time is in sec
FSinceBeginning := 0; //this is the beginning
FSinceLastOutput := 0;
Enabled := True; //set the timer on
end;
//------------------------------------------------------------------------------
procedure TProcessTimer.NewOutput;
begin
FSinceLastOutput := 0; //a new output has been caught
end;
//------------------------------------------------------------------------------
procedure TProcessTimer.Ending;
begin
Enabled := False; //set the timer off
end;
//------------------------------------------------------------------------------
procedure TDosThread.FExecute;
const
MaxBufSize = 1024;
var
pBuf: ^TCharBuffer; //i/o buffer
iBufSize: Cardinal;
app_spawn: PChar;
si: STARTUPINFO;
sa: PSECURITYATTRIBUTES; //security information for pipes
sd: PSECURITY_DESCRIPTOR;
pi: PROCESS_INFORMATION;
newstdin, newstdout, read_stdout, write_stdin: THandle; //pipe handles
Exit_Code: LongWord; //process exit code
bread: LongWord; //bytes read
avail: LongWord; //bytes available
Str, Last: string;
I, II: LongWord;
LineBeginned: Boolean;
begin //FExecute
GetMem(sa, sizeof(SECURITY_ATTRIBUTES));
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin //initialize security descriptor (Windows NT)
GetMem(sd, sizeof(SECURITY_DESCRIPTOR));
InitializeSecurityDescriptor(sd, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(sd, true, nil, false);
sa.lpSecurityDescriptor := sd;
end
else begin
sa.lpSecurityDescriptor := nil;
sd := nil;
end;
sa.nLength := sizeof(SECURITY_ATTRIBUTES);
sa.bInheritHandle := true; //allow inheritable handles
if not (CreatePipe(newstdin, write_stdin, sa, 0)) then //create stdin pipe
begin
raise FCreatePipeError;
Exit;
end;
if not (CreatePipe(read_stdout, newstdout, sa, 0)) then //create stdout pipe
begin
raise FCreateProcessError;
CloseHandle(newstdin);
CloseHandle(write_stdin);
Exit;
end;
GetStartupInfo(si); //set startupinfo for the spawned process
{The dwFlags member tells CreateProcess how to make the process.
STARTF_USESTDHANDLES validates the hStd* members. STARTF_USESHOWWINDOW
validates the wShowWindow member.}
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE;
si.hStdOutput := newstdout;
si.hStdError := newstdout; //set the new handles for the child process
si.hStdInput := newstdin;
app_spawn := PChar(FCommandLine);
//spawn the child process
if not (CreateProcess(nil, app_spawn, nil, nil, TRUE,
CREATE_NEW_CONSOLE or FPriority, nil, nil, si, pi)) then
begin
FCreateProcessError := TCreateProcessError.Create(string(app_spawn)
+ ' doesn''t exist.');
raise FCreateProcessError;
CloseHandle(newstdin);
CloseHandle(newstdout);
CloseHandle(read_stdout);
CloseHandle(write_stdin);
Exit;
end;
Last := ''; // Buffer to save last output without finished with CRLF
LineBeginned := False;
iBufSize := MaxBufSize;
pBuf := AllocMem(iBufSize); // Reserve and init Buffer
try
repeat //main program loop
GetExitCodeProcess(pi.hProcess, Exit_Code); //while the process is running
PeekNamedPipe(read_stdout, pBuf, iBufSize, @bread, @avail, nil);
//check to see if there is any data to read from stdout
if (bread <> 0) then begin
if (iBufSize < avail) then begin // If BufferSize too small then rezize
iBufSize := avail;
ReallocMem(pBuf, iBufSize);
end;
FillChar(pBuf^, iBufSize, #0); //empty the buffer
ReadFile(read_stdout, pBuf^, iBufSize, bread, nil); //read the stdout pipe
Str := Last; //take the begin of the line (if exists)
i := 0;
while ((i < bread) and not (Terminated)) do begin
case pBuf^[i] of
#0: Inc(i);
#10:
begin
Inc(i);
FTimer.NewOutput; //a new ouput has been caught
FLines.add(Str); //add the line
if (FOutputLines <> nil) then
if LineBeginned then begin
FOutputLines[FOutputLines.Count - 1] := Str;
LineBeginned := False;
end
else
FOutputLines.Add(Str);
if Assigned(FOnNewLine) then
FOnNewLine(FOwner, Str, otEntireLine);
Str := '';
end;
#13: begin
Inc(i);
if (i < bread) and (pBuf^[i] = #10) then
Inc(i); //so we don't test the #10 on the next step of the loop
FTimer.NewOutput; //a new ouput has been caught
FLines.add(Str); //add the line
if (FOutputLines <> nil) then
if LineBeginned then begin
FOutputLines[FOutputLines.Count - 1] := Str;
LineBeginned := False;
end
else
FOutputLines.Add(Str);
if Assigned(FOnNewLine) then
FOnNewLine(FOwner, Str, otEntireLine);
Str := '';
end;
else begin
Str := Str + pBuf^[i]; //add a character
Inc(i);
end;
end;
end;
Last := Str; // no CRLF found in the rest, maybe in the next output
if (Last <> '') then
begin
if (FOutputLines <> nil) then
if LineBeginned then
FOutputLines[FOutputLines.Count - 1] := Last
else
FOutputLines.Add(Last);
if Assigned(FOnNewLine) then
FOnNewLine(FOwner, Str, otBeginningOfLine);
LineBeginned := True;
end;
end
else
//send lines in input (if exist)
while ((InputLines.Count > 0) and not (Terminated)) do
begin
FillChar(pBuf^, iBufSize, #0); //clear the buffer
for II := 2 to Length(InputLines[0]) do //copy the string in the buffer
pBuf^[II - 2] := InputLines[0][II];
if (InputLines[0][1] = '_') then
begin
pBuf^[Length(InputLines[0]) - 1] := #13; //add CR/LF at the end of line
pBuf^[Length(InputLines[0])] := #10;
II := Length(Inputlines[0]) + 1;
end
else II := Length(Inputlines[0]) - 1;
WriteFile(write_stdin, pBuf^, II, bread, nil); //send it to stdin
if FInputToOutput then //if we have to output the inputs
begin
InputLines[0] := Copy(InputLines[0], 2, Length(InputLines[0]) - 1);
//the first char has to be ignored
if (FOutputLines <> nil) then
if LineBeginned then begin //if we are continuing a line
Last := Last + InputLines[0];
FOutputLines[FOutputLines.Count - 1] := Last;
LineBeginned := False;
end
else //if it's a new line
FOutputLines.Add(InputLines[0]);
if Assigned(FOnNewLine) then
FOnNewLine(FOwner, Last, otEntireLine);
Last := '';
end;
InputLines.Delete(0); //delete the line that has been send
end;
Sleep(1); // Give other processes a chance
if Terminated then //the user has decided to stop the process
TerminateProcess(pi.hProcess, 0);
until ((Exit_Code <> STILL_ACTIVE) //process terminated (normally)
or ((FMaxTimeAfterBeginning < FTimer.FSinceBeginning)
and (FMaxTimeAfterBeginning > 0)) //time out
or ((FMaxTimeAfterLastOutput < FTimer.FSinceLastOutput)
and (FMaxTimeAfterLastOutput > 0))); //time out
if (Last <> '') then begin // If not empty flush last output
FLines.Add(Last);
if FOutputLines <> nil then
if LineBeginned then
FOutputLines[FOutputLines.Count - 1] := Last
else
FOutputLines.Add(Last);
if Assigned(FOnNewLine) then
FOnNewLine(FOwner, Last, otEntireLine);
end;
finally
FreeMem(pBuf);
end;
FreeMem(sd);
FreeMem(sa);
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
CloseHandle(newstdin); //clean stuff up
CloseHandle(newstdout);
CloseHandle(read_stdout);
CloseHandle(write_stdin);
FTimer.Ending; //turn the timer off
if Assigned(FOnTerminated) then
FOnTerminated(FOwner);
end;
//------------------------------------------------------------------------------
procedure TDosThread.Execute;
begin
FExecute;
end;
//------------------------------------------------------------------------------
constructor TDosThread.Create(AOwner: TObject; Cl: string; L: TStringList;
Ol: TStrings; t: TProcessTimer; mtab, mtalo: Integer; Onl: TNewLineEvent;
Ot: TNotifyEvent; p: Integer; ito: Boolean);
begin
FOwner := AOwner;
FCommandline := Cl;
FLines := L;
FOutputLines := Ol;
InputLines := TStringList.Create;
InputLines.Clear;
FInputToOutput := ito;
FOnNewLine := Onl;
FOnTerminated := Ot;
FTimer := t;
FMaxTimeAfterBeginning := mtab;
FMaxTimeAfterLastOutput := mtalo;
FPriority := p;
inherited Create(False);
end;
//------------------------------------------------------------------------------
constructor TDosCommand.Create(AOwner: TComponent);
begin
inherited;
FOwner := AOwner;
FCommandLine := '';
FLines := TStringList.Create;
Flines.Clear;
FTimer := nil;
FMaxTimeAfterBeginning := 0;
FMaxTimeAfterLastOutput := 0;
FPriority := NORMAL_PRIORITY_CLASS;
end;
//------------------------------------------------------------------------------
procedure TDosCommand.SetOutputLines(Value: TStrings);
begin
if (FOutputLines <> Value) then
FOutputLines := Value;
end;
//------------------------------------------------------------------------------
procedure TDosCommand.Execute;
begin
if (FCommandLine <> '') then
begin
if (FTimer = nil) then //create the timer (first call to execute)
FTimer := TProcessTimer.Create(FOwner);
FLines.Clear; //clear old outputs
FTimer.Beginning; //turn the timer on
FThread := TDosThread.Create(Self, FCommandLine, FLines, FOutputLines,
FTimer, FMaxTimeAfterBeginning, FMaxTimeAfterLastOutput, FOnNewLine,
FOnTerminated, FPriority, FInputToOutput);
end;
end;
//------------------------------------------------------------------------------
procedure TDosCommand.Stop;
begin
if (FThread <> nil) then
begin
FThread.DoTerminate; //terminate the process
FThread.Free; //free memory
FThread := nil;
end;
end;
//------------------------------------------------------------------------------
procedure TDosCommand.SendLine(Value: string; Eol: Boolean);
const
EolCh: array[Boolean] of Char = (' ', '_');
begin
if (FThread <> nil) then
FThread.InputLines.Add(EolCh[Eol] + Value);
end;
//------------------------------------------------------------------------------
procedure Register;
begin
RegisterComponents('Samples', [TDosCommand]);
end;
//------------------------------------------------------------------------------
end. |
