delphi - Get the Percentage of Total CPU Usage

Question

I am trying to get the % of total CPU usage to a label1.Caption

I've searched and found these:

• didn't work - http://www.vbforums.com/showthread.php?345723-DELPHI-Get-CPU-Usage

• not what I need - http://delphi.cjcsoft.net/viewthread.php?tid=42837

  • also found bunch of solutions regarding calculating the Usage per process but that is not what i am looking for , i just want the total CPU usage like this widget :

  this is what i am working on :

I believe there is a simple way like when we get RAM usage.

 GlobalMemoryStatus(RamStats);
 Label1.Caption := Format('RAM: %d %%', [RamStats.dwMemoryLoad]);

Answer 1

I have found an article, determine-cpu-usage-of-current-process-c-and-c, about how to get the CPU usage of the current process.

Now we need to do a bit more to compute the Total CPU usage percentage by adding up CPU usage percentage for each running processes:

function GetTotalCpuUsagePct(): Double;
var
  ProcessID: TProcessID;
  RunningProcessIDs : TArray<TProcessID>;
begin
  Result := 0.0;
  RunningProcessIDs := GetRunningProcessIDs;

  DeleteNonExistingProcessIDsFromCache(RunningProcessIDs);

  for ProcessID in RunningProcessIDs do
    Result := Result + GetProcessCpuUsagePct( ProcessID );

end;

After getting running process id's, we start out calling DeleteNonExistingProcessIDsFromCache to clean up the cache, that holds previous Cpu usage times needed in GetProcessCpuUsagePct: Every process that has been stopped since last query is removed from this cache.

The GetProcessCpuUsagePct is the core, which is a translation of determine-cpu-usage-of-current-process-c-and-c. This function needs to retrieve the previous reading from the Cpu Usage Cache LatestProcessCpuUsageCache (global in the unit) using the ProcessID. Note, it is not recommended to call GetToalCpuUsageCpu less than every 200 ms, as it may give wrong results.

function GetProcessCpuUsagePct(ProcessID: TProcessID): Double;
  function SubtractFileTime(FileTime1: TFileTIme; FileTime2: TFileTIme): TFileTIme;
  begin
    Result := TFileTIme(Int64(FileTime1) - Int64(FileTime2));
  end;

var
  ProcessCpuUsage: TProcessCpuUsage;
  ProcessHandle: THandle;
  SystemTimes: TSystemTimesRec;
  SystemDiffTimes: TSystemTimesRec;
  ProcessDiffTimes: TProcessTimesRec;
  ProcessTimes: TProcessTimesRec;

  SystemTimesIdleTime: TFileTime;
  ProcessTimesCreationTime: TFileTime;
  ProcessTimesExitTime: TFileTime;
begin
  Result := 0.0;

  LatestProcessCpuUsageCache.TryGetValue(ProcessID, ProcessCpuUsage);
  if ProcessCpuUsage = nil then
  begin
    ProcessCpuUsage := TProcessCpuUsage.Create;
    LatestProcessCpuUsageCache.Add(ProcessID, ProcessCpuUsage);
  end;
  // method from:
  // http://www.philosophicalgeek.com/2009/01/03/determine-cpu-usage-of-current-process-c-and-c/
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
  if ProcessHandle <> 0 then
  begin
    try
      if GetSystemTimes(SystemTimesIdleTime, SystemTimes.KernelTime, SystemTimes.UserTime) then
      begin
        SystemDiffTimes.KernelTime := SubtractFileTime(SystemTimes.KernelTime, ProcessCpuUsage.LastSystemTimes.KernelTime);
        SystemDiffTimes.UserTime := SubtractFileTime(SystemTimes.UserTime, ProcessCpuUsage.LastSystemTimes.UserTime);
        ProcessCpuUsage.LastSystemTimes := SystemTimes;
        if GetProcessTimes(ProcessHandle, ProcessTimesCreationTime, ProcessTimesExitTime, ProcessTimes.KernelTime, ProcessTimes.UserTime) then
        begin
          ProcessDiffTimes.KernelTime := SubtractFileTime(ProcessTimes.KernelTime, ProcessCpuUsage.LastProcessTimes.KernelTime);
          ProcessDiffTimes.UserTime := SubtractFileTime(ProcessTimes.UserTime, ProcessCpuUsage.LastProcessTimes.UserTime);
          ProcessCpuUsage.LastProcessTimes := ProcessTimes;
          if (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) > 0 then
            Result := (Int64(ProcessDiffTimes.KernelTime) + Int64(ProcessDiffTimes.UserTime)) / (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) * 100;
        end;
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end;
end;

Here is a screen shot of the result on a Windows 7.

Full Listing of unit:

unit uTotalCpuUsagePct;

interface

  function GetTotalCpuUsagePct : Double;

implementation

uses
  SysUtils, DateUtils, Windows, PsAPI, TlHelp32, ShellAPI, Generics.Collections;

type
  TProcessID = DWORD;

  TSystemTimesRec = record
    KernelTime: TFileTIme;
    UserTime: TFileTIme;
  end;

  TProcessTimesRec = record
    KernelTime: TFileTIme;
    UserTime: TFileTIme;
  end;

  TProcessCpuUsage = class
    LastSystemTimes: TSystemTimesRec;
    LastProcessTimes: TProcessTimesRec;
    ProcessCPUusagePercentage: Double;
  end;

  TProcessCpuUsageList = TObjectDictionary<TProcessID, TProcessCpuUsage>;

var
  LatestProcessCpuUsageCache : TProcessCpuUsageList;
  LastQueryTime : TDateTime;

