mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 12:20:19 +02:00
+ No longer needed
This commit is contained in:
michael
parent
6f93368819
commit
68c994264b
@ -1,124 +0,0 @@
|
|||||||
{
|
|
||||||
$Id$
|
|
||||||
This file is part of the Free Pascal run time library.
|
|
||||||
Copyright (c) 1999-2000 by Michael Van Canneyt
|
|
||||||
|
|
||||||
Linux specific part of TProcess.
|
|
||||||
|
|
||||||
See the file COPYING.FPC, included in this distribution,
|
|
||||||
for details about the copyright.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
||||||
|
|
||||||
**********************************************************************}
|
|
||||||
|
|
||||||
Uses
|
|
||||||
{$ifdef ver1_0}
|
|
||||||
Linux
|
|
||||||
{$else}
|
|
||||||
Unix
|
|
||||||
{$endif}
|
|
||||||
;
|
|
||||||
|
|
||||||
Function TProcess.GetRunning : Boolean;
|
|
||||||
|
|
||||||
begin
|
|
||||||
IF FRunning then
|
|
||||||
FRunning:=GetExitStatus=-1;
|
|
||||||
Result:=FRunning;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Procedure TProcess.Execute;
|
|
||||||
|
|
||||||
begin
|
|
||||||
FreeStreams;
|
|
||||||
CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
|
|
||||||
CreatePipeStreams (FParentInputStream,FChildOutPutStream);
|
|
||||||
If poUsePipes in FCreateOptions then
|
|
||||||
begin
|
|
||||||
if poStdErrToOutPut in FCreateOptions then
|
|
||||||
CreatePipeStreams (FParentErrorStream,FChildErrorStream)
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
FChildErrorStream:=FChildOutPutStream;
|
|
||||||
FParentErrorStream:=FParentInputStream;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
CreatePipeStreams (FParentErrorStream,FChildErrorStream);
|
|
||||||
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
|
|
||||||
FPID:=FHandle;
|
|
||||||
FThreadHandle:=FHandle;
|
|
||||||
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
|
|
||||||
waitpid(FPID, nil, 0);
|
|
||||||
{
|
|
||||||
Result:=WaitForSingleObject (FprocessInformation.hProcess,Infinite);
|
|
||||||
If Result<>Wait_Failed then
|
|
||||||
GetExitStatus;
|
|
||||||
} FRunning:=False;
|
|
||||||
Result := 0;
|
|
||||||
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;
|
|
||||||
|
|
||||||
{
|
|
||||||
$Log$
|
|
||||||
Revision 1.4 2001-04-08 11:26:03 peter
|
|
||||||
* update so it can be compiled by both 1.0.x and 1.1
|
|
||||||
|
|
||||||
Revision 1.3 2001/01/21 20:45:09 marco
|
|
||||||
* Rename fest II FCL version.
|
|
||||||
|
|
||||||
Revision 1.2 2000/07/13 11:33:01 michael
|
|
||||||
+ removed logs
|
|
||||||
|
|
||||||
}
|
|
||||||
@ -1,146 +0,0 @@
|
|||||||
uses windows;
|
|
||||||
|
|
||||||
Function TProcess.GetRunning : Boolean;
|
|
||||||
|
|
||||||
begin
|
|
||||||
IF FRunning then
|
|
||||||
Frunning:=GetExitStatus=Still_Active;
|
|
||||||
Result:=FRunning;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Procedure TProcess.Execute;
|
|
||||||
|
|
||||||
Var PName,PDir : PChar;
|
|
||||||
FStartupInfo : TStartupInfo;
|
|
||||||
FProcessAttributes,
|
|
||||||
FTHreadAttributes : TSecurityAttributes;
|
|
||||||
FProcessInformation : TProcessInformation;
|
|
||||||
status : longbool;
|
|
||||||
|
|
||||||
begin
|
|
||||||
FillChar(FProcessAttributes,SizeOf(FProcessAttributes),#0);
|
|
||||||
FillChar(FThreadAttributes,SizeOf(FThreadAttributes),#0);
|
|
||||||
FillChar(FStartupInfo,SizeOf(FStartupInfo),#0);
|
|
||||||
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;
|
|
||||||
end;
|
|
||||||
With FStartupInfo do
|
|
||||||
begin
|
|
||||||
if poUsePipes in FCreateOptions then
|
|
||||||
begin
|
|
||||||
dwFlags:=dwFlags or Startf_UseStdHandles;
|
|
||||||
hStdInput:=FChildInputStream.Handle;
|
|
||||||
hStdOutput:=FChildOutPutStream.Handle;
|
|
||||||
hStdError:=FChildErrorStream.Handle;
|
|
||||||
end;
|
|
||||||
If (FFillAttribute<>-1) 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:=FWindowWidth;
|
|
||||||
end;
|
|
||||||
if FWindowRows<>-1 then
|
|
||||||
begin
|
|
||||||
dwFlags:=dwFlags or Startf_UseCountChars;
|
|
||||||
dwYCountChars:=FWindowRows;
|
|
||||||
end;
|
|
||||||
if FWindowHeight<>-1 then
|
|
||||||
begin
|
|
||||||
dwFlags:=dwFlags or Startf_UsePosition;
|
|
||||||
dwYsize:=FWindowHeight;
|
|
||||||
end;
|
|
||||||
If FWindowWidth<>-1 then
|
|
||||||
begin
|
|
||||||
dwFlags:=dwFlags or Startf_UsePosition;
|
|
||||||
dwxsize:=FWindowWidth;
|
|
||||||
end;
|
|
||||||
IF FWindowLeft<>-1 then
|
|
||||||
begin
|
|
||||||
dwFlags:=dwFlags or Startf_UseSize;
|
|
||||||
dwx:=FWindowLeft;
|
|
||||||
end;
|
|
||||||
If FWindowTop<>-1 then
|
|
||||||
begin
|
|
||||||
dwFlags:=dwFlags or Startf_UseSize;
|
|
||||||
dwy:=FWindowTop;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
Writeln ('About to start');
|
|
||||||
If FApplicationName<>'' then PName:=Pchar(FApplicationName) else PName:=Nil;
|
|
||||||
If FCurrentDirectory<>'' then PName:=Pchar(FCurrentDirectory) else PDir:=Nil;
|
|
||||||
Status:=CreateProcess (Pname,PChar(FCommandLine),@FProcessAttributes,@FThreadAttributes,
|
|
||||||
FInheritHandles,FCreationFlags,FEnvironment,PDir,@FStartupInfo,
|
|
||||||
@fProcessInformation);
|
|
||||||
Writeln ('Created ',Status);
|
|
||||||
FTHreadHandle:=fProcessInformation.hthread;
|
|
||||||
Writeln ('ThreadHandle :',FThreadHandle);
|
|
||||||
FHandle:=fProcessInformation.hProcess;
|
|
||||||
Writeln ('Process Handle :',FHandle);
|
|
||||||
FPID:=fProcessInformation.dwProcessID;
|
|
||||||
Writeln ('Process Handle :',FPID);
|
|
||||||
FRunning:=True;
|
|
||||||
if (poWaitOnExit in FCreateOptions) and
|
|
||||||
not (poRunSuspended in FCreateOptions) then
|
|
||||||
WaitOnExit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Function TProcess.WaitOnExit : Dword;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Result:=WaitForSingleObject (FHandle,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;
|
|
||||||
{
|
|
||||||
$Log$
|
|
||||||
Revision 1.3 2000-07-25 11:27:35 jonas
|
|
||||||
* fixed missing comment openers for log section
|
|
||||||
|
|
||||||
Revision 1.2 2000/07/13 11:33:07 michael
|
|
||||||
+ removed logs
|
|
||||||
|
|
||||||
}
|
|
||||||
Loading…
Reference in New Issue
Block a user