Как узнать загруженность процессора?

← →
Agran (2002-07-15 13:21) [0]

Сабж.

← →
watcher (2002-07-15 14:09) [1]

ищи Perfomance Counters в MSDN

← →
Proton (2002-07-15 22:24) [2]

unit CpuUsage;

// Author: Alexey A. Dynnikov
// EMail: aldyn@chat.ru
// WebSite: http://www.aldyn.ru/
// Support: Use the e-mail aldyn@chat.ru
// or support@aldyn.ru
//
// modifyed by proton
// removed sysutils support

interface

uses
Windows;

procedure CollectCPUData;
function GetCPUCount: Integer;
function GetCPUUsage(Index: Integer): Double;
procedure ReleaseCPUData;

implementation

type
PInt64 = ^int64;

type
TPERF_DATA_BLOCK = record
Signature : array[0..4 - 1] of WCHAR;
LittleEndian : DWORD;
Version : DWORD;
Revision : DWORD;
TotalByteLength : DWORD;
HeaderLength : DWORD;
NumObjectTypes : DWORD;
DefaultObject : Longint;
SystemTime : TSystemTime;
Reserved: DWORD;
PerfTime : int64;
PerfFreq : int64;
PerfTime100nSec : int64;
SystemNameLength : DWORD;
SystemNameOffset : DWORD;
end;

PPERF_DATA_BLOCK = ^TPERF_DATA_BLOCK;

TPERF_OBJECT_TYPE = record
TotalByteLength : DWORD;
DefinitionLength : DWORD;
HeaderLength : DWORD;
ObjectNameTitleIndex : DWORD;
ObjectNameTitle : LPWSTR;
ObjectHelpTitleIndex : DWORD;
ObjectHelpTitle : LPWSTR;
DetailLevel : DWORD;
NumCounters : DWORD;
DefaultCounter : Longint;
NumInstances : Longint;
CodePage : DWORD;
PerfTime : int64;
PerfFreq : int64;
end;

PPERF_OBJECT_TYPE = ^TPERF_OBJECT_TYPE;

type
TPERF_COUNTER_DEFINITION = record
ByteLength : DWORD;
CounterNameTitleIndex : DWORD;
CounterNameTitle : LPWSTR;
CounterHelpTitleIndex : DWORD;
CounterHelpTitle : LPWSTR;
DefaultScale : Longint;
DetailLevel : DWORD;
CounterType : DWORD;
CounterSize : DWORD;
CounterOffset : DWORD;
end;

PPERF_COUNTER_DEFINITION = ^TPERF_COUNTER_DEFINITION;

TPERF_COUNTER_BLOCK = record
ByteLength : DWORD;
end;

PPERF_COUNTER_BLOCK = ^TPERF_COUNTER_BLOCK;

TPERF_INSTANCE_DEFINITION = record
ByteLength : DWORD;
ParentObjectTitleIndex : DWORD;
ParentObjectInstance : DWORD;
UniqueID : Longint;
NameOffset : DWORD;
NameLength : DWORD;
end;

PPERF_INSTANCE_DEFINITION = ^TPERF_INSTANCE_DEFINITION;

//------------------------------------------------------------------------------
{$ifdef ver130}
{$L-} // The L+ causes internal error in Delphi 5 compiler
{$O-} // The O+ causes internal error in Delphi 5 compiler
{$Y-} // The Y+ causes internal error in Delphi 5 compiler
{$endif}

{$ifndef ver110}
type
int64F = int64;
{$else}
type
int64F = Extended;
{$endif}

{$ifdef ver110}
function FInt64(Value: int64): int64F;
function Int64D(Value: DWORD): int64;
{$else}
type
FInt64 = int64F;
Int64D = int64;
{$endif}

{$ifdef ver110}
function FInt64(Value: int64): int64F;
var V: int64;
begin
if (Value.HighPart and $80000000) = 0 then // positive value
begin
result:=Value.HighPart;
result:=result*$10000*$10000;
result:=result+Value.LowPart;
end else
begin
V.HighPart:=Value.HighPart xor $FFFFFFFF;
V.LowPart:=Value.LowPart xor $FFFFFFFF;
result:= -1 - FInt64(V);
end;
end;

