Delphi-PRAXiS - Delphi Cpu usage EINZELNER PROZESSE ermitteln

Die Berechnung anhand der Werte solltest du CatBytes' Beispiel entnehmen. Ansonsten gibt es hier Code, der dir für beliebige Prozesse anhand der PID (also ohne Handle) die entsprechenden Zeiten anzeigt. Einzig die ExitTime wird von meiner Funktion nicht beachtet, da man die wirklich nur mit Handle rausbekommt (und sie für deine Berechnung auch nicht wichtig ist).

Die Units, vom JEDI-Apilib-Projekt brauchst du nach wie vor (es gibt übrigens eine aktualisierte Version von JwaWinType und JwaNative), die du dir und also runterladen solltest.

Aus der Funktion CallBackProcess() solltest du das Writeln() entfernen, sobald du es getestet hast. Weil es ja so 1. nur in Konsolenprogrammen funktioniert und 2. nur zum Testen da war.

Die wichtige Funktion für dich ist GetProcessTimesByPid()! Alle anderen brauchen dich nicht wirklich zu interessieren. Falls sie es doch tun, kann ich es noch ein wenig erläutern ;) ... Als Test gibt dieses Miniprogramm einfach aus, wann der Prozess mit der hardcodeten PID gestartet wurde. Vorzugsweise sollte die PID natürlich existieren ;)

Der Code ist PUBLIC DOMAIN, darf aber natürlich auch unter einer beliebigen OSI-zertifizierten Lizenz benutzt werden - in diesem Falle ist "Copyright (c) 2005 by Mephistopheles" anzugeben. Für die Benutzung der entsprechenden Units gelten die dort angegebenen Lizenzvereinbarungen (üblicherweise MPL für JEDI).

Kleines Projekt mit den Funktionen:

Delphi-Quellcode:

			program ProcessTimesNoHandle;

{$APPTYPE CONSOLE}

uses

  Windows,

  SysUtils,

  JwaNtStatus,

  JwaWinType,

  JwaNative;

type

  TCallBackProcess = function(ps: PSYSTEM_PROCESSES; dwUserData: DWORD): BOOL; stdcall;

  PProcessTimeRecord = ^TProcessTimeRecord;

  TProcessTimeRecord = record

    PID: DWORD;

    CreationTime,

      KernelTime,

      UserTime: LARGE_INTEGER;

  end;

function ListProcesses(Callback: TCallBackProcess; dwUserData: DWORD): Boolean;

var

  Status: NTSTATUS;

  Buffer: PVOID;

  TempBuf: PSYSTEM_PROCESSES;

  BufLen: ULONG;

const

  MinQuerySize = $10000;

begin

  Result := False;

  BufLen := MinQuerySize;

  Buffer := RtlAllocateHeap(NtpGetProcessHeap(), HEAP_ZERO_MEMORY, BufLen);

  if (Assigned(Buffer)) then

  try

    Status := NtQuerySystemInformation(

      SystemProcessesAndThreadsInformation,

      Buffer,

      BufLen,

      nil);

    while (Status = STATUS_INFO_LENGTH_MISMATCH) do

    begin

      // Double the size to allocate

      BufLen := BufLen * 2;

      TempBuf := RtlReAllocateHeap(NtpGetProcessHeap(), HEAP_ZERO_MEMORY, Buffer, BufLen);

      if (not Assigned(TempBuf)) then

        Exit; // And free "Buffer" inside finally clause

      // Else assign the TempBuf to Buffer

      Buffer := TempBuf;

      // Try to query info again

      Status := NtQuerySystemInformation(

        SystemProcessesAndThreadsInformation,

        Buffer,

        BufLen,

        nil);

    end;

    // TempBuf used for pointer arithmetics

    TempBuf := Buffer;

    if (NT_SUCCESS(Status)) then

    begin

      while (True) do

      begin

        if (Assigned(Callback)) then

          if (not CallBack(TempBuf, dwUserData)) then

          // Exit loop if the callback signalled to do so.

            Break;

        // Break if there is no next entry

        if (TempBuf^.NextEntryDelta = 0) then

          Break;

        // Else go to next entry in list

        TempBuf := PSYSTEM_PROCESSES(DWORD(TempBuf) + TempBuf^.NextEntryDelta);

      end;

      Result := True;

    end;

  finally

    if (Assigned(Buffer)) then

      RtlFreeHeap(NtpGetProcessHeap(), 0, Buffer);

  end;

