paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 05:40:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* centralize some type definitions so that they are compatible between process and processunicode

Browse Source 
* add an extra parameter to the callback in preparation of readoutput callbacks. 
   This is needed to let the callback differentiate between stderr or stdout callbacks
 * rename processunicode class to TProcess on recommendation of MvC.

git-svn-id: trunk@39651 -
This commit is contained in:
marco 2018-08-20 11:46:11 +00:00
parent bffbff73e1
commit 8554332c1d
3 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -40,6 +40,13 @@ Type
TProcessOptions = set of TProcessOption; TProcessOptions = set of TProcessOption;
TStartupOptions = set of TStartupOption; TStartupOptions = set of TStartupOption;
TRunCommandEventCode = (RunCommandIdle,RunCommandReadOutput,RunCommandFinished,RunCommandException);
TOnRunCommandEvent = procedure(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:string) of object;
EProcess = Class(Exception);
{$ifdef UNIX}
TProcessForkEvent = procedure(Sender : TObject) of object;
{$endif UNIX}
{$macro on} {$macro on}
{define processunicodestring} {define processunicodestring}

18
packages/fcl-process/src/processbody.inc
View File

@ -40,13 +40,6 @@ Type
TProcessStringList = TStringList; TProcessStringList = TStringList;
{$endif} {$endif}
{$ifdef UNIX}
TProcessForkEvent = procedure(Sender : TObject) of object;
{$endif UNIX}
TRunCommandEventCode = (RunCommandIdle,RunCommandFinished,RunCommandException);
TOnRunCommandEvent = procedure(Sender : TObject;Status:TRunCommandEventCode;const Message:string) of object;
{ TProcess } { TProcess }
TProcessnamemacro = Class (TComponent) TProcessnamemacro = Class (TComponent)
@ -103,7 +96,7 @@ Type
procedure SetEnvironment(const Value: TProcessStrings); procedure SetEnvironment(const Value: TProcessStrings);
Procedure ConvertCommandLine; Procedure ConvertCommandLine;
function PeekExitStatus: Boolean; function PeekExitStatus: Boolean;
Procedure IntOnIdleSleep(Sender : TObject;Status:TRunCommandEventCode;const Message:String); Procedure IntOnIdleSleep(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:String);
Protected Protected
FRunning : Boolean; FRunning : Boolean;
FExitCode : Cardinal; FExitCode : Cardinal;
@ -174,7 +167,6 @@ Type
end; end;
TProcessClass = Class of TProcessnamemacro; TProcessClass = Class of TProcessnamemacro;
EProcess = Class(Exception);
Procedure CommandToList(S : TProcessString; List : TProcessStrings); Procedure CommandToList(S : TProcessString; List : TProcessStrings);
@ -532,7 +524,7 @@ begin
end; end;
end; end;
procedure TProcessnamemacro.IntOnIdleSleep(Sender : TObject;status:TRunCommandEventCode;const message:string); procedure TProcessnamemacro.IntOnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
begin begin
if status=RunCommandIdle then if status=RunCommandIdle then
sleep(FRunCommandSleepTime); sleep(FRunCommandSleepTime);
@ -571,7 +563,7 @@ begin
gotoutputstderr:=ReadInputStream(StdErr,StdErrBytesRead,StdErrLength,StdErrString,1); gotoutputstderr:=ReadInputStream(StdErr,StdErrBytesRead,StdErrLength,StdErrString,1);
if not gotoutput and not gotoutputstderr and Assigned(FOnRunCommandEvent) Then if not gotoutput and not gotoutputstderr and Assigned(FOnRunCommandEvent) Then
FOnRunCommandEvent(self,RunCommandIdle,''); FOnRunCommandEvent(self,Nil,RunCommandIdle,'');
end; end;
// Get left output after end of execution // Get left output after end of execution
ReadInputStream(output,BytesRead,OutputLength,OutputString,250); ReadInputStream(output,BytesRead,OutputLength,OutputString,250);
@ -582,7 +574,7 @@ begin
anexitstatus:=exitstatus; anexitstatus:=exitstatus;
result:=0; // we came to here, document that. result:=0; // we came to here, document that.
if Assigned(FOnRunCommandEvent) then // allow external apps to react to that and finish GUI if Assigned(FOnRunCommandEvent) then // allow external apps to react to that and finish GUI
FOnRunCommandEvent(self,RunCommandFinished,''); FOnRunCommandEvent(self,Nil,RunCommandFinished,'');
except except
on e : Exception do on e : Exception do
@ -591,7 +583,7 @@ begin
setlength(outputstring,BytesRead); setlength(outputstring,BytesRead);
setlength(stderrstring,StderrBytesRead); setlength(stderrstring,StderrBytesRead);
if Assigned(FOnRunCommandEvent) then if Assigned(FOnRunCommandEvent) then
FOnRunCommandEvent(self,RunCommandException,e.Message); FOnRunCommandEvent(self,Nil,RunCommandException,e.Message);
end; end;
end; end;
end; end;

9
packages/fcl-process/src/processunicode.pp
View File

@ -29,10 +29,17 @@ Type
TProcessPriority = process.TProcessPriority; TProcessPriority = process.TProcessPriority;
TProcessOptions = process.TProcessOptions; TProcessOptions = process.TProcessOptions;
TStartupOptions = process.TStartupOptions; TStartupOptions = process.TStartupOptions;
{$ifdef UNIX}
TProcessForkEvent = Process.TProcessForkEvent;
{$endif UNIX}
TRunCommandEventCode = Process.TRunCommandEventCode;
TOnRunCommandEvent = Process.TOnRunCommandEvent;
EProcess = Process.EProcess;
{$macro on} {$macro on}
{$define processunicodestring} {$define processunicodestring}
{$define TProcessnamemacro:=TProcessUnicode} {$define TProcessnamemacro:=TProcess}
{$i processbody.inc} {$i processbody.inc}
end. end.