paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-11 10:10:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Renamed intruncommand to RunCommandLoop.

Browse Source 
* Added some events for basic parameterization.

git-svn-id: trunk@39517 -
This commit is contained in:
marco 2018-07-28 15:42:25 +00:00
parent 70c09d86a8
commit 0060a3560f
1 changed files with 27 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
packages/fcl-process/src/process.pp
View File

@ -46,11 +46,17 @@ Type
TProcessForkEvent = procedure(Sender : TObject) of object;
{$endif UNIX}
TOnRunCommandIdleEvent = procedure(Sender : TObject) of object;
TOnRunCommandException = procedure(Sender : TObject;message:string) of object;
{ TProcess }
TProcess = Class (TComponent)
Private
FOnRunCommandIdleEvent: TOnRunCommandIdleEvent;
FOnRunCommandException: TOnRunCommandException;
FProcessOptions : TProcessOptions;
FRunCommandSleepTime: Integer;
FStartupOptions : TStartupOptions;
FProcessID : Integer;
FTerminalProgram: String;
@ -101,6 +107,7 @@ Type
procedure SetEnvironment(const Value: TStrings);
Procedure ConvertCommandLine;
function PeekExitStatus: Boolean;
Procedure IntOnIdleSleep(Sender:TObject);
Protected
FRunning : Boolean;
FExitCode : Cardinal;
@ -124,7 +131,7 @@ Type
Function WaitOnExit : Boolean;
Function WaitOnExit(Timeout : DWord) : Boolean;
function ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;
function intRuncommand(out outputstring:string;out stderrstring:string; out anexitstatus:integer):integer;
function RunCommandLoop(out outputstring:string;out stderrstring:string; out anexitstatus:integer):integer;
Property WindowRect : Trect Read GetWindowRect Write SetWindowRect;
Property Handle : THandle Read FProcessHandle;
@ -138,6 +145,9 @@ Type
Property ExitStatus : Integer Read GetExitStatus;
Property ExitCode : Integer Read GetExitCode;
Property InheritHandles : Boolean Read FInheritHandles Write FInheritHandles;
Property OnRunCommandIdleEvent : TOnRunCommandIdleEvent Read FOnRunCommandIdleEvent Write FOnRunCommandIdleEvent;
Property OnRunCommandException : TOnRunCommandException Read FOnRunCommandException Write FOnRunCommandException;
Property RunCommandSleepTime : Integer read FRunCommandSleepTime write FRunCommandSleepTime;
{$ifdef UNIX}
property OnForkEvent : TProcessForkEvent Read FForkEvent Write FForkEvent;
{$endif UNIX}
@ -261,6 +271,8 @@ begin
FPipeBufferSize := 1024;
FEnvironment:=TStringList.Create;
FParameters:=TStringList.Create;
FRunCommandSleepTime:=100;
FOnRunCommandIdleEvent:=@IntOnIdleSleep;
end;
Destructor TProcess.Destroy;
@ -500,11 +512,15 @@ begin
end;
end;
procedure TProcess.IntOnIdleSleep(Sender:TObject);
begin
sleep(FRunCommandSleepTime);
end;
// helperfunction that does the bulk of the work.
// We need to also collect stderr output in order to avoid
// lock out if the stderr pipe is full.
function TProcess.intRuncommand(out outputstring:string;
function TProcess.RunCommandLoop(out outputstring:string;
out stderrstring:string; out anexitstatus:integer):integer;
var
numbytes,bytesread,available : integer;
@ -530,7 +546,8 @@ begin
// if we use poStderrToOutput in p.Options, we do not access invalid memory.
if assigned(stderr) then
if not ReadInputStream(StdErr,StdErrBytesRead,StdErrLength,StdErrString,1) then
sleep(100);
if Assigned(FOnRunCommandIdleEvent) Then
FOnRunCommandIdleEvent(self);
end;
// Get left output after end of execution
ReadInputStream(output,BytesRead,OutputLength,OutputString,250);
@ -545,6 +562,8 @@ begin
result:=1;
setlength(outputstring,BytesRead);
setlength(stderrstring,StderrBytesRead);
if Assigned(FOnRunCommandException) then
FOnRunCommandException(self,e.Message);
end;
end;
end;
@ -570,7 +589,7 @@ begin
for i:=low(commands) to high(commands) do
p.Parameters.add(commands[i]);
try
result:=p.intRuncommand(outputstring,errorstring,exitstatus);
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus);
finally
p.free;
end;
@ -587,7 +606,7 @@ begin
if curdir<>'' then
p.CurrentDirectory:=curdir;
try
result:=p.intRuncommand(outputstring,errorstring,exitstatus)=0;
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
finally
p.free;
end;
@ -611,7 +630,7 @@ begin
for i:=low(commands) to high(commands) do
p.Parameters.add(commands[i]);
try
result:=p.intRuncommand(outputstring,errorstring,exitstatus)=0;
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
finally
p.free;
end;
@ -627,7 +646,7 @@ begin
p:=TProcess.create(nil);
p.setcommandline(cmdline);
try
result:=p.intRuncommand(outputstring,errorstring,exitstatus)=0;
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
finally
p.free;
end;
@ -649,7 +668,7 @@ begin
for i:=low(commands) to high(commands) do
p.Parameters.add(commands[i]);
try
result:=p.intRuncommand(outputstring,errorstring,exitstatus)=0;
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
finally
p.free;
end;