end;

// This MUST NOT be a local function

function CallBackProcess(ps: PSYSTEM_PROCESSES; ProcessTimeRecord: PProcessTimeRecord): BOOL; stdcall;

begin

  Result := True;

  if (Assigned(ps)) then

    if (ps^.ProcessId = ProcessTimeRecord^.PID) then

    begin

      ProcessTimeRecord^.CreationTime := ps^.CreateTime;

      ProcessTimeRecord^.KernelTime := ps^.KernelTime;

      ProcessTimeRecord^.UserTime := ps^.UserTime;

      // FIXME: This is for debugging only. Of course not needed in production code

      Writeln('PID = ', ps^.ProcessId, ' - parent = ', ps^.InheritedFromProcessId);

      // Stop going through the list

      Result := False;

    end;

end;

// Instead of only taking the times, it would be easier and more effective to

// take all information directly from the SYSTEM_PROCESS structures in the

// callback!

function GetProcessTimesByPid(

  PID: DWORD;

  var lpCreationTime: Windows.FILETIME;

  var lpKernelTime: Windows.FILETIME;

  var lpUserTime: Windows.FILETIME

  ): BOOL; stdcall;

var

  times: TProcessTimeRecord;

begin

  times.PID := PID; // PID to search for

  // We need to pass a pointer here!

  Result := ListProcesses(@CallBackProcess, DWORD(@times));

  lpCreationTime := Windows.FILETIME(times.CreationTime);

  lpKernelTime := Windows.FILETIME(times.KernelTime);

  lpUserTime := Windows.FILETIME(times.UserTime);

end;

var

  lpCreationTime,

    lpKernelTime,

    lpUserTime: Windows.FILETIME;

  cst: SYSTEMTIME;

begin

  // Hardcoded PID for testing. This should be called for each PID found

  if (GetProcessTimesByPid(2588, lpCreationTime, lpKernelTime, lpUserTime)) then

  begin

    FileTimeToSystemTime(lpCreationTime, cst);

    Writeln(Format('Process created: %.4d-%.2d-%.2dT%.2d:%.2d:%.2d.%.3d', [cst.wYear, cst.wMonth, cst.wDay, cst.wHour, cst.wMinute, cst.wSecond, cst.wMilliseconds]));

  end;

  Readln;

end.

BTW: Hatte da einen dummen Fehler drin, den ich jetzt per Debugger gefunden hatte. Ursprüngliche war meine Callback-Funktion als lokale Funktion deklariert. Das ist natürlich tötlich, weil mit jedem Aufruf der Callback sich auch der Stackframe ändert. Logischerweise werden also falsche Pointerwerte vom Stack geholt und es wird versucht auf diese zu schreiben ... *plonk* -> AV! ... naja, die Lehre daraus: Niemals eine Callbackfunktion, die von einer dritten Funktion aufgerufen wird als lokale Funktion deklarieren. Hätte ich eigentlich gleich drauf kommen müssen. Übrigens: deshalb die Kopfstände mit PProcessTimeRecord usw.!

PS: Sorry, daß ich dich warten lassen habe. Bin aktuell etwas im Streß (auch außerhalb der DP ;)).
PPS: Windows.FILETIME wird explizit benutzt, damit es keinen Konflikt mit dem gleichnamigen (und gleichwertigen) Typen aus der JwaNative.pas (bzw. den zugehörigen Units) beim Kompilieren gibt.
PPPS: Im Anhang das Projekt ohne die besagten Units. Die muß man sich bitte selber

hier runterladen. Welche Dateien benötigt werden steht weiter oben.