Diff for /mozptch/linux_system.pas between versions 1.1 and 1.2

version 1.1, 2004/05/13 15:20:51 version 1.2, 2004/05/30 19:51:15
Line 1 Line 1
 unit linux_system;  unit linux_system;
 //http://rick-ross.com/papers/borcon2001/6204.html  //http://rick-ross.com/papers/borcon2001/6204.html
   //linkill from
   // Written for "Kylix Power Solutions" 
   // Copyright (c) 2001, Coriolis Group Books
 interface  interface
uses Classes,Process;uses Classes, libc, SysUtils, fork_exec, ProcStuff;
 // forward definition  // forward definition
 TExecuter = class;  
TForkerEventProc = procedure of Object;procedure linStart(cmdline : string);
TForkerWhichProc = (wpParent, wpChild);function start(commandline : string) : boolean;
procedure linKill(name : string);
TForker = class 
  FDebug        : boolean; 
  FOnChild      : TForkerEventProc; 
  FWait         : boolean; 
  FExec         : TExecuter; 
  FStatus       : integer; 
  procedure DebugMsg(msg : string); 
  constructor Create; 
  function    DoFork : TForkerWhichProc; 
  procedure   DoWait; 
  property Debug        : boolean          read FDebug   write FDebug; 
  property OnChild      : TForkerEventProc read FOnChild write FOnChild; 
  property WaitForChild : boolean          read FWait    write FWait; 
  property Exec         : TExecuter        read FExec    write FExec; 
  property WaitStatus   : integer          read FStatus; 
TArgArray = array of AnsiString; 
TExecuter = class 
  FDebug    : Boolean; 
  FParms    : TStrings; 
  FProcName : AnsiString; 
  function StringListToCarray( cmd : AnsiString; 
                               strlst : TStrings ) : TArgArray; 
  procedure DebugMsg(msg : string); 
  function ListArgArray(aa : TArgArray) : string; 
  constructor Create; 
  destructor  Destroy; override; 
  procedure   Exec; 
  property Debug       : boolean      read FDebug    write FDebug; 
  property Parameters  : TStrings     read FParms    write FParms; 
  property ProcessName : AnsiString   read FProcName write FProcName; 
 implementation  implementation
 //The constructor initializes some default values.  
 constructor TForker.Create;  
   inherited Create;  
   FDebug := false;  
   FWait  := true;  
 //The DoFork method is the most complex function. It handles the actual forking code and determines what the class needs to do. Immeadiately, it calls the fork function. If fork returns an error, an exception is raised. When the child code is being executed, it first checks to see if the OnChild event has been assigned. If so, it calls the OnChild event. Next, it checks to see if the Exec property has been assigned. If so, it calls the Exec method. Finally, it returns notifying the caller that it is the child process. When the parent code is being executed, it checks the WaitForChild property and waits if necessary. When the waiting is over, or if there is no reason to wait, it returns, notifying the caller that it is in the parent process.  
 function   TForker.DoFork : TForkerWhichProc;  
   i : integer;  
   i := fork;  
   if i = -1 then  
     raise Exception.CreateFmt('Unable to fork: Error is %d',[GetLastError]);  
   else if i = 0 then  
     // we are in the child...  
     Result := wpChild;  
     // call the child  
     if Assigned (FOnChild) then  
     else if Assigned (FExec) then  
       // do the exec thing..  
     // otherwise we fall through and let the  
     // caller handle it..  
     // we are the parent...  
     Result := wpParent;  
     if FWait then  
       // wait for child  
 //The DoWait method, is using the blocking version of wait. Call this method when the parent process needs more control and does not want to have the TForker class do the waiting.  
 procedure TForker.DoWait;  
 begin  if not FWait then  
 //OnChild Property  
 //The OnChild property provides a callback method when the child process is being executed.  
 //WaitForChild Property  
 //This property determines if the TForker class will wait for the child or allow the parent to decide to wait or not.  
 //Creating an "Exec"ing Class  
 //Now it is time to write a class that wraps an exec function. This class will take a process name, a list of parameters and exec the process. In this implementation, only the execv function is being used. In order to support the other variations of the exec family functions, an environment property would need to be added and a method of choosing which exec function to use.  
 //Class Definition  
 //In the constructor, properties are created and initialized.  
 constructor TExecuter.Create;  
   inherited Create;  
   FDebug    := false;  
   FProcName := '';  
   FParms    := TStringList.Create;  
 //The destructor releases the parameter list that was created in the constructor.  
 destructor TExecuter.Destroy;  
   inherited Destroy;  
 //Exec Method  
 //The Exec method takes the process name and parameters, puts them into an array and calls the execv function to overlay the current process with the one specified.  
 procedure TExecuter.Exec;  
   parms : TArgArray;  
   cmd   : AnsiString;  
   j     : integer;  
   cmd   := FProcName;  
   parms := StringListToCarray(cmd,FParms);  
   j := execv(PChar(cmd), PPChar(@parms[0]));  
   if j = -1 then  
     raise Exception.CreateFmt('execv failed error %d',[GetLastError]);  
   // when properly executed, execv will never return...  
 //Parameters Property  
 //Parameters play a crucial role in executing a process and even more so, when using the execv function. In order to pass the parameters to it, the private method StringListToCarray is called to convert the string list to a structure that the execv function needs. This structure is an array of AnsiStrings. The first value is the command or process name. Subsequent positions in the array are filled with the parameters and the last position is nil, indicating the end of the array.  
 function TExecuter.StringListToCarray( cmd : AnsiString;  
                                        strlst : TStrings ) : TArgArray;  
   i,cnt : integer;  
   // set the array one bigger to account for the "NULL" end of array terminator  
   cnt := strlst.Count+1;  
   if cmd <> '' then  
   SetLength(Result, cnt);  
   // when cmd is nothing, this will be overwritten  
   Result[0] := cmd;  
   for i:= 0 to strlst.Count-1 do  
     Result[i+1] := strlst.Strings[i];  
Line 222  end; Line 26  end;
 //Now that the TForker and TExecuter classes have been created, lets re-write the simple shell example.  //Now that the TForker and TExecuter classes have been created, lets re-write the simple shell example.
procedure linStart(cmdline : string;);procedure linStart(cmdline : string);
 var  var
   cmd     : string;    cmd     : string;
   f       : TForker;    f       : TForker;
Line 275  begin Line 79  begin
   f.Exec.ProcessName := cmd;    f.Exec.ProcessName := cmd;
   f.DoFork;    f.DoFork;
 end;  end;
   function start(commandline : string) : boolean;
    start := true;
   procedure linKill(name : string);
    i : Integer;
    L : TList;
    PRec : PProcInfoRec;
    L := GetProcessListByName(name);
    if L.Count > 0
     then for i := 0 to L.Count - 1 do
       PRec := L.Items[i];
       with PRec^ do
        if MessageDlg('Kill Process ',
            'Process ' + IntToStr(i + 1) + ' of ' + IntToStr(L.Count)
             + LF + LF
            + 'Kill this process?' + LF + LF
            + 'Process ID: ' + IntToStr(PID) + LF
            + 'Status: ' + Status + LF
            + 'User name: ' + UName + LF
            + 'Command: ' + CmdName + LF,
            mtConfirmation, [mbYes, mbNo], 0) = mrYes
        then *)
        kill(PID, SIGTERM);
      end; { for }
      //else ShowMessage('No matches found for ' + PROCESSNAME);
 end.  end.

Removed from v.1.1  
changed lines
  Added in v.1.2

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>