获取总 CPU 使用率的百分比

Question

我正在尝试将总 CPU 使用率的百分比设置为 label1.Caption

我已经搜索并找到了这些：

• 没用 - http://www.vbforums.com/showthread.php?345723-DELPHI-Get-CPU-Usage

• 不是我需要的 - http://delphi.cjcsoft.net/viewthread.php?tid=42837

  • 还找到了一些关于计算每个进程的使用率的解决方案，但这不是我想要的，我只想要总 CPU 使用率 喜欢这个小部件：

  这就是我正在做的事情：

我相信有一种简单的方法，比如我们获取 RAM 使用情况。

 GlobalMemoryStatus(RamStats);
 Label1.Caption := Format('RAM: %d %%', [RamStats.dwMemoryLoad]);

Answer 1

我找到了一篇文章determine-cpu-usage-of-current-process-c-and-c，关于如何获取当前进程的CPU使用率。

现在我们需要做更多的事情来计算总 CPU 使用百分比，方法是将每个正在运行的进程的 CPU 使用百分比相加：

function GetTotalCpuUsagePct(): Double;
var
  ProcessID: TProcessID;
  RunningProcessIDs : TArray<TProcessID>;
begin
  Result := 0.0;
  RunningProcessIDs := GetRunningProcessIDs;

  DeleteNonExistingProcessIDsFromCache(RunningProcessIDs);

  for ProcessID in RunningProcessIDs do
    Result := Result + GetProcessCpuUsagePct( ProcessID );

end;

获得运行进程ID后，我们开始调用 DeleteNonExistingProcessIDsFromCache 清理缓存，它保存了GetProcessCpuUsagePct 中所需的先前 Cpu 使用时间：自上次查询以来已停止的每个进程都将从该缓存中删除。

GetProcessCpuUsagePct是核心，是determine-cpu-usage-of-current-process-c-and-c的翻译。此函数需要使用 ProcessID 从 Cpu Usage Cache LatestProcessCpuUsageCache（单元中的全局）中检索先前的读数。 注意，不建议每 200 毫秒调用一次GetToalCpuUsageCpu，因为这可能会给出错误的结果。

function GetProcessCpuUsagePct(ProcessID: TProcessID): Double;
  function SubtractFileTime(FileTime1: TFileTIme; FileTime2: TFileTIme): TFileTIme;
  begin
    Result := TFileTIme(Int64(FileTime1) - Int64(FileTime2));
  end;

var
  ProcessCpuUsage: TProcessCpuUsage;
  ProcessHandle: THandle;
  SystemTimes: TSystemTimesRec;
  SystemDiffTimes: TSystemTimesRec;
  ProcessDiffTimes: TProcessTimesRec;
  ProcessTimes: TProcessTimesRec;

  SystemTimesIdleTime: TFileTime;
  ProcessTimesCreationTime: TFileTime;
  ProcessTimesExitTime: TFileTime;
begin
  Result := 0.0;

  LatestProcessCpuUsageCache.TryGetValue(ProcessID, ProcessCpuUsage);
  if ProcessCpuUsage = nil then
  begin
    ProcessCpuUsage := TProcessCpuUsage.Create;
    LatestProcessCpuUsageCache.Add(ProcessID, ProcessCpuUsage);
  end;
  // method from:
  // http://www.philosophicalgeek.com/2009/01/03/determine-cpu-usage-of-current-process-c-and-c/
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
  if ProcessHandle <> 0 then
  begin
    try
      if GetSystemTimes(SystemTimesIdleTime, SystemTimes.KernelTime, SystemTimes.UserTime) then
      begin
        SystemDiffTimes.KernelTime := SubtractFileTime(SystemTimes.KernelTime, ProcessCpuUsage.LastSystemTimes.KernelTime);
        SystemDiffTimes.UserTime := SubtractFileTime(SystemTimes.UserTime, ProcessCpuUsage.LastSystemTimes.UserTime);
        ProcessCpuUsage.LastSystemTimes := SystemTimes;
        if GetProcessTimes(ProcessHandle, ProcessTimesCreationTime, ProcessTimesExitTime, ProcessTimes.KernelTime, ProcessTimes.UserTime) then
        begin
          ProcessDiffTimes.KernelTime := SubtractFileTime(ProcessTimes.KernelTime, ProcessCpuUsage.LastProcessTimes.KernelTime);
          ProcessDiffTimes.UserTime := SubtractFileTime(ProcessTimes.UserTime, ProcessCpuUsage.LastProcessTimes.UserTime);
          ProcessCpuUsage.LastProcessTimes := ProcessTimes;
          if (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) > 0 then
            Result := (Int64(ProcessDiffTimes.KernelTime) + Int64(ProcessDiffTimes.UserTime)) / (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) * 100;
        end;
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end;
end;

