unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Gauges, JwaWindows;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    Gauge1: TGauge;
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

var
  FhCounter : PDH_HCOUNTER;
  FQuery    : HQUERY = 0;

{$R *.dfm}

//=============================================================================
//  終了時にはQueryオブジェクトを閉じる
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FQuery <> 0 then PdhCloseQuery(FQuery);
end;

//=============================================================================
//  [開始]ボタン
//  szDataSourceの値を変更すればいろいろなパフォーマンスオブジェクトのカウンタ
//  値を取得できる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LszDataSource : String;
  LStatus       : PDH_STATUS;
begin
  Timer1.Enabled := False;

  //取得する情報はパフォーマンスオブジェクトProcessorのProcessore Timeカウンタ
  LszDataSource := '\Processor(_Total)\% Processor Time';

  //パフォーマンスクエリーが生成されていたら一旦閉じる
  if FQuery <> 0 then begin
    PdhCloseQuery(FQuery);
    Gauge1.Progress := 0;
  end;

  //新規にパフォーマンスクエリー生成
  //使用終了したらPdhCloseQueryで必ず閉じる
  if PdhOpenQuery(nil, 0, FQuery) <> ERROR_SUCCESS then exit;

  //そのパフォーマンスカウンタをクエリーに取得
  LStatus := PdhAddCounter(FQuery, PChar(LszDataSource), 0, FhCounter);

  if LStatus = ERROR_SUCCESS then begin
    //Queryのパフォーマンスカウンタを更新
    PdhCollectQueryData(FQuery);
    Timer1.Interval := 1000;
    Timer1.Enabled  := True;
  end;
end;

//=============================================================================
//  TTimerのOnTimerイベント
//  指定間隔ごとにパフォーマンスカウンタを更新
//=============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
var
  LpValue : PDH_FMT_COUNTERVALUE;
  LStatus : PDH_STATUS;
begin
  if FQuery = 0 then exit;

  //Queryのパフォーマンスカウンタを更新
  PdhCollectQueryData(FQuery);

  //指定形式によるパフォーマンスカウンタ値の取得
  //このサンプルでは1秒ごとの使用率
  LStatus := PdhGetFormattedCounterValue(FhCounter,
                                         PDH_FMT_DOUBLE,
                                         nil,
                                         LpValue);

  //値の取得に成功したらゲージの表示を更新
  if LStatus = ERROR_SUCCESS then begin
    Gauge1.Progress := Round(LpValue.doubleValue);
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Gauges, JwaWindows;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    Gauge1: TGauge;
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

var
  FhCounter : PDH_HCOUNTER;
  FQuery    : HQUERY = 0;

{$R *.dfm}

//=============================================================================
//  終了時にはQueryオブジェクトを閉じる
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FQuery <> 0 then PdhCloseQuery(FQuery);
end;

//=============================================================================
//  [開始]ボタン
//  マイクロソフトワードのCPU使用率を取得して表示
//
//  CPU全体の使用率表示のサンプルと違うのは(*)の1行のみ
//  LszDataSource := '\Process(winword#0)\% Processor Time';
//  Processor -->  Process
//  _Total    -->  winword#0
//
//  winword#0の#0は最初に起動したワードの意味
//  winword#1の時は2番目に起動したワード
//  メモ帳の場合はnotepad#0とする
//  delphi32#0とするとDelphi 7までのDelphi(現在IDE起動しているDelphiを除く)
//
//  このサンプルコードのままでは，ワードを終了しても，最後の値がゲージに表示さ
//  れたままとなる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LszDataSource : String;
  LStatus       : PDH_STATUS;
begin
  Timer1.Enabled := False;

  //取得する情報はパフォーマンスオブジェクトProcessのProcessore Timeカウンタ
  LszDataSource := '\Process(winword#0)\% Processor Time';    //(*)

  //パフォーマンスクエリーが生成されていたら一旦閉じる
  if FQuery <> 0 then begin
    PdhCloseQuery(FQuery);
    Gauge1.Progress := 0;
  end;

  //新規にパフォーマンスクエリー生成
  //使用終了したらPdhCloseQueryで必ず閉じる
  if PdhOpenQuery(nil, 0, FQuery) <> ERROR_SUCCESS then exit;

  //そのパフォーマンスカウンタをクエリーに取得
  LStatus := PdhAddCounter(FQuery, PChar(LszDataSource), 0, FhCounter);

  if LStatus = ERROR_SUCCESS then begin
    //Queryのパフォーマンスカウンタを更新
    PdhCollectQueryData(FQuery);
    Timer1.Interval := 1000;
    Timer1.Enabled  := True;
  end;
