W-Shadow.com

unit CoreUsage;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, JwaWindows, ExtCtrls, ComCtrls, Gauges;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  TCounter = record
   Path : string;
   Handle : cardinal;
   mLabel : TLabel;
   mGauge : TGauge;
  end;
 
var
  Form1: TForm1;
  Counters : array of TCounter;
  Query : Cardinal = 0;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
 dwSize, h : cardinal;
 cnt, i : Integer;
 pPaths:PWideChar;
 pIterator:PwideChar;
 InstanceId, CounterPath : string;
 status : PDH_STATUS;
begin
  //Create a performance query
  if  PdhOpenQuery(nil, 0, Query) = ERROR_SUCCESS then begin
 
    //Get all valid processor/core usage counter paths by expanding
    //a wildcard path. To do this, we must first call PdhExpandWildCardPath
    //with buffer size set to zero to get the actual required buffer size.
    dwSize := 0;
    pPaths := nil;
 
    status := PdhExpandWildCardPath(
      nil,                                  //search the local computer
      '\Processor(*/*#*)\% Processor Time', //we want CPU usage counters for all CPUs/cores
      pPaths,                               //user-allocated buffer; currently null
      dwSize,                               //buffer size
      0) ;                                  //no flags
 
    if status = PDH_MORE_DATA then begin
      dwSize := dwSize + 1; //+1 byte required in XP and below.
      pPaths := GetMemory(dwSize); //Allocate an output buffer.
 
      //Really get the counter paths.
      status := PdhExpandWildCardPath(
        nil,
        '\Processor(*/*#*)\% Processor Time',
        pPaths,
        dwSize,
        0) ;
 
      if status = ERROR_SUCCESS then begin
 
        cnt := 0;
        SetLength(Counters, 32);
 
        //PdhExpandWildCardPath returns the counter list (pPaths) as an array
        //of null-terminated strings where the last item is a zero-length
        //string (i.e. just #0). We'll now iterate over this list with some
        //simple pointer math.
        pIterator := pPaths;
        while (strlen(pIterator)>0) do begin
 
          CounterPath := pIterator;
          pIterator := pIterator + Length(pIterator) + 1;
 
          //Find the counter instance ID (the part in parentheses)
          i := Pos('(', CounterPath);
          InstanceId := Copy(CounterPath, i+1, Pos(')', CounterPath)-i-1);
          //Skip the counter if it indicates the overall CPU usage,
          //we only want the per-core values.
          if InstanceId = '_Total' then continue;
 
          //Add the counter to the query
          status := PdhAddCounter(Query, PWideChar(CounterPath), 0, h);
 
          if status = ERROR_SUCCESS then begin
 
            //Expand the internal counter array if necessary
            if cnt > Length(Counters)-1 then
              SetLength(Counters, Length(Counters)+16);
 
            //Save the counter data to the array
            with Counters[cnt] do begin
              Path := CounterPath;
              Handle := h;
 
              //Create a label for this core/CPU
              mLabel := TLabel.Create(Self);
              mLabel.Parent := Self;
              mLabel.Caption := 'Core '+InstanceId;
              mLabel.Top := (mLabel.Height + 8) * cnt + 10;
              mLabel.Left := 10;
              mLabel.AutoSize := false;
              mLabel.Width := 80;
 
              //Create a "progress bar" to show the core/CPU usage
              mGauge := TGauge.Create(Self);
              mGauge.Parent := Self;
              mGauge.Top := mLabel.Top;
              mGauge.Left := mLabel.Width + 20;
              mGauge.Height := mLabel.Height+2;
              mGauge.Width := Self.ClientWidth - mGauge.Left - 10;
              mGauge.ForeColor := $0031D329;
              mGauge.Anchors := [akRight, akTop];
 
            end;
 
            inc(cnt);
          end;
        end;//while
 
        //Truncate the array to the actual number of discovered cores  
        SetLength(Counters, cnt);
 
        //Collect the first data sample
        PdhCollectQueryData(Query);
 
      end;
    end;
 
  end;
 
  //Did we get any valid counters?
  if Length(Counters) = 0 then begin
 
    //Nope. Show an unhelpful error message...
    MessageBox(Handle, 'Initialization was unsuccessful. The application will now exit.',
      'Error', MB_OK or MB_ICONEXCLAMATION);
 
    //...and quit.
    Application.Terminate;
 
  end else begin
    //Everything went well.
    //Resize the form to make sure all progress bars are visible.
    Self.ClientHeight :=
      Counters[Length(Counters)-1].mLabel.Top +
      Counters[Length(Counters)-1].mLabel.Height +
      Counters[0].mLabel.Top;
  end;
 
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
 i:integer;
 counterType: PDword;
 pValue:_PDH_FMT_COUNTERVALUE;
 status : cardinal;
begin
  if Query = 0 then exit;
 
  //Collect a data sample.
  PdhCollectQueryData(Query);
 
  //Iterate over all counters and update progress bars.
  for i := 0 to Length(Counters) - 1 do begin
    counterType := nil;
 
    //Get the current core/CPU usage
    status := PdhGetFormattedCounterValue(
      Counters[i].Handle, //Counter handle as returned by PdhAddCounter.
      PDH_FMT_DOUBLE,     //Get the counter value as a double-precision float.
      CounterType,        //Counter type; unused.
      pValue);            //Output buffer for the counter value.
 
    //Update the progress bar.
    if status = ERROR_SUCCESS then
      Counters[i].mGauge.Progress := Round(pValue.doubleValue);
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 //Close the query when quitting.
 if Query <> 0 then PdhCloseQuery(Query);
end;
 
end.