const <br> SystemBasicInformation = 0; <br> SystemPerformanceInformation = 2; <br> SystemTimeInformation = 3; <br><br>type <br> TPDWord = ^DWORD; <br><br> TSystem_Basic_Information = packed record <br> dwUnknown1: DWORD; <br> uKeMaximumIncrement: ULONG; <br> uPageSize: ULONG; <br> uMmNumberOfPhysicalPages: ULONG; <br> uMmLowestPhysicalPage: ULONG; <br> uMmHighestPhysicalPage: ULONG; <br> uAllocationGranularity: ULONG; <br> pLowestUserAddress: Pointer; <br> pMmHighestUserAddress: Pointer; <br> uKeActiveProcessors: ULONG; <br> bKeNumberProcessors: byte; <br> bUnknown2: byte; <br> wUnknown3: word; <br> end; <br><br>type <br> TSystem_Performance_Information = packed record <br> liIdleTime: LARGE_INTEGER; {LARGE_INTEGER} <br> dwSpare: array[0..75] of DWORD; <br> end; <br><br>type <br> TSystem_Time_Information = packed record <br> liKeBootTime: LARGE_INTEGER; <br> liKeSystemTime: LARGE_INTEGER; <br> liExpTimeZoneBias: LARGE_INTEGER; <br> uCurrentTimeZoneId: ULONG; <br> dwReserved: DWORD; <br> end; <br><br>var <br> NtQuerySystemInformation: function(infoClass: DWORD; <br> buffer: Pointer; <br> bufSize: DWORD; <br> returnSize: TPDword): DWORD; stdcall = nil; <br><br><br> liOldIdleTime: LARGE_INTEGER = (); <br> liOldSystemTime: LARGE_INTEGER = (); <br><br>function Li2Double(x: LARGE_INTEGER): Double; <br>begin <br> Result := x.HighPart * 4.294967296E9 + x.LowPart <br>end; <br><br>procedure GetCPUUsage; <br>var <br> SysBaseInfo: TSystem_Basic_Information; <br> SysPerfInfo: TSystem_Performance_Information; <br> SysTimeInfo: TSystem_Time_Information; <br> status: Longint; {long} <br> dbSystemTime: Double; <br> dbIdleTime: Double; <br><br> bLoopAborted : boolean; <br><br>begin <br> if @NtQuerySystemInformation = nil then <br> NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'), <br> 'NtQuerySystemInformation'); <br><br> // get number of processors in the system <br><br> status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil); <br> if status <> 0 then Exit; <br><br> // Show some information <br> with SysBaseInfo do <br> begin <br> ShowMessage( <br> Format('uKeMaximumIncrement: %d'#13'uPageSize: %d'#13+ <br> 'uMmNumberOfPhysicalPages: %d'+#13+'uMmLowestPhysicalPage: %d'+#13+ <br> 'uMmHighestPhysicalPage: %d'+#13+'uAllocationGranularity: %d'#13+ <br> 'uKeActiveProcessors: %d'#13'bKeNumberProcessors: %d', <br> [uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages, <br> uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity, <br> uKeActiveProcessors, bKeNumberProcessors])); <br> end; <br><br><br> bLoopAborted := False; <br><br> while not bLoopAborted do <br> begin <br><br> // get new system time <br> status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0); <br> if status <> 0 then Exit; <br><br> // get new CPU's idle time <br> status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil); <br> if status <> 0 then Exit; <br><br> // if it's a first call - skip it <br> if (liOldIdleTime.QuadPart <> 0) then <br> begin <br><br> // CurrentValue = NewValue - OldValue <br> dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime); <br> dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime); <br><br> // CurrentCpuIdle = IdleTime / SystemTime <br> dbIdleTime := dbIdleTime / dbSystemTime; <br><br> // CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors <br> dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5; <br><br> // Show Percentage <br> Form1.Label1.Caption := FormatFloat('CPU Usage: 0.0 %',dbIdleTime); <br><br> Application.ProcessMessages; <br><br> // Abort if user pressed ESC or Application is terminated <br> bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated; <br><br> end; <br><br> // store new CPU's idle and system time <br> liOldIdleTime := SysPerfInfo.liIdleTime; <br> liOldSystemTime := SysTimeInfo.liKeSystemTime; <br><br> // wait one second <br> Sleep(1000); <br> end; <br>end; <br><br><br>procedure TForm1.Button1Click(Sender: TObject); <br>begin <br> GetCPUUsage <br>end;
