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;
