[fpc-pascal]getprocesstimes- help wanted pls

[Thomas Schatzl]

Hello,

> I'm trying to use this (in win 2000) to get process times, but can't seem to
> make it work. Can anyone send me a simple fpc code fragment or a suggestion

 here's some quick hack showing how to do this:

uses
 windows;

type
 TProcessEntry32 = packed record
  dwSize : DWord;
  cntUsage : DWord;
  th32ProcessId : DWord;
  th32DefaultHeapId : ^DWord;
  th32ModuleId : DWord;
  cntThreads : DWord;
  th32ParentProcessId : DWord;
  pcPriClassBase : Longint;
  dwFlags : DWord;
  szExeFile : array[0..MAX_PATH-1] of Char;
 end;
 PProcessEntry32 = ^TProcessEntry32;

function CreateToolhelp32Snapshot(flags : DWord; th32ProcessId : DWord) :
Longint; stdcall; external 'kernel32.dll';
function Process32First(handle : DWord; lppe : PProcessEntry32) : LongBool;
stdcall; external 'kernel32.dll';
function Process32Next(handle : DWord; lppe : PProcessEntry32) : LongBool;
stdcall; external 'kernel32.dll';

const
 TH32CS_SNAPPROCESS = 2;

procedure WriteProcessInfo(prcid : Handle);
var
 t1, t2, t3, t4 : TFileTime;
 b : Boolean;
 h : Handle;
begin
 Writeln('Examining Process ID: ', DWord(prcid));
 h := OpenProcess(PROCESS_QUERY_INFORMATION, false, prcid);
 if (h = 0) then begin
  Writeln('OpenProcess() error : ', GetLastError());
  exit;
 end;
 b := GetProcessTimes(h, @t1, @t2, @t3, @t4);
 if (b) then begin
  Writeln('Creation time : ', int64(t1), ' Exit time : ', int64(t2), ' Kernel
time : ', int64(t3), ' User time : ', int64(t4));
 end else begin
  Writeln('GetProcessTimes() error : ', GetLastError());
 end;
 CloseHandle(h);

end;

var
 snaphandle : Handle;
 processentry : TProcessEntry32;

begin
 snaphandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 if (snaphandle = -1) then begin
  Writeln('Error : ', GetLastError());
  exit;
 end;

 Writeln('Snapshot handle : ', snaphandle);
 Writeln;

 fillchar(processentry, sizeof(processentry), 0);
 with processentry do begin
  dwSize := sizeof(processentry);
 end;

 if (Process32First(snaphandle, @processentry)) then begin
  WriteProcessInfo(processentry.th32ProcessId);
  while (Process32Next(snaphandle, @processentry)) do
   WriteProcessInfo(processentry.th32ProcessId);
 end else Writeln('Error : ', GetLastError);

end.

Notes:
- there must be another way to get the PIDs because above code works with
W2k/W98 only, e.g. not NT 4 or less. It's just that I don't remember it exactly
how (at this time of the day ;); so I'd like to know how you got the different
process id's .... (the Toolhelp32 functions are meant to be used for debugging
purposes btw according to the MSDN - docs)
- converting the time values to human readable output is an exercise left to the
reader =)
- verified working with W2k pro (doesn't work with Win98 though because
GetProcessTimes() doesn't work here)

> that works to get the times into the int64 variables... guess I'm not
> getting my pointers right!  TIA

- likely you simply didn't succeed in getting the correct handle
(GetProcessTimes() requires a process handle, not a process id)

Hope this helps a little,
    Thomas

P.S.: I'm sending a copy directly to you too because my posts to FPC-* seem to
have a slight delay (~ 14 days or so) lately... any ideas ?