Определить загрузку процессора

← →
zhuravelsv (2007-01-10 18:42) [0]

Как можно определить загрузку процессора под WinXP

← →
ors_archangel © (2007-01-10 19:03) [1]

interface uses Windows, SysUtils; procedure CollectCPUData; function GetCPUCount: Integer; function GetCPUUsage(Index: Integer): Double; implementation {$ifndef ver110} {$ifndef ver90} {$ifndef ver100} {$define UseInt64} {$endif} {$endif} {$ifdef UseInt64} type TInt64 = Int64; {$else} type TInt64 = Comp; {$endif} {$else} type TInt64 = TLargeInteger; {$endif} type PInt64 = ^TInt64; 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 : TInt64; PerfFreq : TInt64; PerfTime100nSec : TInt64; 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 : TInt64; PerfFreq : TInt64; 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 TInt64F = TInt64; {$else} type TInt64F = Extended; {$endif} {$ifdef ver110} function FInt64(Value: TInt64): TInt64F; function Int64D(Value: DWORD): TInt64; {$else} type FInt64 = TInt64F; Int64D = TInt64; {$endif} {$ifdef ver110} function FInt64(Value: TInt64): TInt64F; var V: TInt64; 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): TInt64; begin result.LowPart:=Value; result.HighPart := 0; // positive only end; {$endif} const Processor_IDX_Str = "238"; Processor_IDX = 238; CPUUsageIDX = 6; type AInt64F = array[0..$FFFF] of TInt64F; PAInt64F = ^AInt64F; var _PerfData : PPERF_DATA_BLOCK; _BufferSize: Integer; _POT : PPERF_OBJECT_TYPE; _PCD: PPerf_Counter_Definition; _ProcessorsCount: Integer; _Counters: PAInt64F; _PrevCounters: PAInt64F; _SysTime: TInt64F; _PrevSysTime: TInt64F; function GetCPUCount: Integer; begin if _ProcessorsCount < 0 then CollectCPUData; result:=_ProcessorsCount; end; function GetCPUUsage(Index: Integer): Double; begin if _ProcessorsCount < 0 then CollectCPUData; if (Index >= _ProcessorsCount) or (Index < 0) then raise Exception.Create("CPU index out of bounds"); if _PrevSysTime = _SysTime then result:=0 else result:=1-(_Counters[index] - _PrevCounters[index])/(_SysTime-_PrevSysTime); 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 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; _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; if _POT.ObjectNameTitleIndex <> Processor_IDX then raise Exception.Create("Unable to locate the "Processor" performance object"); if _ProcessorsCount < 0 then begin _ProcessorsCount:=_POT.NumInstances; GetMem(_Counters,_ProcessorsCount*SizeOf(TInt64)); GetMem(_PrevCounters,_ProcessorsCount*SizeOf(TInt64)); end; _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; if _PCD.CounterNameTitleIndex <> CPUUsageIDX then raise Exception.Create("Unable to locate the "% of CPU usage" performance counter"); _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(TInt64(ST)); end; initialization _ProcessorsCount:= -1; _BufferSize:= $2000; _PerfData := AllocMem(_BufferSize); VI.dwOSVersionInfoSize:=SizeOf(VI); finalization FreeMem(_PerfData); end.

← →
ors_archangel © (2007-01-10 19:05) [2]

Автор кода [1] - Alexey A. Dynnikov aldyn@chat.ru http://www.aldyn.ru/

← →
Loginov Dmitry © (2007-01-10 20:51) [3]

Работал бы еще этот модулёчек в Win9x по человечески, цены бы не было. А то при частоте загрузке проца 0% пишет, что загрузка составляет аж 60%. К чему это?

> Работал бы еще этот модулёчек в Win9x

Оригинально работал - через HKEY_DYNDATA, но из-за ограничения на длину поста в 7 с чем-то там килов пришлось его вырезать, я надеюсь zhuravelsv не сильно обидется, он же указал WinXP :)

Определить загрузку процессора Найти похожие ветки