mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 19:29:24 +02:00
New TProcess that wors for both linux and win32
This commit is contained in:
michael
parent
651297ed6e
commit
1b1f3d5850
@ -5,7 +5,10 @@ unit Process;
|
||||
|
||||
interface
|
||||
|
||||
Uses Classes,Pipes,Windows;
|
||||
Uses Classes,Pipes;
|
||||
|
||||
Type
|
||||
THandle = Longint;
|
||||
|
||||
Type
|
||||
TProcessOptions = (poExecuteOnCreate,poRunSuspended,poUsePipes,
|
||||
@ -15,7 +18,15 @@ Type
|
||||
|
||||
TProcess = Class (TObject)
|
||||
Private
|
||||
FAccess : Cardinal;
|
||||
FShowWindow : Boolean;
|
||||
FFillAttribute,
|
||||
FWindowColumns,
|
||||
FWindowHeight,
|
||||
FWindowLeft,
|
||||
FWindowRows,
|
||||
FWindowTop,
|
||||
FWindowWidth : Cardinal;
|
||||
FWindowRect : TRect;
|
||||
FApplicationName : string;
|
||||
FChildErrorStream : TOutPutPipeStream;
|
||||
FChildInputSTream : TInputPipeStream;
|
||||
@ -34,29 +45,12 @@ Type
|
||||
FParentInputSTream : TInputPipeStream;
|
||||
FParentOutputStream : TOutPutPipeStream;
|
||||
FPrepared : Boolean;
|
||||
FProcessAttributes : PSecurityAttributes;
|
||||
FProcessInformation : TProcessInformation;
|
||||
FRunning : Boolean;
|
||||
FStartupInfo : TStartupInfo;
|
||||
FThreadAttributes : PSecurityAttributes;
|
||||
Procedure FreeStreams;
|
||||
Function GetExitStatus : Integer;
|
||||
Function GetHandle : THandle;
|
||||
Function GetProcessAttributes : TSecurityAttributes;
|
||||
Function GetRunning : Boolean;
|
||||
Function GetThreadAttributes : TSecurityAttributes;
|
||||
Function GetWindowRect : TRect;
|
||||
Procedure SetFillAttribute (Value : Cardinal);
|
||||
Procedure SetProcessAttributes (Value : TSecurityAttributes);
|
||||
Procedure SetShowWindow (Value : Word);
|
||||
Procedure SetThreadAttributes (Value : TSecurityAttributes);
|
||||
Procedure SetWindowColumns (Value : Cardinal);
|
||||
Procedure SetWindowHeight (Value : Cardinal);
|
||||
Procedure SetWindowLeft (Value : Cardinal);
|
||||
Procedure SetWindowRect (Value : TRect);
|
||||
Procedure SetWindowRows (Value : Cardinal);
|
||||
Procedure SetWindowTop (Value : Cardinal);
|
||||
Procedure SetWindowWidth (Value : Cardinal);
|
||||
Public
|
||||
Constructor Create (Const ACommandline : String;
|
||||
Options : TCreateOptions);
|
||||
@ -78,53 +72,33 @@ Type
|
||||
Property DeskTop : String Read FDeskTop Write FDeskTop;
|
||||
Property Environment : Pointer Read FEnvironment Write FEnvironment;
|
||||
Property ExitStatus : Integer Read GetExitStatus;
|
||||
Property FillAttribute : Cardinal Read FStartupInfo.dwFillAttribute
|
||||
Write SetFillAttribute;
|
||||
Property Handle : THandle Read FProcessInformation.hProcess;
|
||||
Property FillAttribute : Cardinal Read FFillAttribute Write FFillAttribute;
|
||||
Property Handle : THandle Read FHandle;
|
||||
Property Input : TOutPutPipeStream Read FParentOutPutStream;
|
||||
Property InheritHandles : LongBool Read FInheritHandles;
|
||||
Property OutPut : TInputPipeStream Read FParentInputStream;
|
||||
Property ProcessAttributes : TSecurityAttributes
|
||||
Read GetProcessAttributes
|
||||
Write SetProcessAttributes;
|
||||
Property ProcessInformation : TProcessInformation
|
||||
Read FPRocessInformation;
|
||||
Property Running : Boolean Read GetRunning;
|
||||
Property ShowWindow : Word Read FStartupInfo.wShowWindow
|
||||
Write SetShowWindow;
|
||||
Property StartupInfo : TStartupInfo Read FStartupInfo;
|
||||
Property ShowWindow : Boolean Read FShowWindow Write FShowWindow;
|
||||
Property StdErr : TinputPipeStream Read FParentErrorStream;
|
||||
Property ThreadAttributes : TSecurityAttributes
|
||||
Read GetThreadAttributes
|
||||
Write SetThreadAttributes;
|
||||
Property ThreadHandle : THandle Read FprocessInformation.hThread;
|
||||
Property WindowColumns : Cardinal Read FStartupInfo.dwXCountchars
|
||||
Write SetWindowColumns;
|
||||
Property WindowHeight : Cardinal Read FStartupInfo.dwYsize
|
||||
Write SetWindowHeight;
|
||||
Property WindowLeft : Cardinal Read FStartupInfo.dwx
|
||||
Write SetWindowLeft;
|
||||
Property WindowRows : Cardinal Read FStartupInfo.dwYcountChars
|
||||
Write SetWindowRows;
|
||||
Property WindowTop : Cardinal Read FStartupInfo.dwy
|
||||
Write SetWindowTop ;
|
||||
Property WindowWidth : Cardinal Read FStartupInfo.dwXsize
|
||||
Write SetWindowWidth;
|
||||
Property WindowRect : Trect Read GetWindowRect
|
||||
Write SetWindowRect;
|
||||
|
||||
Property WindowColumns : Cardinal Read FWindowColumns Write FWindowColumns;
|
||||
Property WindowHeight : Cardinal Read FWindowHeight Write FWindowHeight;
|
||||
Property WindowLeft : Cardinal Read FWindowLeft Write FWindowLeft;
|
||||
Property WindowRows : Cardinal Read FWindowRows Write FWindowRows;
|
||||
Property WindowTop : Cardinal Read FWindowTop Write FWindowTop;
|
||||
Property WindowWidth : Cardinal Read FWindowWidth Write FWindowWidth;
|
||||
Property WindowRect : Trect Read GetWindowRect Write SetWindowRect;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$i process.inc}
|
||||
|
||||
Constructor TProcess.Create (Const ACommandline : String;
|
||||
Options : TCreateOptions);
|
||||
begin
|
||||
Inherited create;
|
||||
FCreateOptions:=Options;
|
||||
FCommandLine:=ACommandLine;
|
||||
FAccess:=PROCESS_ALL_ACCESS;
|
||||
FStartupInfo.cb:=SizeOf(TStartupInfo);
|
||||
FInheritHandles:=True;
|
||||
If poExecuteOnCreate in FCreateOptions then
|
||||
execute;
|
||||
@ -133,18 +107,19 @@ end;
|
||||
Destructor TProcess.Destroy;
|
||||
|
||||
begin
|
||||
If assigned (FProcessAttributes) then Dispose (FPRocessAttributes);
|
||||
If assigned (FThreadAttributes) then Dispose (FThreadAttributes);
|
||||
FreeStreams;
|
||||
end;
|
||||
|
||||
Procedure TProcess.FreeStreams;
|
||||
|
||||
begin
|
||||
FParentErrorStream.Free;
|
||||
if FChildErrorStream<>FChildoutputStream then
|
||||
begin
|
||||
FChildErrorStream.free;
|
||||
FParentErrorStream.free;
|
||||
end;
|
||||
FParentInputSTream.Free;
|
||||
FParentOutputStream.Free;
|
||||
FChildErrorStream.free;
|
||||
FChildInputSTream.Free;
|
||||
FChildOutPutStream.Free;
|
||||
end;
|
||||
@ -152,229 +127,33 @@ end;
|
||||
Function TProcess.GetExitStatus : Integer;
|
||||
|
||||
begin
|
||||
{
|
||||
If FRunning then
|
||||
GetExitCodeProcess(Handle,@FExitCode);
|
||||
}
|
||||
Result:=FExitCode;
|
||||
end;
|
||||
|
||||
Function TProcess.GetHandle : THandle;
|
||||
|
||||
begin
|
||||
IF FHandle=0 Then
|
||||
FHandle:=OpenProcess (FAccess,True,FProcessInformation.dwProcessId);
|
||||
Result:=FHandle
|
||||
end;
|
||||
|
||||
Function TProcess.GetProcessAttributes : TSecurityAttributes;
|
||||
|
||||
Var P : PSecurityAttributes;
|
||||
|
||||
begin
|
||||
IF not Assigned(FProcessAttributes) then
|
||||
begin
|
||||
// Provide empty dummy value;
|
||||
New(p);
|
||||
Fillchar(p^,Sizeof(TSecurityAttributes),0);
|
||||
Result:=p^;
|
||||
end
|
||||
else
|
||||
REsult:=FProcessAttributes^;
|
||||
end;
|
||||
|
||||
Function TProcess.GetRunning : Boolean;
|
||||
|
||||
begin
|
||||
IF FRunning then
|
||||
Frunning:=GetExitStatus=Still_Active;
|
||||
Result:=FRunning;
|
||||
end;
|
||||
|
||||
Function TProcess.GetThreadAttributes : TSecurityAttributes;
|
||||
|
||||
Var P : PSecurityAttributes;
|
||||
|
||||
begin
|
||||
IF not Assigned(FThreadAttributes) then
|
||||
begin
|
||||
// Provide empty dummy value;
|
||||
New(p);
|
||||
Fillchar(p^,Sizeof(TSecurityAttributes),0);
|
||||
Result:=p^;
|
||||
end
|
||||
else
|
||||
Result:=FThreadAttributes^;
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetProcessAttributes (Value : TSecurityAttributes);
|
||||
|
||||
begin
|
||||
If not Assigned (FProcessAttributes) then
|
||||
New(FProcessAttributes);
|
||||
FPRocessAttributes^:=VAlue;
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetThreadAttributes (Value : TSecurityAttributes);
|
||||
|
||||
begin
|
||||
If not Assigned (FThreadAttributes) then
|
||||
New(FThreadAttributes);
|
||||
FThreadAttributes^:=VAlue;
|
||||
end;
|
||||
|
||||
Procedure TProcess.Execute;
|
||||
|
||||
Var PName,PDir : PChar;
|
||||
|
||||
begin
|
||||
if poNoConsole in FCReateOptions then
|
||||
FCreationFlags:=FCreationFlags or Detached_Process;
|
||||
If poRunSuspended in FCreateOptions Then
|
||||
FCreationFlags:=FCreationFlags or Create_Suspended;
|
||||
If poUsePipes in FCreateOptions then
|
||||
begin
|
||||
FreeStreams;
|
||||
{ // This construct was supported on Win32 only. The new call takes this as a default.
|
||||
CreatePipeStreams (FChildInputSTream,FParentOutPutStream,@piInheritablePipe,1024);
|
||||
CreatePipeStreams (FParentInputStream,FChildOutPutStream,@piInheritablePipe,1024);
|
||||
}
|
||||
CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
|
||||
CreatePipeStreams (FParentInputStream,FChildOutPutStream);
|
||||
if poStdErrToOutPut in FCreateOptions then
|
||||
{
|
||||
CreatePipeStreams (FParentErrorStream,FChildErrorStream,@piInheritablePipe,1024)
|
||||
}
|
||||
CreatePipeStreams (FParentErrorStream,FChildErrorStream)
|
||||
else
|
||||
begin
|
||||
FChildErrorStream:=FChildOutPutStream;
|
||||
FParentErrorStream:=FParentInputStream;
|
||||
end;
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UseStdHandles;
|
||||
FStartupInfo.hStdInput:=FChildInputStream.Handle;
|
||||
FStartupInfo.hStdOutput:=FChildOutPutStream.Handle;
|
||||
FStartupInfo.hStdError:=FChildErrorStream.Handle;
|
||||
end;
|
||||
If FApplicationName<>'' then PName:=Pchar(FApplicationName) else PName:=Nil;
|
||||
If FCurrentDirectory<>'' then PName:=Pchar(FCurrentDirectory) else PDir:=Nil;
|
||||
CreateProcess (Pname,PChar(FCommandLine),FProcessAttributes,FThreadAttributes,
|
||||
FInheritHandles,FCreationFlags,FEnvironment,PDir,@FStartupInfo,
|
||||
@fProcessInformation);
|
||||
FRunning:=True;
|
||||
if (poWaitOnExit in FCreateOptions) and
|
||||
not (poRunSuspended in FCreateOptions) then
|
||||
WaitOnExit;
|
||||
end;
|
||||
|
||||
Function TProcess.WaitOnExit : Dword;
|
||||
|
||||
begin
|
||||
Result:=WaitForSingleObject (FprocessInformation.hProcess,Infinite);
|
||||
If Result<>Wait_Failed then
|
||||
GetExitStatus;
|
||||
FRunning:=False;
|
||||
end;
|
||||
|
||||
Function TProcess.Suspend : Longint;
|
||||
|
||||
begin
|
||||
Result:=SuspendThread(ThreadHandle);
|
||||
end;
|
||||
|
||||
Function TProcess.Resume : LongInt;
|
||||
|
||||
begin
|
||||
Result:=ResumeThread(ThreadHandle);
|
||||
end;
|
||||
|
||||
Function TProcess.Terminate(AExitCode : Integer) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
If ExitStatus=Still_active then
|
||||
Result:=TerminateProcess(Handle,AexitCode);
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetFillAttribute (Value : Cardinal);
|
||||
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UseFillAttribute;
|
||||
FStartupInfo.dwFillAttribute:=Value;
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetShowWindow (Value : Word);
|
||||
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UseShowWindow;
|
||||
FStartupInfo.dwXCountChars:=Value;
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetWindowColumns (Value : Cardinal);
|
||||
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UseCountChars;
|
||||
FStartupInfo.dwXCountChars:=Value;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TProcess.SetWindowHeight (Value : Cardinal);
|
||||
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UsePosition;
|
||||
FStartupInfo.dwYsize:=Value;
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetWindowLeft (Value : Cardinal);
|
||||
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UseSize;
|
||||
FStartupInfo.dwx:=Value;
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetWindowTop (Value : Cardinal);
|
||||
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UseSize;
|
||||
FStartupInfo.dwy:=Value;
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetWindowWidth (Value : Cardinal);
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UsePosition;
|
||||
FStartupInfo.dwxsize:=Value;
|
||||
end;
|
||||
|
||||
Function TProcess.GetWindowRect : TRect;
|
||||
begin
|
||||
With Result do
|
||||
With FStartupInfo do
|
||||
begin
|
||||
Left:=dwx;
|
||||
Right:=dwx+dwxSize;
|
||||
Top:=dwy;
|
||||
Bottom:=dwy+dwysize;
|
||||
end;
|
||||
begin
|
||||
Left:=FWindowLeft;
|
||||
Top:=FWindowTop;
|
||||
Right:=FWindowLeft+FWindowWidth;
|
||||
Bottom:=FWindowTop+FWindowRows;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TProcess.SetWindowRect (Value : Trect);
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UseSize;
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UsePosition;
|
||||
With Value do
|
||||
With FStartupInfo do
|
||||
begin
|
||||
dwx:=Left;
|
||||
dwxSize:=Right-Left;
|
||||
dwy:=Top;
|
||||
dwySize:=Bottom-top;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TProcess.SetWindowRows (Value : Cardinal);
|
||||
|
||||
begin
|
||||
FStartupInfo.dwFlags:=FStartupInfo.dwFlags or Startf_UseCountChars;
|
||||
FStartupInfo.dwYCountChars:=Value;
|
||||
begin
|
||||
FWindowLeft:=Left;
|
||||
FWindowWidth:=Right-Left;
|
||||
FWindowTop:=Top;
|
||||
FWindowRows:=Bottom-top;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Makefile generated by fpcmake v0.99.13 [2000/02/09]
|
||||
# Makefile generated by fpcmake v0.99.13 [2000/02/08]
|
||||
#
|
||||
|
||||
defaultrule: all
|
||||
@ -204,7 +204,7 @@ endif
|
||||
|
||||
# Targets
|
||||
|
||||
override UNITOBJECTS+=classes $(INCUNITS) $(XMLUNITS) $(SHEDITUNITS)
|
||||
override UNITOBJECTS+=classes $(INCUNITS) $(XMLUNITS) $(SHEDITUNITS) process
|
||||
|
||||
# Clean
|
||||
|
||||
@ -749,16 +749,6 @@ override FPCOPT+=-Xs -OG2p3 -n
|
||||
endif
|
||||
endif
|
||||
|
||||
# Strip
|
||||
ifdef STRIP
|
||||
override FPCOPT+=-Xs
|
||||
endif
|
||||
|
||||
# Optimizer
|
||||
ifdef OPTIMIZE
|
||||
override FPCOPT+=-OG2p3
|
||||
endif
|
||||
|
||||
# Verbose settings (warning,note,info)
|
||||
ifdef VERBOSE
|
||||
override FPCOPT+=-vwni
|
||||
@ -1189,3 +1179,5 @@ ezcgi$(PPUEXT): $(INC)/ezcgi$(PASEXT)
|
||||
|
||||
shedit$(PPUEXT): $(SHEDIT)/shedit$(PASEXT)
|
||||
$(COMPILER) $(SHEDIT)/shedit$(PASEXT) -I$(SHEDIT) $(REDIR)
|
||||
|
||||
process$(PPUEXT): process$(PASEXT) process.inc
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
#
|
||||
|
||||
[targets]
|
||||
units=classes $(INCUNITS) $(XMLUNITS) $(SHEDITUNITS)
|
||||
units=classes $(INCUNITS) $(XMLUNITS) $(SHEDITUNITS) process
|
||||
|
||||
[defaults]
|
||||
defaulttarget=linux
|
||||
@ -48,3 +48,5 @@ ezcgi$(PPUEXT): $(INC)/ezcgi$(PASEXT)
|
||||
|
||||
shedit$(PPUEXT): $(SHEDIT)/shedit$(PASEXT)
|
||||
$(COMPILER) $(SHEDIT)/shedit$(PASEXT) -I$(SHEDIT) $(REDIR)
|
||||
|
||||
process$(PPUEXT): process$(PASEXT) process.inc
|
||||
|
||||
84
fcl/linux/process.inc
Normal file
84
fcl/linux/process.inc
Normal file
@ -0,0 +1,84 @@
|
||||
uses linux;
|
||||
|
||||
Function TProcess.GetRunning : Boolean;
|
||||
|
||||
begin
|
||||
IF FRunning then
|
||||
FRunning:=GetExitStatus=-1;
|
||||
Result:=FRunning;
|
||||
end;
|
||||
|
||||
Procedure TProcess.Execute;
|
||||
|
||||
begin
|
||||
If poUsePipes in FCreateOptions then
|
||||
begin
|
||||
FreeStreams;
|
||||
CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
|
||||
CreatePipeStreams (FParentInputStream,FChildOutPutStream);
|
||||
if poStdErrToOutPut in FCreateOptions then
|
||||
CreatePipeStreams (FParentErrorStream,FChildErrorStream)
|
||||
else
|
||||
begin
|
||||
FChildErrorStream:=FChildOutPutStream;
|
||||
FParentErrorStream:=FParentInputStream;
|
||||
end;
|
||||
end;
|
||||
If FCurrentDirectory<>'' then
|
||||
Chdir(FCurrentDirectory);
|
||||
FHandle:=fork();
|
||||
if FHandle=0 then
|
||||
begin
|
||||
// Child
|
||||
fdClose(0);
|
||||
fdClose(1);
|
||||
fdclose(2);
|
||||
dup2(FChildInputStream.Handle,0);
|
||||
dup2(FCHildOutputStream.Handle,1);
|
||||
dup2(FChildErrorStream.Handle,2);
|
||||
execl(FCommandline);
|
||||
halt(127);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Parent
|
||||
|
||||
fdclose(FChildOutputStream.Handle);
|
||||
fdclose(FChildInputStream.Handle);
|
||||
fdclose(FChildErrorStream.Handle);
|
||||
FRunning:=True;
|
||||
if (poWaitOnExit in FCreateOptions) and
|
||||
not (poRunSuspended in FCreateOptions) then
|
||||
WaitOnExit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TProcess.WaitOnExit : Dword;
|
||||
|
||||
begin
|
||||
{
|
||||
Result:=WaitForSingleObject (FprocessInformation.hProcess,Infinite);
|
||||
If Result<>Wait_Failed then
|
||||
GetExitStatus;
|
||||
} FRunning:=False;
|
||||
end;
|
||||
|
||||
Function TProcess.Suspend : Longint;
|
||||
|
||||
begin
|
||||
Result:=Kill(Handle,SIGSTOP);
|
||||
end;
|
||||
|
||||
Function TProcess.Resume : LongInt;
|
||||
|
||||
begin
|
||||
Result:=Kill(FHandle,SIGCONT);
|
||||
end;
|
||||
|
||||
Function TProcess.Terminate(AExitCode : Integer) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
If ExitStatus=-1 then
|
||||
Result:=Kill(FHandle,SIGTERM)=0;
|
||||
end;
|
||||
@ -48,3 +48,5 @@ ezcgi$(PPUEXT): $(INC)/ezcgi$(PASEXT)
|
||||
|
||||
shedit$(PPUEXT): $(SHEDIT)/shedit$(PASEXT)
|
||||
$(COMPILER) $(SHEDIT)/shedit$(PASEXT) -I$(SHEDIT) $(REDIR)
|
||||
|
||||
process$(PPUEXT): process$(PASEXT) process.inc
|
||||
|
||||
117
fcl/win32/process.inc
Normal file
117
fcl/win32/process.inc
Normal file
@ -0,0 +1,117 @@
|
||||
uses windows;
|
||||
|
||||
Function TProcess.GetRunning : Boolean;
|
||||
|
||||
begin
|
||||
IF FRunning then
|
||||
Frunning:=GetExitStatus=Still_Active;
|
||||
Result:=FRunning;
|
||||
end;
|
||||
|
||||
Procedure TProcess.Execute;
|
||||
|
||||
Var PName,PDir : PChar;
|
||||
|
||||
begin
|
||||
if poNoConsole in FCReateOptions then
|
||||
FCreationFlags:=FCreationFlags or Detached_Process;
|
||||
If poRunSuspended in FCreateOptions Then
|
||||
FCreationFlags:=FCreationFlags or Create_Suspended;
|
||||
If poUsePipes in FCreateOptions then
|
||||
begin
|
||||
FreeStreams;
|
||||
CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
|
||||
CreatePipeStreams (FParentInputStream,FChildOutPutStream);
|
||||
if poStdErrToOutPut in FCreateOptions then
|
||||
CreatePipeStreams (FParentErrorStream,FChildErrorStream)
|
||||
else
|
||||
begin
|
||||
FChildErrorStream:=FChildOutPutStream;
|
||||
FParentErrorStream:=FParentInputStream;
|
||||
end;
|
||||
With FStartupInfo do
|
||||
begin
|
||||
dwFlags:=FStartupInfo.dwFlags or Startf_UseStdHandles;
|
||||
hStdInput:=FChildInputStream.Handle;
|
||||
hStdOutput:=FChildOutPutStream.Handle;
|
||||
hStdError:=FChildErrorStream.Handle;
|
||||
If (FFillAttribute<>0) then
|
||||
begin
|
||||
dwFlags:=dwFlags or Startf_UseFillAttribute;
|
||||
dwFillAttribute:=FFIllAttribute;
|
||||
end;
|
||||
If FShowWindow then
|
||||
begin
|
||||
dwFlags:=dwFlags or Startf_UseShowWindow;
|
||||
// ?? dwXCountChars:=Value;
|
||||
end;
|
||||
if FWindowWidth<>-1 then
|
||||
begin
|
||||
dwFlags:=dwFlags or Startf_UseCountChars;
|
||||
dwXCountChars:=Value;
|
||||
end;
|
||||
if FWindowRows<>-1 then
|
||||
begin
|
||||
dwFlags:=dwFlags or Startf_UseCountChars;
|
||||
dwYCountChars:=Value;
|
||||
end;
|
||||
if FWindowHeight<>-1 then
|
||||
begin
|
||||
dwFlags:=dwFlags or Startf_UsePosition;
|
||||
dwYsize:=Value;
|
||||
end;
|
||||
If FWindowWidth<>-1 then
|
||||
begin
|
||||
dwFlags:=dwFlags or Startf_UsePosition;
|
||||
dwxsize:=Value;
|
||||
end;
|
||||
IF FWindowLeft<>-1 then
|
||||
begin
|
||||
dwFlags:=dwFlags or Startf_UseSize;
|
||||
dwx:=Value;
|
||||
end;
|
||||
If FWindowTop<>-1 then
|
||||
begin
|
||||
dwFlags:=dwFlags or Startf_UseSize;
|
||||
dwy:=Value;
|
||||
end;
|
||||
end;
|
||||
If FApplicationName<>'' then PName:=Pchar(FApplicationName) else PName:=Nil;
|
||||
If FCurrentDirectory<>'' then PName:=Pchar(FCurrentDirectory) else PDir:=Nil;
|
||||
CreateProcess (Pname,PChar(FCommandLine),FProcessAttributes,FThreadAttributes,
|
||||
FInheritHandles,FCreationFlags,FEnvironment,PDir,@FStartupInfo,
|
||||
@fProcessInformation);
|
||||
FRunning:=True;
|
||||
if (poWaitOnExit in FCreateOptions) and
|
||||
not (poRunSuspended in FCreateOptions) then
|
||||
WaitOnExit;
|
||||
end;
|
||||
|
||||
Function TProcess.WaitOnExit : Dword;
|
||||
|
||||
begin
|
||||
Result:=WaitForSingleObject (FprocessInformation.hProcess,Infinite);
|
||||
If Result<>Wait_Failed then
|
||||
GetExitStatus;
|
||||
FRunning:=False;
|
||||
end;
|
||||
|
||||
Function TProcess.Suspend : Longint;
|
||||
|
||||
begin
|
||||
Result:=SuspendThread(ThreadHandle);
|
||||
end;
|
||||
|
||||
Function TProcess.Resume : LongInt;
|
||||
|
||||
begin
|
||||
Result:=ResumeThread(ThreadHandle);
|
||||
end;
|
||||
|
||||
Function TProcess.Terminate(AExitCode : Integer) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
If ExitStatus=Still_active then
|
||||
Result:=TerminateProcess(Handle,AexitCode);
|
||||
end;
|
||||
Loading…
Reference in New Issue
Block a user