function Int64D(Value: DWORD): int64;
begin
result.LowPart:=Value;
result.HighPart := 0; // positive only
end;
{$endif}

//------------------------------------------------------------------------------

← →
Proton (2002-07-15 22:28) [3]

Продолжение

const
Processor_IDX_Str = "238";
Processor_IDX = 238;
CPUUsageIDX = 6;

type
AInt64F = array[0..$FFFF] of int64F;
PAInt64F = ^AInt64F;

var
_PerfData : PPERF_DATA_BLOCK;
_BufferSize: Integer;
_POT : PPERF_OBJECT_TYPE;
_PCD: PPerf_Counter_Definition;
_ProcessorsCount: Integer;
_Counters: PAInt64F;
_PrevCounters: PAInt64F;
_SysTime: int64F;
_PrevSysTime: int64F;
_IsWinNT: Boolean;

_W9xCollecting: Boolean;
_W9xCpuUsage: DWORD;
_W9xCpuKey: HKEY;

//------------------------------------------------------------------------------
function GetCPUCount: Integer;
begin
if _IsWinNT then
begin
if _ProcessorsCount < 0 then CollectCPUData;
result:=_ProcessorsCount;
end else
begin
result:=1;
end;

end;

//------------------------------------------------------------------------------
procedure ReleaseCPUData;
var H: HKEY;
R: DWORD;
dwDataSize, dwType: DWORD;
begin
if _IsWinNT then exit;
if not _W9xCollecting then exit;
_W9xCollecting:=False;

RegCloseKey(_W9xCpuKey);

R:=RegOpenKeyEx( HKEY_DYN_DATA, "PerfStats\StopStat", 0, KEY_ALL_ACCESS, H );

if R <> ERROR_SUCCESS then exit;

dwDataSize:=sizeof(DWORD);

RegQueryValueEx ( H, "KERNEL\CPUUsage", nil, @dwType, PBYTE(@_W9xCpuUsage), @dwDataSize);

RegCloseKey(H);

end;

//------------------------------------------------------------------------------
function GetCPUUsage(Index: Integer): Double;
begin
if _IsWinNT then
begin
if _ProcessorsCount < 0 then CollectCPUData;
if (Index >= _ProcessorsCount) or (Index < 0) then
MessageBox(0,"CPU index out of bounds","error",mb_IconError or mb_ok);
if _PrevSysTime = _SysTime then result:=0 else
result:=1-(_Counters[index] - _PrevCounters[index])/(_SysTime-_PrevSysTime);
end else
begin
if Index <> 0 then
MessageBox(0,"CPU index out of bounds","error",mb_IconError or mb_ok);
if not _W9xCollecting then CollectCPUData;
result:=_W9xCpuUsage / 100;
end;
end;

var VI: TOSVERSIONINFO;

//------------------------------------------------------------------------------
procedure CollectCPUData;
var BS: integer;
i: Integer;
_PCB_Instance: PPERF_COUNTER_BLOCK;
_PID_Instance: PPERF_INSTANCE_DEFINITION;
ST: TFileTime;

var H: HKEY;
R: DWORD;
dwDataSize, dwType: DWORD;
begin
if _IsWinNT then
begin
BS:=_BufferSize;
while RegQueryValueEx( HKEY_PERFORMANCE_DATA, Processor_IDX_Str, nil, nil,
PByte(_PerfData), @BS ) = ERROR_MORE_DATA do
begin
// Get a buffer that is big enough.
INC(_BufferSize,$1000);
BS:=_BufferSize;
ReallocMem( _PerfData, _BufferSize );
end;

← →
Proton (2002-07-15 22:28) [4]

продолжение ....

// Locate the performance object
_POT := PPERF_OBJECT_TYPE(DWORD(_PerfData) + _PerfData.HeaderLength);
for i := 1 to _PerfData.NumObjectTypes do
begin
if _POT.ObjectNameTitleIndex = Processor_IDX then Break;
_POT := PPERF_OBJECT_TYPE(DWORD(_POT) + _POT.TotalByteLength);
end;

