Home


Delphi - CPU Auslastung ermitteln

var
  Form1: TForm1;
  nOldIdleTime: Int64 = 0;
  nOldSystemTime : INT64 = 0;
  nNewCPUTime    : ULONG = 0;

const
  SYS_BASIC_INFO            = 0;
  SYS_PERFORMANCE_INFO      = 2;
  SYS_TIME_INFO             = 3;

type
  SYSTEM_BASIC_INFORMATION = packed record
    dwUnknown1              : DWORD;
    uKeMaximumIncrement     : ULONG;
    uPageSize               : ULONG;
    uMmNumberOfPhysicalPages: ULONG;
    uMmLowestPhysicalPage   : ULONG;
    uMmHighestPhysicalPage  : ULONG;
    uAllocationGranularity  : ULONG;
    pLowestUserAddress      : POINTER;
    pMmHighestUserAddress   : POINTER;
    uKeActiveProcessors     : POINTER;
    bKeNumberProcessors     : BYTE;
    bUnknown2               : BYTE;
    wUnknown3               : WORD;
  end;

  SYSTEM_PERFORMANCE_INFORMATION = packed record
    nIdleTime               : INT64;
    dwSpare                 : array[0..75]of DWORD;
  end;

  SYSTEM_TIME_INFORMATION = packed record
    nKeBootTime             : INT64;
    nKeSystemTime           : INT64;
    nExpTimeZoneBias        : INT64;
    uCurrentTimeZoneId      : ULONG;
    dwReserved              : DWORD;
  end;

  function NTQuerySystemInformation(SystemInformationClass: Longint;
                                    SystemInformation: Pointer;
                                    SystemInformationLength: Longint;
                                    ReturnLength: Longint): Longint; stdcall;
                                    external 'ntdll.dll' name 'NtQuerySystemInformation';

implementation

{$R *.dfm}


function GetCPUUsage: Integer;
var
  spi : SYSTEM_PERFORMANCE_INFORMATION;
  sti : SYSTEM_TIME_INFORMATION;
  sbi : SYSTEM_BASIC_INFORMATION;
begin
  result := 0;
  if (NTQuerySystemInformation(SYS_BASIC_INFO, @sbi, sizeof(SYSTEM_BASIC_INFORMATION), 0) = NO_ERROR) then
  begin
    if (NTQuerySystemInformation(SYS_TIME_INFO, @sti, sizeof(SYSTEM_TIME_INFORMATION), 0) = NO_ERROR) then
    if (NTQuerySystemInformation(SYS_PERFORMANCE_INFO, @spi, sizeof(SYSTEM_PERFORMANCE_INFORMATION), 0)= NO_ERROR) then
    begin
      if (nOldIdleTime <> 0) then
      begin
        nNewCPUTime:= trunc(100-((spi.nIdleTime-nOldIdleTime)/(sti.nKeSystemTime-nOldSystemTime)*100)/sbi.bKeNumberProcessors+0.5);
        if (nNewCPUTime <> nOldIdleTime) then
        begin
          Result := nNewCPUTIME;
        end;
      end;
      nOldIdleTime   := spi.nIdleTime;
      nOldSystemTime := sti.nKeSystemTime;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := IntToStr(GetCPUUsage());
end;


2012-01-26T23:14:33 +0100