end;

//=============================================================================
//  TTimerのOnTimerイベント
//  指定間隔ごとにパフォーマンスカウンタを更新
//=============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
var
  LpValue : PDH_FMT_COUNTERVALUE;
  LStatus : PDH_STATUS;
begin
  if FQuery = 0 then exit;

  //Queryのパフォーマンスカウンタを更新
  PdhCollectQueryData(FQuery);

  //指定形式によるパフォーマンスカウンタ値の取得
  //このサンプルでは1秒ごとの使用率
  LStatus := PdhGetFormattedCounterValue(FhCounter,
                                        PDH_FMT_DOUBLE,
                                        nil,
                                        LpValue);

  //値の取得に成功したらゲージの表示を更新
  if LStatus = ERROR_SUCCESS then begin
    Gauge1.Progress := Round(LpValue.doubleValue);
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Gauges, JwaWindows;

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

  TCounterGauge = record
    Path   : String;
    Handle : NativeUInt;
    mLabel : TLabel;
    mGauge : TGauge;
  end;

var
  Form1: TForm1;

implementation

var
  FCounterGauges : array of TCounterGauge;
  FQuery         : HQUERY = 0;

{$R *.dfm}

//=============================================================================
//  プログラム開始時の処理
//
//  このコードは以下のサイトの記事とコードを利用
//  [How To Get Per-Core CPU Usage]
//  http://w-shadow.com/blog/2009/04/17/per-core-cpu-usage/
//  上記URLのサンプルからの変更点
//
//  [実行開始]ボタンでパフォーマンスカウンタの更新開始とした
//  カウンタごとの情報を格納するCountersのサイズの調整コードを変更
//  FreeMem(pPaths)を追加(メモリリーク対策)
//  \Processor(*/*#*)を\Processor(*/*)に変更
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LdwSize       : Cardinal;
  LpdhQuery     : HQUERY;
  LszDataSource : String;
  LCoreNo       : Integer;
  LpPaths       : PChar;
  LpIterator    : PChar;
  LInstanceId   : String;
  LCounterPath  : String;
  LStatus       : PDH_STATUS;
  LCpuGauge     : TCounterGauge;
  i             : Integer;
begin
  Timer1.Enabled := False;

  //Total(全体)のCPU使用率だけを表示する場合は(*)を(_Total)に変更する
  LszDataSource := '\Processor(*/*)\% Processor Time';

  //新規にパフォーマンスクエリー生成
  //使用終了したらPdhCloseQueryで必ず閉じる
  if  PdhOpenQuery(nil, 0, FQuery) <> ERROR_SUCCESS then exit;

  //情報取得に必要なサイズを取得
  LdwSize := 0;
  LpPaths := nil;
  LStatus := PdhExpandWildCardPath(nil,
                                   PChar(LszDataSource),
                                   LpPaths,
                                   LdwSize,
                                   0) ;

  if LStatus = PDH_MORE_DATA then begin
    //MSDNオンラインの記事によりWindows2000以上では+1とする
    //+1は最後のnull終端文字(最後は#0#0でリストの1つの最後は#0)
    LdwSize := LdwSize + 1;
    //その分のメモリを確保
    LpPaths := GetMemory(LdwSize);

    //トータルのCPU使用率を表示しない場合はこのコメントアウトを外す
    //if LInstanceId = '_Total' then continue;

    //カウンタパスの文字列を取得
    //pPathsにその文字がnull終端で結合されて入っている
    LStatus := PdhExpandWildCardPath(nil,
                                     PChar(LszDataSource),
                                     LpPaths,
                                     LdwSize,
                                     0) ;

    if LStatus = ERROR_SUCCESS then begin
      LCoreNo := 0;

      //取得したリスト文字列を処理操作用のリスト(null終端も熾烈のPChar)に代入
      LpIterator := LpPaths;
      while (strlen(LpIterator) > 0) do begin

        //pIteratorには\\コンピュータ名\Processor(0)\% Processor Time#0....
        //という形式で格納されている
        //null終端文字なのでStringに代入すれば先頭のカウンタパス名が取得できる
