Performance Counters

unit mbsCpuUsage;
//CPU USAGE unit for Windows NT
//Modified: 2009-08-10, mortenbs.com
//Tested using Delphi 7 and Windows XP

interface

uses
windows;

const
MAX_CPU_COUNT                =  64;          //Max cpu count (array)
THRD_TIMER_DELAY              = 500;          //Thread update time (ms)

type
//-----------------------------|----------------|----------------------|----------------------------
str                          = ansiString;
lInt                          = longInt;
pInt64                        = ^int64;
aInt64                        = array[0..$FFFF] of int64;
pAInt64                      = ^aInt64;
tCpuFloats                    = array[0..MAX_CPU_COUNT-1] of extended;
tSimpleEvent                  = procedure of object;
//-----------------------------|----------------|----------------------|----------------------------
tCpuUsageNT=class(tObject)
  procedure reset;virtual;                      //Reset all states to zero
  function usagePct(const aCpuId:lInt):extended;//Get cpu core usage in percents
  function text(const aSep:str;const aAlsoWantAvrg:boolean=false):str;
  procedure notifyChanges;
private
  fOnChanges                  :tSimpleEvent;
protected
public
  data                        :tCpuFloats;    //Cpu core array in percents (extended)
  thrd                        :pointer;        //Updater thread pointer
  count                        :lInt;          //Cpu count
  constructor create;virtual;
  destructor destroy;override;
  property onChanges          :tSimpleEvent    read fOnChanges        write fOnChanges;
end;
//-----------------------------|----------------|----------------------|----------------------------

implementation

uses
sysUtils,classes;

type
//-----------------------------|----------------|----------------------|----------------------------
pPerfDataBlock=^tPerfDataBlock;
tPerfDataBlock=packed record
  signature                    :array[0..3] of wChar;
  littleEndian,vs,rev,
  totalbyteLn,headerLn,
  numObjectTypes              :dWord;
  defaultObject                :lInt;
  sysTime                      :tSystemTime;
  reserved                    :dWord;
  perfTime,perfFreq,
  perfTime100nSec              :int64;
  sysNameLn,systemNameOffset  :dWord
end;
//-----------------------------|----------------|----------------------|----------------------------
pPerfObjType=^tPerfObjType;
tPerfObjType=packed record
  totalbyteLn,defLn,
  headerLn,objNti              :dWord;
  objectNameTitle              :lpwStr;
  objHti                      :dWord;
  objHt                        :lpwStr;
  detailLevel,numCounters      :dWord;
  defCounter,numInstances      :lInt;
  codePage                    :dWord;
  perfTime,perfFreq            :int64
end;
//-----------------------------|----------------|----------------------|----------------------------
pPerfCounterDef=^tPerfCounterDef;
tPerfCounterDef=packed record
  byteLn,counterNti            :dWord;
  counterTit                  :lpwStr;
  counterHti                  :dWord;
  counterHt                    :lpwStr;
  defaultScale                :lInt;
  detailLevel,counterType,
  counterSize,counterOffset    :dWord
end;
//-----------------------------|----------------|----------------------|----------------------------
pPerfCounterBlock=^tPerfCounterBlock;
tPerfCounterBlock=packed record
  byteLn                      :dWord
end;
//-----------------------------|----------------|----------------------|----------------------------
pPerfInstanceDef=^tPerfInstanceDef;
tPerfInstanceDef=packed record
  byteLn,parentObjectTitleIndex,
  parentObjectInstance        :dWord;
  uniqueId                    :lInt;
  nameOffset,nameLength        :dWord
end;
//-----------------------------|----------------|----------------------|----------------------------

const
CPU_USAGE_IDX                =  6;          //Internal use
PROCESSOR_IDX                = 238;          //Internal use

//--------------------------------------------------------------------------------------------------
//tCpuUsageNTThrd:

type
tCpuUsageNTThrd=class(tThread)
  function usagePct(const aCpuId:byte):extended;
  procedure update;
private
  fCpuUsageNT                  :tCpuUsageNT;
  fPerfData                    :pPerfDataBlock;
  pot                          :pPerfObjType;
  pcd                          :pPerfCounterDef;
  fBufSize,fCpuCount          :integer;
  fCounters,fPrevCounters      :pAint64;
  fSysTime,fPrevSysTime        :int64;
protected
  procedure execute;override;
public
  count                        :lInt;
  constructor create(aCpuUsageNT:tCpuUsageNT);reintroduce;
  destructor destroy;override;
end;

constructor tCpuUsageNTThrd.create(aCpuUsageNT:tCpuUsageNT);//reintroduce;
begin inherited create(true);fCpuUsageNT:=aCpuUsageNT;freeOnTerminate:=true;
fCpuCount:=-1;fBufSize:=$2000;
getMem(fPerfData,fBufSize);fillChar(fPerfData^,fBufSize,0);resume
end;

