delphi – 获取总CPU使用率的百分比

发布时间：2020-12-15 10:11:45 所属栏目：大数据来源：网络整理

导读：我试图将总CPU使用率的百分比变为label1.Caption 我搜索并找到了这些：没用 – http://www.vbforums.com/showthread.php?345723-DELPHI-Get-CPU-Usage 不是我需要的 – http://delphi.cjcsoft.net/viewthread.php?tid=42837 还发现了一堆关于计算每个进程的

我试图将总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(单元中的全局)检索先前的读取.
注意,建议不要每隔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.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.

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!