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

Answer 1

You can achieve your goal using the Performance Counters Functions from Microsoft.

Limited User Access Support

Only the administrator of the computer or users in the Performance Logs User Group can log and view counter data. Users in the Administrator group can log and view counter data only if the tool they use to log and view counter data is started from a Command Prompt window that is opened with Run as administrator.... Users in the Performance Monitoring Users group can view counter data.

---

I have found this answer - see CPU currently used - from the Lanzelot user here on SO and I have done some porting to Delphi.

Raw porting:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  pdh in 'pdh.pas';

var
  cpuQuery: HQUERY;
  cpuTotal: HCOUNTER;
  i: Integer;

procedure init;
begin
  PdhOpenQuery(nil, 0, cpuQuery);
  PdhAddCounter(cpuQuery, '\Processor(_Total)\% Processor Time', 0, cpuTotal);
  PdhCollectQueryData(cpuQuery);
end;

function getCurrentValue: Double;
var
  counterVal: TPdhFmtCounterValue;
begin
  PdhCollectQueryData(cpuQuery);
  PdhGetFormattedCounterValue(cpuTotal, PDH_FMT_DOUBLE, nil, counterVal);
  Result := counterVal.doubleValue;
end;

The example requires the pdh unit which I have grabbed from here.
The WinPerf unit is needed by the pdh and I have downloaded it from here.

Basic test in a console application:

begin
  init;
  for i := 1 to 60 do begin
    //let's monitor the CPU usage for one minute
    WriteLn(getCurrentValue);
    Sleep(1000);
  end;
  PdhCloseQuery(cpuQuery);
end.

---

A more useful example based on the TThread class.
This allows to obtain different counters based on the parameter passed to the ACounterPath argument in the constructor.

counterThread.pas

unit counterThread;

interface

uses
  Classes, Windows, SyncObjs, pdh;

type
  TCounterNotifyEvent = procedure(AValue: Double) of object;

  TCounterThread = class(TThread)
    private
      FInterval: Integer;
      FWaitEvent: TEvent;
      FHQuery: HQUERY;
      FHCounter: HCOUNTER;

      procedure checkSuccess(AResult: Integer);
    protected
      procedure Execute; override;
      procedure TerminatedSet; override;
    public
      OnCounter: TCounterNotifyEvent;
      constructor Create(const ACounterPath: PChar; AInterval: Cardinal; ACreateSuspended: Boolean);
      destructor Destroy; override;
  end;

implementation

uses
  SysUtils;

procedure TCounterThread.checkSuccess(AResult: Integer);
begin
  if ERROR_SUCCESS <> AResult then
    RaiseLastOSError;
end;

constructor TCounterThread.Create(const ACounterPath: PChar; AInterval: Cardinal; ACreateSuspended: Boolean);
begin
  inherited Create(ACreateSuspended);
  FInterval := AInterval;
  FWaitEvent := TEvent.Create(nil, False, False, '');

  FHQuery := INVALID_HANDLE_VALUE;
  checkSuccess(PdhOpenQuery(nil, 0, FHQuery));
  checkSuccess(PdhAddCounter(FHQuery, ACounterPath, 0, FHCounter));
  //checkSuccess(PdhAddEnglishCounter(FHQuery, ACounterPath, 0, FHCounter));
  checkSuccess(PdhCollectQueryData(FHQuery));
end;

destructor TCounterThread.Destroy;
begin
  FWaitEvent.Free;
  if (FHQuery <> 0) and (FHQuery <> INVALID_HANDLE_VALUE) then
    PdhCloseQuery(FHQuery);
  inherited;
end;

procedure TCounterThread.TerminatedSet;
begin
  inherited;
  FWaitEvent.SetEvent;
end;

procedure TCounterThread.Execute;
var
  counterVal: TPdhFmtCounterValue;
begin
  inherited;
  while not Terminated do begin
    checkSuccess(PdhCollectQueryData(FHQuery));
    FillChar(counterVal, SizeOf(TPdhFmtCounterValue), 0);
    checkSuccess(PdhGetFormattedCounterValue(FHCounter, PDH_FMT_DOUBLE, nil, counterVal));
    if Assigned(OnCounter) then
      OnCounter(counterVal.doubleValue);
    FWaitEvent.WaitFor(FInterval);
  end;
