Annotation of mozptch/ProcStuff.pas, revision 1.1

1.1     ! oertel      1: // 
        !             2: //          Process Information Library Unit 
        !             3: //             ProcStuff.pas : Unit File 
        !             4: //              Developed by Don Taylor 
        !             5: // 
        !             6: // Description: Routines for retrieving process status
        !             7: // and a list of currently running processes.
        !             8: // 
        !             9: // Written for "Kylix Power Solutions" 
        !            10: // Copyright (c) 2001, Coriolis Group Books 
        !            11: //       Last revised 31 May 2001 
        !            12: //
        !            13: 
        !            14: unit ProcStuff;
        !            15: 
        !            16: interface
        !            17: {$IFDEF LINUX}
        !            18: 
        !            19: uses SysUtils, Classes, Libc;
        !            20: 
        !            21: const
        !            22:  NO_ERR    =  0;
        !            23:  NOT_FOUND = -1;
        !            24:  PIPE_ERR  = -2;
        !            25:  MISC_ERR  = -3;
        !            26: 
        !            27: type
        !            28:  PProcInfoRec = ^TProcInfoRec;
        !            29:  TProcInfoRec =
        !            30:   record
        !            31:    PID : Integer; { process id }
        !            32:    Status : String; { process status }
        !            33:    uName : String; { name of process initiator }
        !            34:    CmdName : String; { name of process (no path) }
        !            35:   end; { record }
        !            36: 
        !            37: {
        !            38:   - For a given processs ID, return the process
        !            39:     status, the login of the user who invoked the
        !            40:     process, and the command line used to invoke it.
        !            41:     Return value indicates success.
        !            42: }
        !            43: function GetProcessStatus(    PID : Integer;
        !            44:                           var Status : String;
        !            45:                           var UName  : String;
        !            46:                           var Cmd    : String) : Integer;
        !            47: 
        !            48: {
        !            49:   - For a given process name, return a pointer
        !            50:     to a list of records that contain the process
        !            51:     ID, its status and the name of the user who
        !            52:     initiated the process. If no matches were
        !            53:     found, return nil.
        !            54: }
        !            55: function GetProcessListByName(Cmd : String)
        !            56:   : TList;
        !            57: {$ENDIF}
        !            58: implementation
        !            59: {$IFDEF LINUX}
        !            60: 
        !            61: function ParseToSpace(var InStr : String) : String;
        !            62: var
        !            63:  OutStr : String;
        !            64: begin
        !            65:  OutStr := '';
        !            66:  while (Length(Instr) > 0) and (InStr[1] = ' ') do
        !            67:   Delete(Instr, 1, 1);
        !            68:  while (Length(Instr) > 0) and (InStr[1] <> ' ') do
        !            69:   begin
        !            70:    OutStr := OutStr + InStr[1];
        !            71:    Delete(InStr, 1, 1);
        !            72:   end; { while }
        !            73:  Result := OutStr;
        !            74: end; { ParseToSpace }
        !            75: 
        !            76: function GetProcessStatus(    PID : Integer;
        !            77:                           var Status : String;
        !            78:                           var UName  : String;
        !            79:                           var Cmd    : String) : Integer;
        !            80: const
        !            81:  PIPE_CMD : PChar = 'ps -eo pid,stat,user,args | grep ';
        !            82:  PIPE_TYPE : PChar = 'r'; { read from the pipe }
        !            83: var
        !            84:  CmdArr : array[0..512] of char;
        !            85:  StrArr : array[0..1024] of char;
        !            86:  F : PIOFile;
        !            87:  s : String;
        !            88:  ErrResult : Integer;
        !            89:  PtrResult : Pointer;
        !            90:  Found : Boolean;
        !            91:  PSLine : String;
        !            92: begin
        !            93:  ErrResult := NO_ERR;
        !            94:  StrPCopy(CmdArr, PIPE_CMD);
        !            95:  StrPCopy(StrArr, IntToStr(PID));
        !            96:  StrCat(CmdArr, StrArr);
        !            97: 
        !            98:  F := popen(CmdArr, PIPE_TYPE);
        !            99:  if F = nil
        !           100:   then ErrResult := PIPE_ERR
        !           101:   else begin
        !           102:         Found := False;
        !           103:         repeat
        !           104:          PtrResult := fgets(StrArr, 1024, F);
        !           105:          if PtrResult <> nil
        !           106:           then begin
        !           107:                 PSLine := StrPas(StrArr);
        !           108:                 PSLine := Copy(PSLine, 1, Length(PSLine) - 1);
        !           109:                 s := ParseToSpace(PSLine);
        !           110:                 Found := StrToInt(s) = PID;
        !           111:                 if Found
        !           112:                  then begin
        !           113:                        { Parse out the values }
        !           114:                        Status := ParseToSpace(PSLine);
        !           115:                        UName  := ParseToSpace(PSLine);
        !           116:                        Cmd    := ParseToSpace(PSLine);
        !           117:                       end;
        !           118:                end;
        !           119:         until Found or (PtrResult = nil);
        !           120: 
        !           121:         if (PtrResult = nil) and (ErrResult = NO_ERR)
        !           122:          then ErrResult := NOT_FOUND;
        !           123:         if (pclose(F) = -1) and (ErrResult = NO_ERR)
        !           124:          then ErrResult := PIPE_ERR;
        !           125:        end;
        !           126: 
        !           127:  Result := ErrResult;
        !           128: end;
        !           129: 
        !           130: function GetProcessListByName(Cmd : String)
        !           131:   : TList;
        !           132: const
        !           133:  PIPE_CMD : PChar = 'ps -eo pid,stat,user,args | grep ';
        !           134:  PIPE_TYPE : PChar = 'r'; { read from the pipe }
        !           135: var
        !           136:  CmdArr : array[0..512] of char;
        !           137:  StrArr : array[0..1024] of char;
        !           138:  F : PIOFile;
        !           139:  PtrResult : Pointer;
        !           140:  AList : TList;
        !           141:  Found : Boolean;
        !           142:  PSLine : String;
        !           143:  ProcRec : PProcInfoRec;
        !           144:  PID : Integer;
        !           145:  Status : String;
        !           146:  UName : String;
        !           147:  CmdName : String;
        !           148: begin
        !           149:  AList := TList.Create;
        !           150:  StrPCopy(CmdArr, PIPE_CMD);
        !           151:  StrPCopy(StrArr, Cmd);
        !           152:  StrCat(CmdArr, StrArr);
        !           153: 
        !           154:  F := popen(CmdArr, PIPE_TYPE);
        !           155:  if F = nil
        !           156:   then begin
        !           157:         Result := nil;
        !           158:         AList.Free;
        !           159:         Exit;
        !           160:        end;
        !           161: 
        !           162:  repeat
        !           163:   PtrResult := fgets(StrArr, 1024, F);
        !           164:   if PtrResult <> nil
        !           165:    then begin
        !           166:          PSLine := StrPas(StrArr);
        !           167:          PSLine := Copy(PSLine, 1, Length(PSLine) - 1);
        !           168:          PID := StrToInt(ParseToSpace(PSLine));
        !           169:          Status := ParseToSpace(PSLine);
        !           170:          UName := ParseToSpace(PSLine);
        !           171:          CmdName := ParseToSpace(PSLine);
        !           172:          CmdName := ExtractFileName(CmdName);
        !           173:          Found := CmdName = Cmd;
        !           174:          if Found
        !           175:           then begin
        !           176:                 ProcRec := New(PProcInfoRec);
        !           177:                 ProcRec.PID := PID;
        !           178:                 ProcRec.Status := Status;
        !           179:                 ProcRec.UName := UName;
        !           180:                 ProcRec.CmdName := CmdName;
        !           181:                 AList.Add(ProcRec);
        !           182:                end;
        !           183:         end;
        !           184:    until PtrResult = nil;
        !           185: 
        !           186:  pclose(F);
        !           187: 
        !           188:  Result := AList;
        !           189: end;
        !           190: 
        !           191: {$ENDIF}
        !           192: end.

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