1. 技术文章
  2. Get the Percentage of Total CPU Usage

Get the Percentage of Total CPU Usage

由 我与影子孤独终老i 提交于 2019-12-30 04:59:11

问题


I am trying to get the % of total CPU usage to a label1.Caption

I've searched and found these:

  • didn't work - http://www.vbforums.com/showthread.php?345723-DELPHI-Get-CPU-Usage

  • not what I need - http://delphi.cjcsoft.net/viewthread.php?tid=42837

    • also found bunch of solutions regarding calculating the Usage per process but that is not what i am looking for , i just want the total CPU usage like this widget :

    this is what i am working on :

I believe there is a simple way like when we get RAM usage.

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

回答1:


I have found an article, determine-cpu-usage-of-current-process-c-and-c, about how to get the CPU usage of the current process.

Now we need to do a bit more to compute the Total CPU usage percentage by adding up CPU usage percentage for each running processes:

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;

After getting running process id's, we start out calling DeleteNonExistingProcessIDsFromCache to clean up the cache, that holds previous Cpu usage times needed in GetProcessCpuUsagePct: Every process that has been stopped since last query is removed from this cache.

The GetProcessCpuUsagePct is the core, which is a translation of determine-cpu-usage-of-current-process-c-and-c. This function needs to retrieve the previous reading from the Cpu Usage Cache LatestProcessCpuUsageCache (global in the unit) using the ProcessID. Note, it is not recommended to call GetToalCpuUsageCpu less than every 200 ms, as it may give wrong results.

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;

Here is a screen shot of the result on a Windows 7.

Full Listing of unit:

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.

Test Code:

unit 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.



回答2:


You can achieve your goal using the Performance Counters Functions from Microsoft.

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.

I have found this answer - see CPU currently used - from the Lanzelot user here on SO and I have done some porting to 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;

The example requires the pdh unit which I have grabbed from here.
The WinPerf unit is needed by the pdh and I have downloaded it from here.

Basic test in a console application:

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.

A more useful example based on the TThread class.
This allows to obtain different counters based on the parameter passed to the ACounterPath argument in the constructor.

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

OFF TOPIC I'm currently at home and I've not a Delphi XE here so I coded it with Turbo Delphi, I have no pdh unit installed on my machine and I can't know at the moment if Delphi XE has the units.

NOTICE I have used the PdhAddCounter function instead of the PdhAddEnglishCounter because the function reference is missing in the unit. Unfortunately, after I added the reference, the function was still missing in the Pdh.dll on my old Windows XP.

The szFullCounterPath of the PdhAddCounter is localized so I have to use the italian localized path on my Windows \Processore(_Total)\% Tempo Processore.

If you use the PdhAddEnglishCounter function or your locale is english, you have to use the path \Processor(_Total)\% Processor Time.

If your system locale is other than english or italian, you have to find the path by yourself using the PdhBrowseCounters function.
The very basic function usage which follows needs the PdhMsg unit.
See also MSDN Browsing Performance Counters for further reference.

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;



回答3:


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

Get the MagWMI component. It's free.

This component will allow you to access the WMI pretty easily which already has the info you want. I just tested an old program I had using this on Win 10 and it correctly found all 8 of my cores and the processor usage.

And then do something like this:

 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;



回答4:


I found t h i s

does the job

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.

worked for me



来源：https://stackoverflow.com/questions/33571061/get-the-percentage-of-total-cpu-usage

标签
Delphi
cpu
delphi-xe
performancecounter
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!