Читать из реестра HKEY_DYN_DATA\PerfStats\StatData соответствующий ключ Kernel \CPUUsage.
или
Code: |
//NT – 2000 - XP 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 = ();
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');
// get number of processors in the system
status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil); if status <> 0 then Exit;
// Show some information with SysBaseInfo do begin ShowMessage( Format('uKeMaximumIncrement: %d'#13'uPageSize: %d'#13 + 'uMmNumberOfPhysicalPages: %d' + #13 + 'uMmLowestPhysicalPage: %d' + #13 + 'uMmHighestPhysicalPage: %d' + #13 + 'uAllocationGranularity: %d'#13 + 'uKeActiveProcessors: %d'#13'bKeNumberProcessors: %d' , [uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages, uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity, uKeActiveProcessors, bKeNumberProcessors])); end;
bLoopAborted := False;
while not bLoopAborted do begin
// get new system time status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0); if status <> 0 then Exit;
// get new CPU's idle time status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil); if status <> 0 then Exit;
// if it's a first call - skip it if (liOldIdleTime.QuadPart <> 0) then begin
// CurrentValue = NewValue - OldValue dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime); dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);
// CurrentCpuIdle = IdleTime / SystemTime dbIdleTime := dbIdleTime / dbSystemTime;
// CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;
// Show Percentage Form1.Label1.Caption := FormatFloat('CPU Usage: 0.0 %', dbIdleTime);
Application.ProcessMessages;
// Abort if user pressed ESC or Application is terminated bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated;
end;
// store new CPU's idle and system time liOldIdleTime := SysPerfInfo.liIdleTime; liOldSystemTime := SysTimeInfo.liKeSystemTime;
// wait one second Sleep(1000); end; end;
procedure TForm1.Button1Click(Sender: TObject); begin GetCPUUsage end; |
Code: |
{ **** UBPFD *************** >> Показывает загруженость процессора
Показывает загруженость процессора
Зависимости: registry,Windows, SysUtils, Forms,Gauges, Classes, Controls, ExtCtrls, StdCtrls; Автор: DDA, Vologda Copyright: Где-то найдено ***************************************************** }
unit Unit1;
interface
uses registry, Windows, SysUtils, Forms, Gauges, Classes, Controls, ExtCtrls, StdCtrls;
type TForm1 = class(TForm) Gauge1: TGauge; Timer1: TTimer; Button1: TButton; procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject); var def: string; reg: TRegistry; Buffer: array[0..1000] of integer; begin //------------------------------- reg := TRegistry.Create; reg.RootKey := HKEY_DYN_DATA; def := ''; if reg.OpenKey('PerfStats\StartStat', false) = TRUE then begin reg.ReadBinaryData('KERNEL\CPUusage', buffer, 1000); end; reg.CloseKey; Timer1.Enabled := true;
end; //-------------------------------
procedure TForm1.Timer1Timer(Sender: TObject); var def: string; reg: TRegistry; B: array[1..4] of integer; begin reg := TRegistry.Create; reg.RootKey := HKEY_DYN_DATA; def := ''; if reg.OpenKey('PerfStats\StatData', false) = TRUE then begin reg.ReadBinaryData('KERNEL\CPUusage', b, 4); end;
reg.CloseKey; Gauge1.Progress := b[1]; Application.ProcessMessages;
//------------------------------- end;
end. |
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!