mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 11:09:42 +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