end;

end.

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  counterThread;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FCpuCounter: TCounterThread;
    procedure CpuCounterCounter(AValue: Double);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
begin
  FCpuCounter := TCounterThread.Create('\Processor(_Total)\% Processor Time', 1000, False);
  //'\Processore(_Total)\% Tempo Processore'
  with FCpuCounter do begin
    FreeOnTerminate := True;
    OnCounter := CpuCounterCounter;
  end;
  Button1.Enabled := False;
end;

procedure TForm1.CpuCounterCounter(AValue: Double);
begin
  Edit1.Text := FloatToStr(AValue);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FCpuCounter) then
    FCpuCounter.Terminate;
end;

end.

Unit1.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 123
  ClientWidth = 239
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 24
    Width = 97
    Height = 13
    Caption = 'Total CPU usage %:'
  end
  object Edit1: TEdit
    Left = 111
    Top = 21
    Width = 99
    Height = 21
    TabOrder = 0
  end
  object Button1: TButton
    Left = 111
    Top = 80
    Width = 99
    Height = 25
    Caption = 'Start monitoring'
    TabOrder = 1
    OnClick = Button1Click
  end
end

---

OFF TOPIC I'm currently at home and I've not a Delphi XE here so I coded it with Turbo Delphi, I have no pdh unit installed on my machine and I can't know at the moment if Delphi XE has the units.

---

NOTICE I have used the PdhAddCounter function instead of the PdhAddEnglishCounter because the function reference is missing in the unit. Unfortunately, after I added the reference, the function was still missing in the Pdh.dll on my old Windows XP.

The szFullCounterPath of the PdhAddCounter is localized so I have to use the italian localized path on my Windows \Processore(_Total)\% Tempo Processore.

If you use the PdhAddEnglishCounter function or your locale is english, you have to use the path \Processor(_Total)\% Processor Time.

If your system locale is other than english or italian, you have to find the path by yourself using the PdhBrowseCounters function.
The very basic function usage which follows needs the PdhMsg unit.
See also MSDN Browsing Performance Counters for further reference.

function CounterPathCallBack(dwArg: DWORD_PTR): Longint; stdcall;
begin
  Form1.Memo1.Lines.Add(PChar(dwArg));
  Result := ERROR_SUCCESS;
end;

procedure TForm1.Button2Click(Sender: TObject);
const
  PDH_MAX_COUNTER_PATH = 255;//maybe ?
  BROWSE_DIALOG_CAPTION: PChar = 'Select a counter to monitor.';
var
  browseDlgData: TPdhBrowseDlgConfig;
  counterPathBuffer: array [0..PDH_MAX_COUNTER_PATH-1] of Char;
  status: LongInt;
begin
  FillChar(browseDlgData, SizeOf(TPdhBrowseDlgConfig), 0);

  with browseDlgData do begin
    {bIncludeInstanceIndex = FALSE;
    bSingleCounterPerAdd = TRUE;
    bSingleCounterPerDialog = TRUE;
    bLocalCountersOnly = FALSE;
    bWildCardInstances = TRUE;
    bHideDetailBox = TRUE;
    bInitializePath = FALSE;
    bDisableMachineSelection = FALSE;
    bIncludeCostlyObjects = FALSE;
    bShowObjectBrowser = FALSE;}
    hWndOwner := Self.Handle;
    szReturnPathBuffer := @counterPathBuffer[0];
    cchReturnPathLength := PDH_MAX_COUNTER_PATH;
    pCallBack := CounterPathCallBack;
    dwCallBackArg := DWORD_PTR(@counterPathBuffer[0]);
    CallBackStatus := ERROR_SUCCESS;
    dwDefaultDetailLevel := PERF_DETAIL_WIZARD;
    szDialogBoxCaption := BROWSE_DIALOG_CAPTION;
  end;

  status := PdhBrowseCounters(browseDlgData);

  case status of
    PDH_DIALOG_CANCELLED, ERROR_SUCCESS:
      ;
    else
      RaiseLastOSError;
  end;
end;