　      LCounterPath := LpIterator;

        //取得した文字列の()内がCore番号なのでそれを取り出す
        //PdhParseCounterPathという関数があるが()内は取得不可．カウンタ値は可
        i := Pos('(', LCounterPath);
        LInstanceId := Copy(LCounterPath, i + 1, Pos(')', LCounterPath) - i - 1);

        //そのパフォーマンスカウンタをクエリーに取得
        //このQueryをPdhCollectQueryData関数の引数に与えてパフォーマンスカウンタ
        //を更新する
        LStatus := PdhAddCounter(FQuery, PChar(LCounterPath), 0, LpdhQuery);

        if LStatus = ERROR_SUCCESS then begin

          //情報格納用の構造体(レコード体のサイズを更新
          //表示用のTLabel,TGauge等はTCounterGauge構造体にまとめて定義してある
          SetLength(FCounterGauges, LCoreNo + 1);

          //カウンタパス名(このサンプルでは使用していない)
          LCpuGauge.Path := LCounterPath;
          //そのカウンタのハンドル値
          LCpuGauge.Handle := LpdhQuery;

          //表示用のTLabelを作成
          LCpuGauge.mLabel := TLabel.Create(Self);
          LCpuGauge.mLabel.Parent     := Self;
          LCpuGauge.mLabel.ParentFont := True;
          LCpuGauge.mLabel.Caption    := 'Core ' + LInstanceId;
          LCpuGauge.mLabel.Top        := Button1.Height
                                       + (LCpuGauge.mLabel.Height + 8) * LCoreNo + 20;
          LCpuGauge.mLabel.Left       := 10;
          LCpuGauge.mLabel.AutoSize   := false;
          LCpuGauge.mLabel.Width      := 80;

          //表示用のゲージを作成
          LCpuGauge.mGauge := TGauge.Create(Self);
          LCpuGauge.mGauge.Parent     := Self;
          LCpuGauge.mGauge.ParentFont := True;
          LCpuGauge.mGauge.Top        := LCpuGauge.mLabel.Top - 2;
          LCpuGauge.mGauge.Left       := 80;
          LCpuGauge.mGauge.Height     := LCpuGauge.mLabel.Height + 4;
          LCpuGauge.mGauge.Width      := ClientWidth - LCpuGauge.mGauge.Left - 10;
          LCpuGauge.mGauge.ForeColor  := clGreen;
          LCpuGauge.mGauge.Anchors    := [akRight, akTop];

          //設定した値をLCoreNo番目に代入
          FCounterGauges[LCoreNo] := LCpuGauge;

          inc(LCoreNo);
        end;
        //次のカウンタパス名を取り出す.+1はnull終端文字分
        //この文字列の長さが0になるまでWhileループを繰り返す
        LpIterator := LpIterator + Length(LpIterator) + 1;
      end;
    end;
    if LpPaths <> nil then FreeMem(LpPaths);
  end;

  //フォームのサイズ(高さ)を調整
  if Length(FCounterGauges) > 0 then begin
    Self.ClientHeight := FCounterGauges[Length(FCounterGauges) - 1].mLabel.Top
                       + FCounterGauges[Length(FCounterGauges) - 1].mLabel.Height
                       + FCounterGauges[0].mLabel.Top - Button1.Height;
  end;
end;

//=============================================================================
//  終了時にはQueryオブジェクトを閉じる
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FQuery <> 0 then PdhCloseQuery(FQuery);
end;

//=============================================================================
//  [開始]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i : Integer;
begin
  if Length(FCounterGauges) = 0 then begin
    MessageBox(Handle,
               '情報の取得に失敗しました．　',
               '失敗',
               MB_OK or MB_ICONEXCLAMATION);
  end else begin
    //Queryのパフォーマンスカウンタを更新
    //次にPdhCollectQueryData関数を実行するとその間のCPU使用率が求まる
    PdhCollectQueryData(FQuery);

    //プログラム実行開始と同時にCPU使用率を表示するのであれば不要
    for i := 0 to Length(FCounterGauges) - 1 do begin
      FCounterGauges[i].mGauge.Progress := 0;
    end;

    Timer1.Interval := 1000;
    Timer1.Enabled  := True;
  end;
end;

//=============================================================================
//  TTimerのOnTimerイベント
//  指定間隔ごとにパフォーマンスカウンタを更新
//=============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
var
  LCounterType : PDWORD;
  LpValue      : PDH_FMT_COUNTERVALUE;
  LStatus      : PDH_STATUS;
  i            : Integer;