(* -------------------------------------------------------------------------- *)

function GetRunningProcessIDs: TArray<TProcessID>;
var
  SnapProcHandle: THandle;
  ProcEntry: TProcessEntry32;
  NextProc: Boolean;
begin
  SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if SnapProcHandle <> INVALID_HANDLE_VALUE then
  begin
    try
      ProcEntry.dwSize := SizeOf(ProcEntry);
      NextProc := Process32First(SnapProcHandle, ProcEntry);
      while NextProc do
      begin
        SetLength(Result, Length(Result) + 1);
        Result[Length(Result) - 1] := ProcEntry.th32ProcessID;
        NextProc := Process32Next(SnapProcHandle, ProcEntry);
      end;
    finally
      CloseHandle(SnapProcHandle);
    end;
    TArray.Sort<TProcessID>(Result);
  end;
end;

(* -------------------------------------------------------------------------- *)

function GetProcessCpuUsagePct(ProcessID: TProcessID): Double;
  function SubtractFileTime(FileTime1: TFileTIme; FileTime2: TFileTIme): TFileTIme;
  begin
    Result := TFileTIme(Int64(FileTime1) - Int64(FileTime2));
  end;

var
  ProcessCpuUsage: TProcessCpuUsage;
  ProcessHandle: THandle;
  SystemTimes: TSystemTimesRec;
  SystemDiffTimes: TSystemTimesRec;
  ProcessDiffTimes: TProcessTimesRec;
  ProcessTimes: TProcessTimesRec;

  SystemTimesIdleTime: TFileTime;
  ProcessTimesCreationTime: TFileTime;
  ProcessTimesExitTime: TFileTime;
begin
  Result := 0.0;

  LatestProcessCpuUsageCache.TryGetValue(ProcessID, ProcessCpuUsage);
  if ProcessCpuUsage = nil then
  begin
    ProcessCpuUsage := TProcessCpuUsage.Create;
    LatestProcessCpuUsageCache.Add(ProcessID, ProcessCpuUsage);
  end;
  // method from:
  // http://www.philosophicalgeek.com/2009/01/03/determine-cpu-usage-of-current-process-c-and-c/
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
  if ProcessHandle <> 0 then
  begin
    try
      if GetSystemTimes(SystemTimesIdleTime, SystemTimes.KernelTime, SystemTimes.UserTime) then
      begin
        SystemDiffTimes.KernelTime := SubtractFileTime(SystemTimes.KernelTime, ProcessCpuUsage.LastSystemTimes.KernelTime);
        SystemDiffTimes.UserTime := SubtractFileTime(SystemTimes.UserTime, ProcessCpuUsage.LastSystemTimes.UserTime);
        ProcessCpuUsage.LastSystemTimes := SystemTimes;
        if GetProcessTimes(ProcessHandle, ProcessTimesCreationTime, ProcessTimesExitTime, ProcessTimes.KernelTime, ProcessTimes.UserTime) then
        begin
          ProcessDiffTimes.KernelTime := SubtractFileTime(ProcessTimes.KernelTime, ProcessCpuUsage.LastProcessTimes.KernelTime);
          ProcessDiffTimes.UserTime := SubtractFileTime(ProcessTimes.UserTime, ProcessCpuUsage.LastProcessTimes.UserTime);
          ProcessCpuUsage.LastProcessTimes := ProcessTimes;
          if (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) > 0 then
            Result := (Int64(ProcessDiffTimes.KernelTime) + Int64(ProcessDiffTimes.UserTime)) / (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) * 100;
        end;
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end;
end;

(* -------------------------------------------------------------------------- *)

procedure DeleteNonExistingProcessIDsFromCache(const RunningProcessIDs : TArray<TProcessID>);
var
  FoundKeyIdx: Integer;
  Keys: TArray<TProcessID>;
  n: Integer;
begin
  Keys := LatestProcessCpuUsageCache.Keys.ToArray;
  for n := Low(Keys) to High(Keys) do
  begin
    if not TArray.BinarySearch<TProcessID>(RunningProcessIDs, Keys[n], FoundKeyIdx) then
      LatestProcessCpuUsageCache.Remove(Keys[n]);
  end;
end;

(* -------------------------------------------------------------------------- *)

function GetTotalCpuUsagePct(): Double;
var
  ProcessID: TProcessID;
  RunningProcessIDs : TArray<TProcessID>;
begin
  Result := 0.0;
  RunningProcessIDs := GetRunningProcessIDs;

  DeleteNonExistingProcessIDsFromCache(RunningProcessIDs);

  for ProcessID in RunningProcessIDs do
    Result := Result + GetProcessCpuUsagePct( ProcessID );

end;

(* -------------------------------------------------------------------------- *)

initialization
  LatestProcessCpuUsageCache := TProcessCpuUsageList.Create( [ doOwnsValues ] );
  // init:
  GetTotalCpuUsagePct;
finalization
  LatestProcessCpuUsageCache.Free;
end.

Test Code:

unit Unit1;

interface

uses
  Vcl.Forms, System.SysUtils, Vcl.Controls, Vcl.StdCtrls, System.Classes,
  Vcl.ExtCtrls,

  uTotalCpuUsagePct;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // start cpu load thread
  TThread.CreateAnonymousThread(
    procedure
    begin
      while True do
      begin
      end;
    end).Start;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  TotalCPUusagePercentage: Double;
begin
  TotalCPUusagePercentage := GetTotalCpuUsagePct();
  Label1.Caption := 'Total cpu: ' + IntToStr(Round(TotalCPUusagePercentage)) + '%';
end;

end.