这是 Windows 7 上结果的屏幕截图。

单位完整列表：

unit uTotalCpuUsagePct;

interface

  function GetTotalCpuUsagePct : Double;

implementation

uses
  SysUtils, DateUtils, Windows, PsAPI, TlHelp32, ShellAPI, Generics.Collections;

type
  TProcessID = DWORD;

  TSystemTimesRec = record
    KernelTime: TFileTIme;
    UserTime: TFileTIme;
  end;

  TProcessTimesRec = record
    KernelTime: TFileTIme;
    UserTime: TFileTIme;
  end;

  TProcessCpuUsage = class
    LastSystemTimes: TSystemTimesRec;
    LastProcessTimes: TProcessTimesRec;
    ProcessCPUusagePercentage: Double;
  end;

  TProcessCpuUsageList = TObjectDictionary<TProcessID, TProcessCpuUsage>;

var
  LatestProcessCpuUsageCache : TProcessCpuUsageList;
  LastQueryTime : TDateTime;

(* -------------------------------------------------------------------------- *)

function GetRunningProcessIDs: TArray<TProcessID>;
var
  SnapProcHandle: THandle;
  ProcEntry: TProcessEntry32;
  NextProc: Boolean;
begin
  SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if SnapProcHandle <> INVALID_HANDLE_VALUE then
  begin
    try
      ProcEntry.dwSize := SizeOf(ProcEntry);
      NextProc := Process32First(SnapProcHandle, ProcEntry);
      while NextProc do
      begin
        SetLength(Result, Length(Result) + 1);
        Result[Length(Result) - 1] := ProcEntry.th32ProcessID;
        NextProc := Process32Next(SnapProcHandle, ProcEntry);
      end;
    finally
      CloseHandle(SnapProcHandle);
    end;
    TArray.Sort<TProcessID>(Result);
  end;
end;

(* -------------------------------------------------------------------------- *)

function GetProcessCpuUsagePct(ProcessID: TProcessID): Double;
  function SubtractFileTime(FileTime1: TFileTIme; FileTime2: TFileTIme): TFileTIme;
  begin
    Result := TFileTIme(Int64(FileTime1) - Int64(FileTime2));
  end;

var
  ProcessCpuUsage: TProcessCpuUsage;
  ProcessHandle: THandle;
  SystemTimes: TSystemTimesRec;
  SystemDiffTimes: TSystemTimesRec;
  ProcessDiffTimes: TProcessTimesRec;
  ProcessTimes: TProcessTimesRec;

  SystemTimesIdleTime: TFileTime;
  ProcessTimesCreationTime: TFileTime;
  ProcessTimesExitTime: TFileTime;