begin
  if FQuery = 0 then exit;

  //Queryのパフォーマンスカウンタを更新
  PdhCollectQueryData(FQuery);

  //コア数分だけループ処理
  for i := 0 to Length(FCounterGauges) - 1 do begin
    LCounterType := nil;

    //指定形式によるパフォーマンスカウンタ値の取得
    //このサンプルでは1秒ごとの使用率
    LStatus := PdhGetFormattedCounterValue(FCounterGauges[i].Handle,
                                           PDH_FMT_DOUBLE,
                                           LCounterType,
                                           LpValue);

    //値の取得に成功したらゲージの表示を更新
    if LStatus = ERROR_SUCCESS then begin
      FCounterGauges[i].mGauge.Progress := Round(LpValue.doubleValue);
    end;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Gauges, JwaWindows;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [取得開始]ボタン
//  パフォーマンスオブジェクトの一覧を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStatus       : PDH_STATUS;
  LdwSize       : DWORD;
  LpObjNameList : PChar;
  LpTempNames   : PChar;
  LObjName      : String;
  LStringList   : TStringList;
begin
  Screen.Cursor := crHourGlass;

  //リスト取得に必要なサイズを取得
  LdwSize := 0;
  LStatus := PdhEnumObjects(nil,
                            nil,
                            nil,
                            LdwSize,
                            PERF_DETAIL_WIZARD,
                            True);
  if LStatus = PDH_MORE_DATA then begin

    //その分のメモリを確保して取得開始
    //LdwSize+1とするとのは最後のnull終端分(#0#0)
    LdwSize       := LdwSize + 1;
    LpObjNameList := GetMemory(LdwSize);
    LStatus := PdhEnumObjects(nil,
                              nil,
                              LpObjNameList,
                              LdwSize,
                              PERF_DETAIL_WIZARD,
                              False);

    if LStatus = ERROR_SUCCESS then begin
      LStringList := TStringList.Create;
      try
        //取得したリストを操作用のリストに代入
        LpTempNames := LpObjNameList;
        while (StrLen(LpTempNames) > 0) do begin
　　      //Stringに代入すればnull終端までの文字列が取得できる
          LObjName := LpTempNames;
          LStringList.Add(LObjName);
          //取得元のポインタを移動(+1はnull終端(#0)分)
          LpTempNames := LpTempNames + Length(LpTempNames) + 1;
        end;
        ListBox1.Sorted := True;
        ListBox1.Items.Text := LStringList.Text;
      finally
        FreeAndNil(LStringList);
      end;
    end;
    if LpObjNameList <> nil then FreeMem(LpObjNameList);
  end;

  Screen.Cursor := crDefault;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Gauges, JwaWindows;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    Splitter1: TSplitter;
    ListBox2: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  テスト用にパフォーマンスオブジェクトの1つをセット
//  この文字列は[パフォーマンスオブジェクトの一覧]で取得するものを使用する
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Text := 'Process';
end;

//=============================================================================
//  [取得開始]ボタン
//  パフォーマンスカウンタとインスタンスとの一覧を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStatus         : PDH_STATUS;
  LdwCounterSize  : DWORD;
  LdwInstanceSize : DWORD;
  LpCounterList   : PChar;
  LpInstanceList  : PChar;
  LpTempList      : PChar;
  LObjName        : String;
  LStringList             : TStringList;
