Annotation of mozptch/linux_system.pas, revision 1.1

1.1     ! oertel      1: unit linux_system;
        !             2: 
        !             3: //http://rick-ross.com/papers/borcon2001/6204.html
        !             4: 
        !             5: 
        !             6: interface
        !             7: {$IFDEF LINUX}
        !             8: uses Classes,Process;
        !             9: // forward definition
        !            10: TExecuter = class;
        !            11: 
        !            12: TForkerEventProc = procedure of Object;
        !            13: TForkerWhichProc = (wpParent, wpChild);
        !            14: 
        !            15: TForker = class
        !            16: private
        !            17:   FDebug        : boolean;
        !            18:   FOnChild      : TForkerEventProc;
        !            19:   FWait         : boolean;
        !            20:   FExec         : TExecuter;
        !            21:   FStatus       : integer;
        !            22: 
        !            23:   procedure DebugMsg(msg : string);
        !            24: public
        !            25:   constructor Create;
        !            26:   function    DoFork : TForkerWhichProc;
        !            27:   procedure   DoWait;
        !            28: 
        !            29: published
        !            30:   property Debug        : boolean          read FDebug   write FDebug;
        !            31:   property OnChild      : TForkerEventProc read FOnChild write FOnChild;
        !            32:   property WaitForChild : boolean          read FWait    write FWait;
        !            33:   property Exec         : TExecuter        read FExec    write FExec;
        !            34:   property WaitStatus   : integer          read FStatus;
        !            35: end;
        !            36: 
        !            37: 
        !            38: TArgArray = array of AnsiString;
        !            39: 
        !            40: TExecuter = class
        !            41: private
        !            42:   FDebug    : Boolean;
        !            43:   FParms    : TStrings;
        !            44:   FProcName : AnsiString;
        !            45: 
        !            46:   function StringListToCarray( cmd : AnsiString;
        !            47:                                strlst : TStrings ) : TArgArray;
        !            48:   procedure DebugMsg(msg : string);
        !            49: protected
        !            50:   function ListArgArray(aa : TArgArray) : string;
        !            51: 
        !            52: public
        !            53:   constructor Create;
        !            54:   destructor  Destroy; override;
        !            55:   procedure   Exec;
        !            56: 
        !            57: published
        !            58:   property Debug       : boolean      read FDebug    write FDebug;
        !            59:   property Parameters  : TStrings     read FParms    write FParms;
        !            60:   property ProcessName : AnsiString   read FProcName write FProcName;
        !            61: end;
        !            62: {$ENDIF}
        !            63: 
        !            64: implementation
        !            65: {$IFDEF LINUX}
        !            66: 
        !            67: //Constructor
        !            68: 
        !            69: //The constructor initializes some default values.
        !            70: 
        !            71: constructor TForker.Create;
        !            72: begin
        !            73:   inherited Create;
        !            74:   FDebug := false;
        !            75:   FWait  := true;
        !            76: end;
        !            77: 
        !            78: 
        !            79: //Forking
        !            80: 
        !            81: //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.
        !            82: 
        !            83: function   TForker.DoFork : TForkerWhichProc;
        !            84: var
        !            85:   i : integer;
        !            86: 
        !            87: begin
        !            88:   i := fork;
        !            89:   if i = -1 then
        !            90:   begin
        !            91:     raise Exception.CreateFmt('Unable to fork: Error is %d',[GetLastError]);
        !            92:   end
        !            93:   else if i = 0 then
        !            94:   begin
        !            95:     // we are in the child...
        !            96:     Result := wpChild;
        !            97: 
        !            98:     // call the child
        !            99:     if Assigned (FOnChild) then
        !           100:       FOnChild
        !           101:     else if Assigned (FExec) then
        !           102:     begin
        !           103:       // do the exec thing..
        !           104:       FExec.Exec;
        !           105:     end;
        !           106: 
        !           107:     // otherwise we fall through and let the
        !           108:     // caller handle it..
        !           109:   end
        !           110:   else
        !           111:   begin
        !           112:     // we are the parent...
        !           113:     Result := wpParent;
        !           114: 
        !           115:     if FWait then
        !           116:     begin
        !           117:       // wait for child
        !           118:       wait(@FStatus);
        !           119:     end;
        !           120:   end;
        !           121: end;
        !           122: 
        !           123: 
        !           124: //Waiting
        !           125: 
        !           126: //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.
        !           127: 
        !           128: procedure TForker.DoWait;
        !           129: begin  if not FWait then
        !           130:     wait(@FStatus);
        !           131: end;
        !           132: 
        !           133: //OnChild Property
        !           134: 
        !           135: //The OnChild property provides a callback method when the child process is being executed.
        !           136: //WaitForChild Property
        !           137: 
        !           138: //This property determines if the TForker class will wait for the child or allow the parent to decide to wait or not.
        !           139: //Creating an "Exec"ing Class
        !           140: 
        !           141: //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.
        !           142: //Class Definition
        !           143: 
        !           144: //---------------
        !           145: //Constructor
        !           146: 
        !           147: //In the constructor, properties are created and initialized.
        !           148: 
        !           149: constructor TExecuter.Create;
        !           150: begin
        !           151:   inherited Create;
        !           152:   FDebug    := false;
        !           153:   FProcName := '';
        !           154:   FParms    := TStringList.Create;
        !           155: end;
        !           156: 
        !           157: 
        !           158: //Destructor
        !           159: 
        !           160: //The destructor releases the parameter list that was created in the constructor.
        !           161: 
        !           162: destructor TExecuter.Destroy;
        !           163: begin
        !           164:   FParms.Free;
        !           165:   inherited Destroy;
        !           166: end;
        !           167: 
        !           168: 
        !           169: //Exec Method
        !           170: 
        !           171: //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.
        !           172: 
        !           173: procedure TExecuter.Exec;
        !           174: var
        !           175:   parms : TArgArray;
        !           176:   cmd   : AnsiString;
        !           177:   j     : integer;
        !           178: 
        !           179: begin
        !           180:   cmd   := FProcName;
        !           181:   parms := StringListToCarray(cmd,FParms);
        !           182:  
        !           183:   j := execv(PChar(cmd), PPChar(@parms[0]));
        !           184:   if j = -1 then
        !           185:     raise Exception.CreateFmt('execv failed error %d',[GetLastError]);
        !           186:   // when properly executed, execv will never return...
        !           187: end;
        !           188: 
        !           189: 
        !           190: //Parameters Property
        !           191: 
        !           192: //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.
        !           193: 
        !           194: function TExecuter.StringListToCarray( cmd : AnsiString;
        !           195:                                        strlst : TStrings ) : TArgArray;
        !           196: 
        !           197: var
        !           198:   i,cnt : integer;
        !           199: 
        !           200: begin
        !           201:   // set the array one bigger to account for the "NULL" end of array terminator
        !           202: 
        !           203:   cnt := strlst.Count+1;
        !           204:   if cmd <> '' then
        !           205:     inc(cnt);
        !           206: 
        !           207:   SetLength(Result, cnt);
        !           208: 
        !           209:   // when cmd is nothing, this will be overwritten
        !           210:   Result[0] := cmd;
        !           211: 
        !           212:   for i:= 0 to strlst.Count-1 do
        !           213:   begin
        !           214:     Result[i+1] := strlst.Strings[i];
        !           215:   end;
        !           216: end;
        !           217: 
        !           218: 
        !           219: 
        !           220: 
        !           221: //Using the Classes - A Simple OO Shell
        !           222: 
        !           223: //Now that the TForker and TExecuter classes have been created, lets re-write the simple shell example.
        !           224: 
        !           225: procedure linStart(cmdline : string;);
        !           226: var
        !           227:   cmd     : string;
        !           228:   f       : TForker;
        !           229: 
        !           230:   procedure ParseArgs(commandline : string; var cmd : string;
        !           231:                       strlst : TStrings);
        !           232:   var
        !           233:     tmp    : string;
        !           234:     i      : integer;
        !           235: 
        !           236:   begin
        !           237:     // start with an empty parameter list
        !           238:     strlst.Clear;
        !           239: 
        !           240:     tmp := commandline;
        !           241:     i   := Pos(' ',tmp);
        !           242:     while (i > 0) do
        !           243:     begin
        !           244:       // found an argument
        !           245:       // extract the string from 1 to i-1
        !           246:       strlst.Add(  Copy(tmp,1,(i-1)) );
        !           247: 
        !           248:       tmp := Copy(tmp,i+1,length(tmp));
        !           249:       i   := Pos(' ',tmp);
        !           250:     end;
        !           251: 
        !           252:     if (tmp <> '') then
        !           253:     begin
        !           254:       // found an argument
        !           255:       // extract the string from 1 to len
        !           256:       strlst.Add( Copy(tmp,1,length(tmp)) );
        !           257:     end;
        !           258: 
        !           259:     // now get the command from the first argument
        !           260:     cmd := strlst.Strings[0];
        !           261: 
        !           262:     // and delete the first parameter
        !           263:     strlst.Delete(0);
        !           264:   end; // ParseArgs
        !           265: 
        !           266: begin
        !           267:   // create the forker object
        !           268:   f := TForker.Create;
        !           269:   f.Exec := TExecuter.Create;
        !           270:   f.WaitForChild := true;
        !           271: 
        !           272: 
        !           273:   // search for arguments in the string
        !           274:   ParseArgs(cmdline, cmd, f.Exec.Parameters);
        !           275:   f.Exec.ProcessName := cmd;
        !           276:   f.DoFork;
        !           277: end;
        !           278: {$ENDIF}
        !           279: end.

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