unit CPU;
interface
function CPUUssage:single;
implementation
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
const
SystemBasicInformation = 0;
SystemPerformanceInformation = 2;
SystemTimeInformation = 3;
type
TPDWord = ^DWORD;
TSystem_Basic_Information =
packed record
dwUnknown1: DWORD;
uKeMaximumIncrement: ULONG;
uPageSize: ULONG;
uMmNumberOfPhysicalPages: ULONG;
uMmLowestPhysicalPage: ULONG;
uMmHighestPhysicalPage: ULONG;
uAllocationGranularity: ULONG;
pLowestUserAddress: Pointer;
pMmHighestUserAddress: Pointer;
uKeActiveProcessors: ULONG;
bKeNumberProcessors: byte;
bUnknown2: byte;
wUnknown3: word;
end;
type
TSystem_Performance_Information =
packed record
liIdleTime: LARGE_INTEGER;
{LARGE_INTEGER}
dwSpare:
array[0..75]
of DWORD;
end;
type
TSystem_Time_Information =
packed record
liKeBootTime: LARGE_INTEGER;
liKeSystemTime: LARGE_INTEGER;
liExpTimeZoneBias: LARGE_INTEGER;
uCurrentTimeZoneId: ULONG;
dwReserved: DWORD;
end;
var
NtQuerySystemInformation:
function(infoClass: DWORD; buffer: Pointer; bufSize: DWORD; returnSize: TPDword): DWORD;
stdcall =
nil;
liOldIdleTime: LARGE_INTEGER = ();
liOldSystemTime: LARGE_INTEGER = ();
CPUTime:single;
function CPUUssage:single;
begin
result:=CPUTime;
end;
function Li2Double(x: LARGE_INTEGER): Double;
begin
Result := x.HighPart * 4.294967296E9 + x.LowPart
end;
procedure GetCPUUsage;
var
SysBaseInfo: TSystem_Basic_Information;
SysPerfInfo: TSystem_Performance_Information;
SysTimeInfo: TSystem_Time_Information;
status: Longint;
{long}
dbSystemTime: Double;
dbIdleTime: Double;
bLoopAborted : boolean;
begin
if @NtQuerySystemInformation =
nil then
NtQuerySystemInformation := GetProcAddress(GetModuleHandle('
ntdll.dll'), '
NtQuerySystemInformation');
status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo),
nil);
if status <> 0
then Exit;
bLoopAborted := False;
while not bLoopAborted
do
begin
status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0);
if status <> 0
then Exit;
status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo),
nil);
if status <> 0
then Exit;
if (liOldIdleTime.QuadPart <> 0)
then
begin
dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime);
dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);
dbIdleTime := dbIdleTime / dbSystemTime;
dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;
CPUTime:=dbIdleTime;
Application.ProcessMessages;
bLoopAborted := (GetKeyState(VK_ESCAPE)
and 128 = 128)
or Application.Terminated;
end;
liOldIdleTime := SysPerfInfo.liIdleTime;
liOldSystemTime := SysTimeInfo.liKeSystemTime;
Sleep(1000);
end;
end;
procedure Start;
var
ThreadID: DWORD;
ThreadHandle: THandle;
begin
ThreadHandle:=CreateThread(
nil, 0, TFNThreadStartRoutine(@GetCPUUsage),
nil, 0, ThreadID);
if ThreadHandle<>0
then CloseHandle(ThreadHandle);
end;
initialization
Start;
end.