begin
  //リスト取得に必要なサイズを取得
  LdwCounterSize  := 0;
  LdwInstanceSize := 0;
  LStatus := PdhEnumObjectItems(nil,
                                nil,
                                PChar(Edit1.Text),
                                nil,
                                LdwCounterSize,
                                nil,
                                LdwInstanceSize,
                                PERF_DETAIL_WIZARD,
                                0);
  if LStatus <> PDH_MORE_DATA then exit;

  //その分のメモリを確保して取得開始
  //dwSize+1とするとのは最後のnull終端分(#0#0)
  LdwCounterSize  := LdwCounterSize + 1;
  LdwInstanceSize := LdwInstanceSize + 1;

  LpCounterList  := GetMemory(LdwCounterSize);
  LpInstanceList := GetMemory(LdwInstanceSize);

  LStatus := PdhEnumObjectItems(nil,
                                nil,
                                PChar(Trim(Edit1.Text)),
                                LpCounterList,
                                LdwCounterSize,
                                LpInstanceList,
                                LdwInstanceSize,
                                PERF_DETAIL_WIZARD,
                                0);

  if LStatus = ERROR_SUCCESS then begin
    LStringList := TStringList.Create;
    try

      //まずカウンタのリストを表示
      //取得したリストを操作用のリストに代入
      LpTempList := LpCounterList;
      while (StrLen(LpTempList) > 0) do begin
        //Stringに代入すればnull終端までの文字列が取得できる
        LObjName := LpTempList;
        LStringList.Add(LObjName);
        //取得元のポインタを移動(+1はnull終端(#0)分)
        LpTempList := LpTempList + Length(LpTempList) + 1;
      end;
      ListBox1.Sorted     := True;
      ListBox1.Items.Text := LStringList.Text;

      //次にインスタンスのリストを表示
      //取得したリストを操作用のリストに代入
      LStringList.Clear;
      LpTempList := LpInstanceList;
      while (StrLen(LpTempList) > 0) do begin
        //Stringに代入すればnull終端までの文字列が取得できる
        LObjName := LpTempList;
        LStringList.Add(LObjName);
        //取得元のポインタを移動(+1はnull終端(#0)分)
        LpTempList := LpTempList + Length(LpTempList) + 1;
      end;
      ListBox2.Sorted := True;
      ListBox2.Items.Text := LStringList.Text;

    finally
      FreeAndNil(LStringList);
    end;
  end;

  if LpCounterList <> nil  then FreeMem(LpCounterList);
  if LpInstanceList <> nil then FreeMem(LpInstanceList);
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Gauges, JwaWindows;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [パフォーマンスカウンタの参照ダイアログ]を表示してカウンタ文字列を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDlgData      : PDH_BROWSE_DLG_CONFIG;
  LpCounterPath : array [0..4095] of Char;
  LCounterPath  : String;
begin
  FillChar(LpCounterPath, SizeOf(LpCounterPath), #0);

  LDlgData.hWndOwner            := Handle;
  LDlgData.pCallBack            := nil;
  LDlgData.CallBackStatus       := 0;
  LDlgData.dwCallBackArg        := 0;
  LDlgData.dwConfigFlags        := 0;
  LDlgData.dwDefaultDetailLevel := PERF_DETAIL_WIZARD;
  LDlgData.szDataSource         := nil;
  LDlgData.szDialogBoxCaption   := 'カウンタ選択';
  LDlgData.cchReturnPathLength  := 4096;
  LDlgData.szReturnPathBuffer   := LpCounterPath;

  //ダイアログを表示して結果を表示
  //ダイアログで[追加]してから[閉じる]ボタンをクリックする
  PdhBrowseCounters(LDlgData);
  LCounterPath := LpCounterPath;
  ListBox1.Items.Add(LCounterPath);
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleServer, StdCtrls, Grids, ValEdit, ExtCtrls, ComCtrls,
  WbemScripting_TLB, ActiveX, Generics.Collections, Gauges;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private 宣言 }
    FGaugeList : TList<TGauge>;
    FstrQuery  : String;
    FService   : SWbemServices;
    function GetPropertyEnumCollection(FstrQuery: String;
      ConnectFlag: Boolean): IEnumVariant;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時に最初のクエリを実行し，表示用のゲージ等を作成
//  実際にはこの最初のクエリー実行でCPU使用率が取得できている
//
//  このサンプルコードではFstrQueryはグローバル変数としている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LEnumCollection : IEnumVariant;
  LCollectionItem : OleVariant;
  LValue          : LongWord;
  LLabel          : TLabel;
  LGauge          : TGauge;
