获取总CPU使用的百分比

Question

我正在尝试将总CPU的百分比用于 label1.caption

我已经搜索并发现这些：

• 不起作用 - http://www.vbforums.com/showthread.php?345723-delphi-delphi-get-get-cpu-usage

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

  • 还发现了有关计算每个过程使用的解决方案 像这个小部件一样：

  这是我正在努力的：

我相信有一种简单的方式，例如我们获得RAM使用时。

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

Answer 1

我找到了一篇文章，确定有关如何获取当前过程的CPU使用情况的cpu-usage-process-corcess-c-and-c 。

现在，我们需要做更多的事情来计算每个运行过程的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 清理缓存，该缓存保留了以前所需的CPU使用时间 getProcesscpuusagepct ：自上次查询以来已停止的每个过程都从此缓存中删除。

getProcesscpuusagepct 是核心-c-and-c/“ rel =“ noreferrer”>确定cpu-usage of-rurrent-process-c-and-c and-c 。此功能需要从CPU用法中检索先前的读数CACHE 最新的Processcpuusagecache （单元中的全局）使用ProcessID。
请注意，不建议拨打 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.

​

​

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。

只有用户组中的计算机管理员或性能日志中的用户可以记录和查看计数器数据。管理员组中的用户只能在使用以运行为管理员的命令提示符窗口启动并查看计数器数据时记录和查看计数器数据。性能监视用户组可以查看计数器数据。

---

我发现 /a> - 参见 cpu当前使用 - 来自 lanzelot> lanzelot 在这里用户对Delphi进行了一些移植。

RAW PORTING ：

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;

示例需要 pdh 我从

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

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有单位。

---

注意
我已经使用了函数而不是 pdhaddenglishcounter 因为单元中缺少函数参考。不幸的是，在添加了引用后，我旧的Windows XP上的 pdh.dll 中仍缺少该功能。

pdhaddcounter 的 是本地化的，因此我必须在Windows \ processore（_total）\％tempo processore 上使用意大利局部化路径。

如果使用 pdhaddenglishCounter 函数或您的语言环境为英语，则必须使用路径 \ processor（_total）\％处理器时间。

如果您的系统语言环境除英语或意大利语外，则必须使用 pdhbrowsecounters 函数。
以下的非常基本的功能用法需要以获取进一步的参考。

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

我发现 thi 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.

对我有用