获取总 CPU 使用量的百分比
Get the Percentage of Total CPU Usage
我正在尝试将 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]);
我找到了一篇文章，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（单元中的全局）检索先前的读数。
注意，不建议调用 GetToalCpuUsageCpu 少于每 200 毫秒，因为它可能会给出错误的结果。
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.
测试代码：
单位 Unit1;
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.
您可以使用 Microsoft 的 Performance Counters Functions 来实现您的目标。
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.
我在 SO 上找到了 this answer - see CPU currently used - from the Lanzelot 用户，我已经完成了一些移植到 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 class.
这允许根据传递给构造函数中的 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 function instead of the 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;
我找到了 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.
对我有用
http://www.magsys.co.uk/delphi/
获取 MagWMI 组件。免费。
此组件将允许您非常轻松地访问已经具有您需要的信息的 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;
我是这样解决的：
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
中获取任何参数值
我正在尝试将 CPU 总使用量的百分比设为 label1.Caption
我搜索并找到了这些：
没用 - http://www.vbforums.com/showthread.php?345723-DELPHI-Get-CPU-Usage
不是我需要的 - http://delphi.cjcsoft.net/viewthread.php?tid=42837
- 还找到了一堆关于计算每个进程的使用量的解决方案，但这不是我要找的，我只想要总的 CPU 使用量
喜欢这个小部件：
这就是我正在做的事情:
- 还找到了一堆关于计算每个进程的使用量的解决方案，但这不是我要找的，我只想要总的 CPU 使用量
喜欢这个小部件：
我相信有一种简单的方法，比如我们获取 RAM 使用情况。
GlobalMemoryStatus(RamStats);
Label1.Caption := Format('RAM: %d %%', [RamStats.dwMemoryLoad]);
我找到了一篇文章，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（单元中的全局）检索先前的读数。
注意，不建议调用 GetToalCpuUsageCpu 少于每 200 毫秒，因为它可能会给出错误的结果。
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.
测试代码：
单位 Unit1;
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.
您可以使用 Microsoft 的 Performance Counters Functions 来实现您的目标。
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.
我在 SO 上找到了 this answer - see CPU currently used - from the Lanzelot 用户，我已经完成了一些移植到 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 class.
这允许根据传递给构造函数中的 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 function instead of the 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;
我找到了 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.
对我有用
http://www.magsys.co.uk/delphi/
获取 MagWMI 组件。免费。
此组件将允许您非常轻松地访问已经具有您需要的信息的 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;
我是这样解决的：
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
中获取任何参数值