begin
  if FGaugeList <> nil then FreeAndNil(FGaugeList);
  FGaugeList := TList<TGauge>.Create;

  //このstrQueryのクエリー文でプロパティセットのコレクションを取得
  //Nameプロパティは取得リストに指定していなくても自動的にセットに含まれる
  FstrQuery := 'Select PercentProcessorTime '
             + 'From Win32_PerfFormattedData_PerfOS_Processor';

  LEnumCollection := GetPropertyEnumCollection(FstrQuery, True);

  //プロパティセットの数だけ繰返す
  //このwhileの部分がVBのFor - Eachに相当する
  while (LEnumCollection.Next(1, LCollectionItem, LValue) = S_OK) do begin
    //コア名表示用のTLabelを生成
    LLabel := TLabel.Create(Self);
    LLabel.Parent     := Self;
    LLabel.ParentFont := True;
    LLabel.AutoSize   := False;
    LLabel.Caption    := 'Core ' + LCollectionItem.Name;
    LLabel.Top        := Button1.Height+(LLabel.Height+8) * FGaugeList.Count+20;
    LLabel.Left       := 10;
    LLabel.Width      := 80;

    //CPU使用率表示用のゲージを生成してリストに格納
    LGauge := TGauge.Create(Self);
    LGauge.Parent     := Self;
    LGauge.ParentFont := True;
    LGauge.Top        := LLabel.Top - 2;
    LGauge.Left       := 80;
    LGauge.Width      := Self.ClientWidth - LGauge.Left - 10;
    LGauge.Height     := LLabel.Height + 4;
    LGauge.ForeColor  := clGreen;
    LGauge.Anchors    := [akRight, akTop];
    FGaugeList.Add(LGauge);
  end;

  //フォームのサイズ(高さ)を調整
  if FGaugeList.Count > 0 then begin
    Self.ClientHeight := FGaugeList[FGaugeList.Count - 1].Top
                       + FGaugeList[FGaugeList.Count - 1].Height
                       + FGaugeList[0].Top
                       - Button1.Height;
  end;
end;

//=============================================================================
//  ゲージコンポーネントのリストを破棄
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FGaugeList <> nil then FreeAndNil(FGaugeList);
end;

//=============================================================================
//  プロセッサ(CPU)の情報取得開始
//  タイマーイベントを有効にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled  := True;
  Timer1.Interval := 1000;
end;

//=============================================================================
//  TTimerのOnTimerイベント
//  再度クエリーを実行して情報を収集
//  このサンプルコードではstrQueryはグローバル変数としている
//=============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
var
  LEnumCollection : IEnumVariant;
  LCollectionItem : OleVariant;
  LValue          : LongWord;
  LCount          : Integer;
begin
  //クエリーを実行してプロパティセットのコレクションを取得
  //引数のFalseはWbemのオブジェクトの生成省略フラグ
  LEnumCollection := GetPropertyEnumCollection(FstrQuery, False);

  //プロパティセットの数だけ繰返す
  LCount := 0;
  while (LEnumCollection.Next(1, LCollectionItem, LValue) = S_OK) do begin
    FGaugeList[LCount].Progress := LCollectionItem.PercentProcessorTime;
    inc(LCount);
  end;
end;

//-----------------------------------------------------------------------------
//  Wbemのオブジェクトを生成して指定引数で接続してクエリーを実行
//  プロパティセットのコレクションを取得して返す関数
//  クエリー文は引数のstrQueryで指定する
//
//  このサンプルコードでは ServiceとstrQueryをグローバル変数にしている
//-----------------------------------------------------------------------------
function TForm1.GetPropertyEnumCollection(FstrQuery: String;
  ConnectFlag: Boolean): IEnumVariant;
var
  LstrSever       : String;
  LstrNameSpace   : String;
  LstrUser        : String;
  LstrPassword    : String;
  LstrLocale      : String;
  LstrAuthority   : String;
  LiSecurityFlags : Integer;
  LLocator        : SWbemLocator;
  LPropObjectSet  : SWbemObjectSet;
