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 that works to get the times into the int64 variables... guess I'm not getting my pointers right! TIA

var t1,t2,t3,t4:int64;
    tmpb:winbool;
    myhndl:handle;
{
... get myhndl for process...
}
tmpb:=getprocesstimes(myhndl,@t1,@t2, @t3,@t4);

gives tmpb true (ie success) but the values in t1..t4 are always the same ...

The GetProcessTimes function obtains timing information about a specified process.
BOOL GetProcessTimes(

HANDLE hProcess, // specifies the process of interest LPFILETIME lpCreationTime, // when the process was created LPFILETIME lpExitTime, // when the process exited LPFILETIME lpKernelTime, // time the process has spent in kernel mode

    LPFILETIME  lpUserTime 	// time the process has spent in user mode
   );

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 ?

Thanks for prog - works ok under win2000 & I can get times for processes... BTW here is the way I get process ids etc - I received the original befoire I hacked it around from someone else via [fpc-pascal] a while ago..., so thanks to them for it!

BTW when I compare the o/p from your prog with the 'windows task manager' list of processes (on win2000) I get error from your program & no times o/p for process with pid=0 (system idle process). I'm really trying to get the system idle process cpu time... ie time processor isn't foing anything. Anyone any idea on best way to get this in win2000?

-------------------------------------
{$MODE DELPHI}
{$h-}
Uses Windows,dos;
var tcount,wcount:longint;
 op:boolean;
Function strHex(a : LongInt; b : Byte) : String;
Const digit : Array[$0..$F] Of Char = '0123456789ABCDEF';
Var i : Byte;
  xstring : String;
Begin
  xstring:='';
  For i:=1 To b Do
  Begin
{
    xstring:=xstring+ digit[a And $000F];
}
    Insert(digit[a And $000F], xstring, 1);
    a:=a ShR 4
  End;
  strhex:=xstring
End; {hex}
Function OurEnumWindowsCallBack(TheHWND:HWND;  LV:Longint):Longint;
stdcall; export;
var S  :String;
    C  :String;
    PID : DWORD;
    PDD : DWORD;
    t1,t2,t3,t4:dword;
    xx:int64;
BaseAddr : DWORD;
    TmpHandle, tmphandle1 : HANDLE;
    f : File;
    NumRead : DWORD;
    P : Pointer;
    TmpB : WinBool;
    n,j,k,l,m:longint;
    eq:boolean;
Begin
  Inc(WCount,1);
  S[0] := Chr( Lo(Lo(GetWindowTextA(TheHWND, @S[1], 255))) );
  C[0] := Chr( Lo(Lo(GetClassNameA(TheHWND, @C[1], 255))) );
      PDD := GetWindowThreadProcessId(TheHWND, @PID);
      Write(StrHex(TheHWND,8),', "',S,'" - "',C,'"');
      Write('   [PDD=',strhex(PDD,8),', PID=',strhex(PID,8),' ',pid,']');
      TmpHandle := OpenProcess(PROCESS_ALL_ACCESS, FALSE, PID);
      If GetLastError=0 then  { I'm doing this part wrong I think! }
        begin
      Writeln(',  = ',GetPriorityClass(Tmphandle));
    tmpb:=getprocesstimes(tmphandle,@t1,@t2,@t3,@t4);
    if tmpb then
begin
writeln('times= ', t1,' ',t2,' ', t3,' ',t4);
end;
        end else if op then Writeln;
          CloseHandle(TmpHandle);
  Result := 1;
End;
Procedure ListWindows;
var S: String;
Begin
   WCount := 0;
   TCount := 0;
   If EnumWindows(@OurEnumWindowsCallBack, 1313) then
     begin
     if op then writeln('Success!');
     end;
if op then Writeln('Total Was ',WCount,'  with ',TCount,' threads');
End;
begin
op:=true;
  ListWindows;
END.

Hello,

Thanks for prog - works ok under win2000 & I can get times for processes... BTW here is the way I get process ids etc - I received the original befoire I hacked it around from someone else via [fpc-pascal] a while ago..., so thanks to them for it!

Well, it doesn't do what it should.... it does something very close to retrieving processes though.

Well, after taking a look at the docs for a second time I think I found out how it's done properly (and working with all NT versions). The way to do this is parsing the 'HKEY_PERFORMANCE_DATA' key in the registry.... Since this process of retrieving this data is more complex I am sorry but I don't have the time to create a sample application; neither I do have something already working. I recommend reading the 'Performance Monitoring' chapter in the MSDN docs in detail, there is lots of information about how to do that though (and some small example applications using C).

[... skipping some stuff ...]

Replace this line with:

"if (TmpHandle -1) then begin"

and it works as it should (not as it is intended to) imho. Because it only enumerates _windows_ and retrieves the associated process (and threads, but a few lines of code already seem to be missing ;) but not the processes directly. E.g. processes not having allocated a window handle are not listed (this includes the idle process btw), so my approach is actually better. It is also possible (very likely) that one process has more than one window open and you get lots of data several times.

Regards,
Thomas

--------------------------------------------------------------------- Sent through MailGateway - http://www.ssw.uni-linz.ac.at:2000/ Send or read your emails anywhere.
---------------------------------------------------------------------