[fpc-pascal]getprocesstimes- help wanted pls

Lee, John LeeJ at logica.com
Thu Apr 12 17:37:49 CEST 2001


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, at t1, at t2, at t3, at 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.




More information about the fpc-pascal mailing list