destructor tCpuUsageNTThrd.destroy;//override;
begin freeMem(fPerfData);inherited destroy end;

procedure tCpuUsageNTThrd.execute;//override;
var i,c:lInt;
begin
with fCpuUsageNT do while not terminated do begin update;
  c:=fCpuCount;if c>MAX_CPU_COUNT then c:=MAX_CPU_COUNT;count:=c;
  for i:=0 to MAX_CPU_COUNT-1 do if i<c then data[i]:=self.usagePct(i) else data[i]:=0.0;
  synchronize(notifyChanges);
  sleep(THRD_TIMER_DELAY)
end
end;

function tCpuUsageNTThrd.usagePct(const aCpuId:byte):extended;
begin
if fPrevSysTime=fSysTime then result:=0 else
result:=(1-(fCounters[aCpuId]-fPrevCounters[aCpuId])/(fSysTime-fPrevSysTime))*100;
if result<0.0 then result:=0.0 else if result>100.0 then result:=100.0
end;

procedure tCpuUsageNTThrd.update;
var i,bs:integer;st:tFileTime;pcbI:pPerfCounterBlock;pidI:pPerfInstanceDef;
begin bs:=fBufSize;

while regQueryValueEx(HKEY_PERFORMANCE_DATA,pChar(intToStr(PROCESSOR_IDX)),nil,nil,pByte(fPerfData),@bs)=ERROR_MORE_DATA do begin
  inc(fBufSize,$1000);bs:=fBufSize;reallocMem(fPerfData,fBufSize)
end;

pot:=pPerfObjType(dWord(fPerfData)+fPerfData.headerLn);
for i:=1 to fPerfData.numObjectTypes do if pot.objNti<>PROCESSOR_IDX then
  pot:=pPerfObjType(dWord(pot)+pot.totalByteLn) else break;

if pot.objNti<>PROCESSOR_IDX then exit;

if fCpuCount<0 then begin fCpuCount:=pot.numInstances;
  getMem(fCounters,fCpuCount*sizeOf(int64));getMem(fPrevCounters,fCpuCount*sizeOf(int64));
end;

pcd:=pPerfCounterDef(dWord(pot)+pot.headerLn);
for i:=1 to pot.numCounters do if pcd.counterNti<>CPU_USAGE_IDX then
  pcd:=pPerfCounterDef(dWord(pcd)+pcd.byteLn) else break;

if pcd.counterNti<>CPU_USAGE_IDX then exit;

pidI:=pPerfInstanceDef(dWord(pot)+pot.defLn);
for i:=0 to fCpuCount-1 do begin
  pcbI:=pPerfCounterBlock(dWord(pidI)+pidI.byteLn);
  fPrevCounters[i]:=fCounters[i];
  fCounters[i]:=int64(pInt64(dWord(pcbI)+pcd.counterOffset)^);
  pidI:=pPerfInstanceDef(dWord(pcbI)+pcbI.byteLn);
end;

fPrevSysTime:=fSysTime;systemTimeToFileTime(fPerfData.sysTime,st);fSysTime:=int64(st)
end;

//--------------------------------------------------------------------------------------------------
//tCpuUsageNT:

constructor tCpuUsageNT.create;//virtual;
begin inherited create;reset;
thrd:=pointer(tCpuUsageNTThrd.create(self))
end;

destructor tCpuUsageNT.destroy;//override;
begin
if thrd<>nil then begin tCpuUsageNTThrd(thrd).terminate;thrd:=nil end;
inherited destroy
end;

procedure tCpuUsageNT.reset;//virtual;
var i:lInt;
begin for i:=0 to MAX_CPU_COUNT do data[i]:=0 end;

function tCpuUsageNT.usagePct(const aCpuId:lInt):extended;
begin if (aCpuId>-1) and (aCpuId<count) then result:=data[aCpuId] else result:=0 end;

function tCpuUsageNT.text(const aSep:str;const aAlsoWantAvrg:boolean=false):str;
var i,cnt:lInt;
begin result:='';cnt:=count-1;if not aAlsoWantAvrg then dec(cnt);
for i:=0 to cnt do begin
  if i>0 then result:=result+aSep;
  result:=result+intToStr(trunc(usagePct(i)))+'%'
end
end;

procedure tCpuUsageNT.notifyChanges;
begin if assigned(fOnChanges) then fOnChanges end;

end.

unit Unit1;

interface

uses
  Windows, mbsCpuUsage, SysUtils, Classes, Graphics, Controls, Forms;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  cpuUsage:tCpuUsageNT;
  procedure cpuUsageChanges;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
cpuUsage:=tCpuUsageNT.create;
cpuUsage.onChanges:=cpuUsageChanges
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
cpuUsage.free
end;

procedure TForm1.cpuUsageChanges;
begin
caption:=cpuUsage.text(',')
end;

end.