123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118 |
- {
- $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.2 2002-09-07 15:15:27 peter
- * old logs removed and tabs fixed
- }
|