【列表5.9】ProcStuff单元代码。
unit ProcStuff;
interface
uses SysUtils, Classes, Libc;
const
NO_ERR = 0;
NOT_FOUND = -1;
PIPE ERR = -2;
MISC ERR = -3;
type
PProcInfoRec = ^TProcInfoRec;
TProcInfoRec =
record
PID : Integer; { process id }
Status : String; { process status }
uName : String; { name of process initiator }
CmdName : String; [ name of process (no path) }
end; { record }
{
- For a given process ID, return the process
status, the login of the user who invoked the
process, and the command line used to -invoke it.
Return value indicates success.
}
function GetProcessStatus( PID : Integer;
var Status : String;
var UName : String;
var Cmd : String) : Integer:
{
- For a given process name. return a pointer
to a list of records that contain the process
ID, -its status and the name of the user who
Initiated the process. If no matches were
found, return nil.
}
function GetProcessListByName(Cmd : String)
: TList;
impiementation
function ParseToSpace(var InStr : String) : String;
var
OutStr : String;
begin
OutStr :=’ ‘;
while (Length(lnstr) > 0) and (InStr[1] = ' ') do
Delete(Instr, 1, 1):
while (Length(lnstr) > 0) and (lnStr[1] ' ‘) do
begin
OutStr := OutStr + InStr[1];
Deiete(InStr,1,1);
end; { while }
Result := OutStr;
end; { ParseToSpace }
function GetProcessStatus( PID : Integer;
var Status : String;
var UNarne : String;
var Cmd : String) : Integer;
const
PIPE_CMD : PChar = 'ps -eo pid.stat,user,args | grep ';
PIPE_TYPE : PChar = 'r'; {read from the pipe }
var
CmdArr : array[0. .512] of char;
StrArr : array[0..1024] of char;
F : PIOFile;
s : String;
ErrResult : Integer;
PtrResuH : Pointer:
Found : Boolean;
PSLine : String;
begin
ErrResult := NO_ERR;
StrPCopy(CmdArr, PIPE_CMD);
StrPCopy(StrArr, lntToStr(PID));
StrCat(CmdArr, StrArr);
F := popen(CmdArr, PIPE_TYPE):
If F = nil
then ErrResult := PIPE_ERR
else begin
Found := False;
repeat
PtrResult :=fgets(StrArr, 1024. F);
if PtrResult nil
then begin
PSLine := StrPas(StrArr);
PSLine := Copy(PSLine, 1. Length(PSLine) - 1)
s := ParseToSpace(PSLine):
Found := StrToInt(s) =PID:
if Found
then begin
{ Parse out the values }
Status := ParseToSpace(PSLine);
UName := ParseToSpace(PSLine);
Cmd := ParseToSpace(PSL1ne);
end;
end;
until Found or (PtrResult = nil);
if (PtrResuU = nil) and (ErrResuH = NO_ERR)
then ErrResult := NOT_FOUND;
if (pclose(F) = -1) and (ErrResult = NO_ERR)
then ErrResult := PIPE_ERR;
end:
Result := ErrResult;
end;
function GetProcessListByName(Cmd : String)
: TList;
const
PIPE_CMD : PChar= 'ps -eo pid.stat,user,args| grep ';
PIPE_TYPE : PChar ='r'; { read from the pipe }
var
CmdArr : array[0. .512] of char;
StrArr : array[0..1024] of char;
F : PIOFile;
PtrResult : Pointer;
AList : TList;
Found : Boolean;
PSLine : String;
ProcRec : PProcInfoRec;
PID : Integer;
Status : String;
UName : String;
CmdName : String;
begin
AList := TList.Create;
StrPCopy(CmdArr, PIPE_CMD);
StrPCopy(StrArr, Cmd);
StrCat(CmdArr, StrArr);
F := popen(CmdArr, PIPE_TYPE);
if F = nil
then begin
Result := nil;
AList. Free;
Exit;
end;
repeat
PtrResult := fgets(StrArr, 1024, F);
if PtrResult nil
then begin
PSLine := StrPas(StrArr);
PSLine := Copy(PSLine, 1, Length(PSLine) - 1);
PID := StrToInt(ParseToSpace(PSLine));
Status := ParseToSpace(PSLine);
UName := ParseToSpace(PSLine);
CmdName := ParseToSpace(PSLine);
CmdName := ExtractFileName(CmdName);
Found := CmdName = Cmd;
if Found
then begin
ProcRec := New(PProcInfoRec);
ProcRec. PID := PID;
ProcRec. Status := Status;
ProcRec.UName := UName;
ProcRec. CmdName := CmdName;
AList.Add(ProcRec);
end:
end;
until PtrResult= nil;
pclose(F);
Result := AList;
end;
end.