begin
  Result := nil;

  try
    if ConnectFlag then begin
      LstrSever     := '.';           //PC名．ローカルPCの場合は'.'
      LstrNameSpace := '\root\cimv2'; //名前空間．空文字でも可
      LstrUser      := '';            //管理権限者名．ローカルPCの場合は要空文字
      LstrPassword  := '';            //パスワード．ローカルPCの場合は要空文字
      LstrLocale    := '';            //実行地域コード(米ならMS_409)．空白は現地域
      LstrAuthority := '';            //ドメイン名'ntlmdomain:DOMAIN'のように指定
                                      //ドメイン無しかローカルPCの場合は要空文字
      LiSecurityFlags := 0;           //常に0

      //Wbemのオブジェクトを生成して指定引数で接続
      LLocator := CoSWbemLocator.Create;

      FService := LLocator.ConnectServer(LstrSever,
                                         LstrNameSpace,
                                         LstrUser,
                                         LstrPassword,
                                         LstrLocale,
                                         LstrAuthority,
                                         LiSecurityFlags,
                                         nil);
    end;

    //プロパティのセットのオブジェクトを取得
    LPropObjectSet := FService.ExecQuery(FstrQuery,
                                       'WQL',
                                       wbemFlagReturnImmediately,
                                       nil);

    //プロパティのセットのコレクションを列挙
    Result := LPropObjectSet._NewEnum as IEnumVariant;
  except
    on ex: Exception do
      ShowMessage(ex.Message);
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Generics.Collections, Gauges;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FGaugeList     : TList<TGauge>;
    FOldIdleTime   : array of Int64;
    FOldKernelTime : array of Int64;
    FOldSystemTime : array of Int64;
    procedure GetCPUTimeAndDisplayCPUUsageRate(StartFlag: Boolean);
    procedure DisplayCPUUsageRate(CpuNo: Integer; IdleTime: Int64;
      KernelTime: Int64; SystemTime: Int64);
  public
  end;

var
  Form1: TForm1;

implementation

uses
  JwaWindows;

{$R *.dfm}

//=============================================================================
//  フォーム作成時
//  表示用のコントロール等を作成．他の初期化
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LSysInfo  : TSystemInfo;
  LCpuCount : Integer;
  LLabel    : TLabel;
  LGauge    : TGauge;
  i         : Integer;
begin
  Timer1.Enabled := False;

  //CPUの数(コア数)を取得
  GetSystemInfo(LSysInfo);
  LCpuCount := LSysInfo.dwNumberOfProcessors;
  if LCpuCount = 0 then exit;

  //CPU使用率表示用のゲージのリストを生成
  if FGaugeList <> nil then FreeAndNil(FGaugeList);
  FGaugeList := TList<TGauge>.Create;


  //CPUの数+1(+1は全体の使用率表示用)だけ繰返す
  for i:= 0 to LCpuCount do begin
    //表示用のTLabelを生成
    LLabel := TLabel.Create(Self);
    LLabel.Parent     := Self;
    LLabel.ParentFont := True;
    LLabel.AutoSize   := False;
    if i = LCpuCount then begin
      LLabel.Caption := 'Core Total';
    end else begin
      LLabel.Caption := 'Core ' + IntToStr(i);
    end;
    LLabel.Top        := Button1.Height + (LLabel.Height + 8) * FGaugeList.Count + 20;
    LLabel.Left       := 10;
    LLabel.Width      := 80;

    //使用率表示用のゲージを生成してリストに格納
    LGauge := TGauge.Create(Self);
    LGauge.Parent     := Self;
    LGauge.ParentFont := True;
    LGauge.Top        := LLabel.Top - 2;
    LGauge.Left       := 80;
    LGauge.Width      := Self.ClientWidth - LGauge.Left - 10;
    LGauge.Height     := LLabel.Height + 4;
    LGauge.ForeColor  := clGreen;
    LGauge.Anchors    := [akRight, akTop];
    FGaugeList.Add(LGauge);
  end;

  //フォームのサイズ(高さ)を調整
  if FGaugeList.Count > 0 then begin
    Self.ClientHeight := FGaugeList[FGaugeList.Count - 2].Top +
                         FGaugeList[FGaugeList.Count - 2].Height +
                         FGaugeList[0].Top;

  end;

  //アイドル時間，カーネル時間，経過(システム)時間の前の値を保存しておく配列
  //のサイズを設定．LCpuCountはCPUのコア数
  SetLength(FOldIdleTime,   LCpuCount);
  SetLength(FOldKernelTime, LCpuCount);
  SetLength(FOldSystemTime, LCpuCount);
end;

//=============================================================================
//  終了処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FGaugeList <> nil then FreeAndNil(FGaugeList);
end;

//=============================================================================
//  [開始]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //最初に現在のカーネル時間等を保存するために実行
  //この後，Timerコンポで指定する時間ごとに取得してCPU使用率を計算
  GetCPUTimeAndDisplayCPUUsageRate(True);
  Timer1.Interval := 1000;
  Timer1.Enabled  := True;
end;

