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
|
unit callbackprocess;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, process, pipes;
type
TProcessChannel=(pcStdOut, pcStdError, pcFinished, pcError);
TCallBackEvent=procedure(pcChannel: TProcessChannel; strData: String) of object;
TCallbackProcess=class(TComponent)
private
FProcess: TProcess;
FCallBackEvent: TCallBackEvent;
FCommandLine: String;
FCancel: Boolean;
procedure CreateProcess;
function ReadFromPipeStream(AStream: TInputPipeStream; var AString: String): Integer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Execute;
property CallBackEvent: TCallBackEvent write FCallBackEvent;
published
property Cancel: Boolean read FCancel write FCancel;
property CommandLine: String read FCommandLine write FCommandLine;
end;
implementation
constructor TCallbackProcess.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TCallbackProcess.Destroy;
begin
inherited Destroy;
end;
function TCallbackProcess.ReadFromPipeStream(AStream: TInputPipeStream; var AString: String): Integer;
var
M: TMemoryStream;
BytesRead: Int64;
n: Integer;
begin
M := TMemoryStream.Create;
BytesRead := 0;
try
repeat
M.SetSize(BytesRead + AStream.NumBytesAvailable);
n := AStream.Read((M.Memory + BytesRead)^, AStream.NumBytesAvailable);
Inc(BytesRead, n);
until (n=0);
if BytesRead>0 then
begin
SetLength(AString,BytesRead);
M.Read(AString[1],BytesRead);
end;
finally
M.Free;
Result := BytesRead;
end;
end;
procedure TCallbackProcess.Execute;
var
strTemp: String;
begin
try
strTemp := '';
CreateProcess;
FCancel := False;
FProcess.CommandLine := FCommandLine;
FProcess.Execute;
while (FProcess.Running) do
begin
Sleep(10);
if FCancel then FProcess.Terminate(0);
if ReadFromPipeStream(FProcess.Stderr,strTemp)>0 then
FCallBackEvent(pcStdError, strTemp);
end;
if ReadFromPipeStream(FProcess.Stderr,strTemp)>0 then
FCallBackEvent(pcStdError, strTemp);
if ReadFromPipeStream(FProcess.Output,strTemp)>0 then
FCallBackEvent(pcStdOut, strTemp);
except
on E:EProcess do
FCallBackEvent(pcError, 'Process-Error ' + IntToStr(FProcess.ExitStatus));
else
FCallBackEvent(pcError, IntToStr(FProcess.ExitStatus));
end;
FreeAndNil(FProcess);
FCallBackEvent(pcFinished, '');
end;
procedure TCallbackProcess.CreateProcess;
begin
FProcess := TProcess.Create(nil);
FProcess.Options := [poUsePipes,poNoConsole];
end;
end.
|
