CPU Auslastung einzelner Prozesse

[chest3rs]

Mit diesen Funktionen errechnet man anhand der ProcessID die CPU Auslastung eines Prozesses. Die ProzessIDs müssen natülich vorher ermittelt werden.

Delphi-Quellcode:

// Datensatz für die CPU Auslastung
// Hier werden die Zeitwerte des Prozesses gespeichert
type
  TCPULOAD = record
    PID                    : Integer;
    dwOldTime, dwNewTime   : Cardinal;
    lOldUser, lNewUser     : Cardinal;
    lOldKernel, lNewKernel : Cardinal;
  end;

var
  Process       : TCPULOAD;

function GetTime(fFileTime: FileTime): Cardinal;
var
  sSystemTime : SystemTime;
begin
  FileTimeToSystemTime(fFileTime,sSystemTime);
  result := (sSystemTime.wSecond*1000)+sSystemTime.wMilliseconds;
end;

// aktualisiert Zeitwerte im Datensatz des Prozesses
procedure RefreshProcess(var Process: TCPULOAD);
var
  hProc : THandle;
  ftCreate, ftExit, ftUser, ftKernel : FileTime;
begin
  ZeroMemory(@ftUser, SizeOf(ftUser));
  ZeroMemory(@ftUser, SizeOf(ftKernel));

  Process.dwOldTime  := Process.dwnewTime;
  Process.lOldUser   := Process.lNewUser;
  Process.lOldKernel := Process.lNewKernel;

  hProc := OpenProcess(PROCESS_QUERY_INFORMATION, False, Process.PID);
  if (hProc <> 0) then
  begin
    GetProcessTimes(hProc, ftCreate, ftExit, ftKernel, ftUser);
    Process.dwNewTime  := GetTickCount;
    Process.lNewUser   := GetTime(ftUser);
    Process.lNewKernel := GetTime(ftKernel);
  end;
  CloseHandle(hProc);
end;

function GetCPUTimeForProcess(Process: TCPULOAD): Integer;
var
  lUser, lKernel: Cardinal;
  dwTime: DWORD;
begin
  lKernel := Process.lNewKernel - Process.lOldKernel;
  lUser   := Process.lNewUser   - Process.lOldUser;
  dwTime  := Process.dwNewTime  - Process.dwOldTime;
  if (dwTime > 0) then
    Result := ((lKernel+lUser)*100) div (dwTime)
  else
    Result := 0;
end;

Anwendungsbeispiel:

Delphi-Quellcode:

Process.PID := { gültige PID hier eintragen };

// Zeitwerte müssen auf null gesetzt werden
Process.lNewKernel := 0;
Process.lNewUser   := 0;
Process.dwNewTime  := 0;

// speichert die aktuellen Zeitwerte im Datensatz
RefreshProcess(Process);

Label1.Caption := IntToStr(GetCPUTimeForProcess(Process)) +'%';

Bevor RefreshProcess ausgeführt wird, müssen die alten Zeitwerte auf null gesetzt werden, damit bei neuen Prozessen keine ungültigen Werte herauskommen.