//-----------------------------------------------------------------------------
//  CPUの情報を取得して表示
//  Timerコンボのイベントで呼出して実行
//
//  この関数を最初に実行する時はStartFlagをTrueにしてCPU時間関係の値を記録
//-----------------------------------------------------------------------------
procedure TForm1.GetCPUTimeAndDisplayCPUUsageRate(StartFlag: Boolean);
var
  LSysInfo          : TSystemInfo;
  LpBuffer          : array of TSystemProcessorPerformanceInformation;
  LInfo             : PSystemProcessorPerformanceInformation;
  LCpuCount         : Integer;
  LStatus           : NTSTATUS;
  LdIdleTime        : Int64;
  LdKernelTime      : Int64;
  LdSystemTime      : Int64;
  LiIdleTime        : Int64;
  LiKernelTime      : Int64;
  LiSystemTime      : Int64;
  LTotalIdleTime    : Int64;
  LTotalKernelTime  : Int64;
  LTotalSystemTime  : Int64;
  i                 : Integer;
begin
  //CPUの数(コア数)を取得
  GetSystemInfo(LSysInfo);
  LCpuCount := LSysInfo.dwNumberOfProcessors;
  if LCpuCount = 0 then exit;

  //SYSTEM_PROCESSOR_PERFORMANCE_INFORMATION構造体の情報格納用の配列のサイズ決定
  //CPUのコア数分だけこの構造体の格納サイズが必要
  //(LCpuCountはCPUのコア数)
  SetLength(LpBuffer, LCpuCount);
  //SystemProcessorTimes(SDKのSystemProcessorPerformanceInformation=8)を指定
  LStatus := NtQuerySystemInformation(SystemProcessorTimes,
                                      LpBuffer,
                                      SizeOf(LpBuffer[0]) * LCpuCount,
                                      nil);
  if LStatus = 0 then begin

    //CPU全体の使用率取得計算用の値を初期化
    LTotalIdleTime    := 0;
    LTotalKernelTime  := 0;
    LTotalSystemTime  := 0;

    //CPU(コア)数分だけ繰り返す
    for i := 0 to LCpuCount - 1 do begin
      LInfo := @LpBuffer[i];

      //現在のアイドル時間，カーネル時間，システム時間を取得
      //この値は積算値(100ns単位)
      LiIdleTime   := LInfo.IdleTime.QuadPart;
      LiKernelTime := LInfo.KernelTime.QuadPart;
      LiSystemTime := LInfo.KernelTime.QuadPart + LInfo.UserTime.QuadPart;

      //初回はCPU使用率は計算しないで現在の値を記録
      //次回からはStartFlag=Trueとなってこのif文を実行する
      if StartFlag = False then begin
        LdIdleTime   := LiIdleTime   - FOldIdleTime[i];
        LdKernelTime := LiKernelTime - FOldKernelTime[i];
        LdSystemTime := LiSystemTime - FOldSystemTime[i];

        //取得した値でCPU使用率を表示するメソッド
        DisplayCPUUsageRate(i, LdIdleTime, LdKernelTime, LdSystemTime);

        //CPU全体の使用率計算のためにループ内で加算
        LTotalIdleTime    := LTotalIdleTime   + LdIdleTime;
        LTotalKernelTime  := LTotalKernelTime + LdKernelTime;
        LTotalSystemTime  := LTotalSystemTime + LdSystemTime;
      end;

      //今取得した値を前の値として保存
      FOldIdleTime[i]   := LiIdleTime;
      FOldKernelTime[i] := LiKernelTime;
      FOldSystemTime[i] := LiSystemTime;
    end;

    //CPU全体の使用率取得計算用の値で計算して表示
    if StartFlag = False then begin
      DisplayCPUUsageRate(LCpuCount,
                          LTotalIdleTime,
                          LTotalKernelTime,
                          LTotalSystemTime);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  CPU使用率を計算してゲージに表示する
//  このサンプルプログラムではTimer1.Interval := 1000なので，SystemTimeの値は
//  1秒(実際の値は10000000)．CpuNoがCPU(コア)数を超えた場合を除く)
//-----------------------------------------------------------------------------
procedure TForm1.DisplayCPUUsageRate(CpuNo: Integer; IdleTime, KernelTime,
  SystemTime: Int64);
var
  LCpuRate : Integer;
begin
  LCpuRate := Round((KernelTime - IdleTime) / SystemTime * 100);
  TGauge(FGaugeList[CpuNo]).Progress := LCpuRate;
end;

//=============================================================================
//  TTimerのOnTimerイベント
//=============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  GetCPUTimeAndDisplayCPUUsageRate(False);
end;

end.