begin
  Result := 0.0;

  LatestProcessCpuUsageCache.TryGetValue(ProcessID, ProcessCpuUsage);
  if ProcessCpuUsage = nil then
  begin
    ProcessCpuUsage := TProcessCpuUsage.Create;
    LatestProcessCpuUsageCache.Add(ProcessID, ProcessCpuUsage);
  end;
  // method from:
  // http://www.philosophicalgeek.com/2009/01/03/determine-cpu-usage-of-current-process-c-and-c/
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
  if ProcessHandle <> 0 then
  begin
    try
      if GetSystemTimes(SystemTimesIdleTime, SystemTimes.KernelTime, SystemTimes.UserTime) then
      begin
        SystemDiffTimes.KernelTime := SubtractFileTime(SystemTimes.KernelTime, ProcessCpuUsage.LastSystemTimes.KernelTime);
        SystemDiffTimes.UserTime := SubtractFileTime(SystemTimes.UserTime, ProcessCpuUsage.LastSystemTimes.UserTime);
        ProcessCpuUsage.LastSystemTimes := SystemTimes;
        if GetProcessTimes(ProcessHandle, ProcessTimesCreationTime, ProcessTimesExitTime, ProcessTimes.KernelTime, ProcessTimes.UserTime) then
        begin
          ProcessDiffTimes.KernelTime := SubtractFileTime(ProcessTimes.KernelTime, ProcessCpuUsage.LastProcessTimes.KernelTime);
          ProcessDiffTimes.UserTime := SubtractFileTime(ProcessTimes.UserTime, ProcessCpuUsage.LastProcessTimes.UserTime);
          ProcessCpuUsage.LastProcessTimes := ProcessTimes;
          if (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) > 0 then
            Result := (Int64(ProcessDiffTimes.KernelTime) + Int64(ProcessDiffTimes.UserTime)) / (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) * 100;
        end;
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end;
end;

(* -------------------------------------------------------------------------- *)

procedure DeleteNonExistingProcessIDsFromCache(const RunningProcessIDs : TArray<TProcessID>);
var
  FoundKeyIdx: Integer;
  Keys: TArray<TProcessID>;
  n: Integer;
begin
  Keys := LatestProcessCpuUsageCache.Keys.ToArray;
  for n := Low(Keys) to High(Keys) do
  begin
    if not TArray.BinarySearch<TProcessID>(RunningProcessIDs, Keys[n], FoundKeyIdx) then
      LatestProcessCpuUsageCache.Remove(Keys[n]);
  end;
end;

(* -------------------------------------------------------------------------- *)

function GetTotalCpuUsagePct(): Double;
var
  ProcessID: TProcessID;
  RunningProcessIDs : TArray<TProcessID>;
begin
  Result := 0.0;
  RunningProcessIDs := GetRunningProcessIDs;

  DeleteNonExistingProcessIDsFromCache(RunningProcessIDs);

  for ProcessID in RunningProcessIDs do
    Result := Result + GetProcessCpuUsagePct( ProcessID );

end;

(* -------------------------------------------------------------------------- *)

initialization
  LatestProcessCpuUsageCache := TProcessCpuUsageList.Create( [ doOwnsValues ] );
  // init:
  GetTotalCpuUsagePct;
finalization
  LatestProcessCpuUsageCache.Free;
end.

测试代码：

单元单元1；

interface

uses
  Vcl.Forms, System.SysUtils, Vcl.Controls, Vcl.StdCtrls, System.Classes,
  Vcl.ExtCtrls,

  uTotalCpuUsagePct;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // start cpu load thread
  TThread.CreateAnonymousThread(
    procedure
    begin
      while True do
      begin
      end;
    end).Start;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  TotalCPUusagePercentage: Double;
begin
  TotalCPUusagePercentage := GetTotalCpuUsagePct();
  Label1.Caption := 'Total cpu: ' + IntToStr(Round(TotalCPUusagePercentage)) + '%';
end;

end.

Answer 2

您可以使用 Microsoft 的 Performance Counters Functions 来实现您的目标。

Limited User Access Support

