New TProcess that wors for both linux and win32

fcl/inc/process.pp

@@ -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;
+  Result:=FExitCode;
 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.

fcl/linux/Makefile

@@ -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

fcl/linux/Makefile.fpc

@@ -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

fcl/linux/process.inc

@@ -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;

fcl/win32/Makefile.fpc

@@ -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

fcl/win32/process.inc

@@ -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;