Delphiを忘れない

unit ProcessCpuUsage;

interface

uses
  Windows, 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 GetProcessCpuUsageHandle( Handle : THandle ) : Double;
  function GetProcessCpuUsageProcessID( ProcessID: TProcessID ): Double;

implementation

function GetProcessCpuUsageHandle( Handle : THandle ) : Double;
var
  li_ProcID:     DWORD;
begin
  GetWindowThreadProcessId(Handle, @li_ProcID);

  result := GetProcessCpuUsageProcessID(li_ProcID);
end;

function GetProcessCpuUsageProcessID(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;

  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 begin
            Result := (Int64(ProcessDiffTimes.KernelTime) + Int64(ProcessDiffTimes.UserTime)) / (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) * 100;
          end;
        end;
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end;
end;

initialization
  LatestProcessCpuUsageCache := TProcessCpuUsageList.Create( [ doOwnsValues ] );
finalization
  LatestProcessCpuUsageCache.Free;

end.


使い方の例

uses ProcessCpuUsage;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := Format('%f', [GetProcessCpuUsageHandle(Handle)] );
end;

[0回]