只有计算机管理员或性能日志用户组中的用户才能记录和查看计数器数据。只有当他们用于记录和查看计数器数据的工具是从以管理员身份运行...打开的命令提示符窗口启动时，管理员组中的用户才能记录和查看计数器数据。性能监控用户组可以查看计数器数据。

---

我找到了this answer - 查看当前使用的CPU - 来自Lanzelot 用户这里的 SO，我已经完成了一些到 Delphi 的移植。

原始移植：

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;

该示例需要我从here 获取的pdh 单元。
pdh 需要 WinPerf 单元，我已经从 here 下载了它。

控制台应用程序中的基本测试：

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.

---

基于TThread 类的更有用的示例。
这允许根据传递给构造函数中的ACounterPath 参数的参数获取不同的计数器。

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

---

题外话 我现在在家，我这里没有 Delphi XE，所以我用 Turbo Delphi 对其进行了编码，我的机器上没有安装pdh 单元，目前我不知道 Delphi XE 是否有这些单元。

---

注意 我使用了PdhAddCounter 函数而不是PdhAddEnglishCounter，因为单元中缺少函数引用。不幸的是，在我添加引用后，我的旧 Windows XP 上的 Pdh.dll 中仍然缺少该函数。

PdhAddCounter 的 szFullCounterPath 已本地化，因此我必须在我的 Windows \Processore(_Total)\% Tempo Processore 上使用意大利语本地化路径。

如果你使用PdhAddEnglishCounter函数或者你的语言环境是英文，你必须使用路径\Processor(_Total)\% Processor Time。

如果您的系统区域设置不是英语或意大利语，您必须使用PdhBrowseCounters 函数自行查找路径。
以下非常基本的功能使用需要PdhMsg单元。
另请参阅 MSDN Browsing Performance Counters 以获取更多参考。

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;

Answer 3

http://www.magsys.co.uk/delphi/

获取 MagWMI 组件。它是免费的。

此组件将允许您非常轻松地访问 WMI，该 WMI 已经包含您想要的信息。我刚刚测试了一个在 Win 10 上使用过的旧程序，它正确地找到了我的所有 8 个内核和处理器的使用情况。

然后做这样的事情：

 var
   compname:string;
   WmiResults: T2DimStrArray ;
   instances, i : Integer
 Begin
    compname:=getcompname;  // a function in the MagWMI to get the computer name.
    MagWmiGetInfoEx (compname, '', '',
                       '', 'SELECT percentidletime FROM Win32_PerfFormattedData_PerfOS_Processor', WmiResults, instances, errstr) ;
    for i := 1 to instances do
    begin
         // wmiresults[i,2] will hold the percentage for each processor found.
    end;

Answer 4

我是这样解决的：

function TCPU.get_param_value(param_name: String): String;
var
  command,
  file_out: String;
  data_file: TStringList;

begin
  data_file := TStringList.Create;
  try
    try
      file_out := TPath.GetTempPath + FormatDateTime('yyyymmddhhnnss', Now) + '_CPUInfo.txt';
      comando := '"wmic cpu get '+param_name+' /value | find "'+param_name+'" > ' +
                  file_out + '&&exit"';

      // "runas" for admin privileges, or "open" to any user
      ShellExecute(0, 'open', 'cmd.exe', PChar('/k ' + command), nil, SW_HIDE);

      // Wait 4 sec to cmd release the process...
      Sleep(4000);

      data_file.LoadFromFile(file_out);
      Result := data_file.Values[param_name];

    except
      Result := '';
    end;

  finally
    TFile.Delete(file_out);
    data_file.Free;
  end;

这样就可以从wmic

获取任意参数值

Answer 5

我找到t h i s

完成任务

uses adCpuUsage;

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
u:string;
begin
  collectcpudata;
   for i:=0 to GetCPUCount-1 do

 u:=FloatToStr(Round(getcpuusage(i)*100));   //Round to approximate 1.0003 to 1

label1.Caption:=u
end;

end.

为我工作