// Check for success
if _POT.ObjectNameTitleIndex <> Processor_IDX then
MessageBox(0,"Unable to locate the "Processor" performance object",
"error",mb_IconError or mb_ok);

if _ProcessorsCount < 0 then
begin
_ProcessorsCount:=_POT.NumInstances;
GetMem(_Counters,_ProcessorsCount*SizeOf(int64));
GetMem(_PrevCounters,_ProcessorsCount*SizeOf(int64));
end;

// Locate the "% CPU usage" counter definition
_PCD := PPERF_Counter_DEFINITION(DWORD(_POT) + _POT.HeaderLength);
for i := 1 to _POT.NumCounters do
begin
if _PCD.CounterNameTitleIndex = CPUUsageIDX then break;
_PCD := PPERF_COUNTER_DEFINITION(DWORD(_PCD) + _PCD.ByteLength);
end;

// Check for success
if _PCD.CounterNameTitleIndex <> CPUUsageIDX then
MessageBox(0,"Unable to locate the "% of CPU usage" performance counter",
"error",mb_IconError or mb_ok);

// Collecting coutners
_PID_Instance := PPERF_INSTANCE_DEFINITION(DWORD(_POT) + _POT.DefinitionLength);
for i := 0 to _ProcessorsCount-1 do
begin
_PCB_Instance := PPERF_COUNTER_BLOCK(DWORD(_PID_Instance) +

_PID_Instance.ByteLength );

_PrevCounters[i]:=_Counters[i];
_Counters[i]:=FInt64(PInt64(DWORD(_PCB_Instance) + _PCD.CounterOffset)^);

_PID_Instance := PPERF_INSTANCE_DEFINITION(DWORD(_PCB_Instance) +

_PCB_Instance.ByteLength);
end;

_PrevSysTime:=_SysTime;
SystemTimeToFileTime(_PerfData.SystemTime, ST);
_SysTime:=FInt64(int64(ST));
end else
begin
if not _W9xCollecting then
begin
R:=RegOpenKeyEx( HKEY_DYN_DATA, "PerfStats\StartStat", 0, KEY_ALL_ACCESS, H );
if R <> ERROR_SUCCESS then
MessageBox(0,"Unable to start performance monitoring",
"error",mb_IconError or mb_ok);

dwDataSize:=sizeof(DWORD);

RegQueryValueEx( H, "KERNEL\CPUUsage", nil, @dwType, PBYTE(@_W9xCpuUsage),

@dwDataSize );

RegCloseKey(H);

R:=RegOpenKeyEx( HKEY_DYN_DATA, "PerfStats\StatData", 0,KEY_READ, _W9xCpuKey );

if R <> ERROR_SUCCESS then
MessageBox(0,"Unable to read performance data",
"error",mb_iconerror or mb_ok);

_W9xCollecting:=True;
end;

dwDataSize:=sizeof(DWORD);
RegQueryValueEx( _W9xCpuKey, "KERNEL\CPUUsage", nil,@dwType, PBYTE(@_W9xCpuUsage),

@dwDataSize );
end;
end;

initialization
_ProcessorsCount:= -1;
_BufferSize:= $2000;
//_PerfData := AllocMem(_BufferSize);
GetMem(_PerfData,_BufferSize);

VI.dwOSVersionInfoSize:=SizeOf(VI);
if not GetVersionEx(VI) then
MessageBox(0,"Can""t get the Windows version",
"error",mb_iconerror or mb_ok);

_IsWinNT := VI.dwPlatformId = VER_PLATFORM_WIN32_NT;
finalization
ReleaseCPUData;
FreeMem(_PerfData);
end.

← →
Agran (2002-07-17 10:01) [5]

GetCPUUsage не заработала. Я скачал их компонент с http://www.aldyn.ru/ с примером. Всё Ok.

Как узнать загруженность процессора? Найти похожие ветки