Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.01.28;
Скачать: CL | DM;

Вниз

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

 
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%. К чему это?


 
ors_archangel ©   (2007-01-10 20:56) [4]


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

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



Страницы: 1 вся ветка

Текущий архив: 2007.01.28;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.051 c
11-1146386530
gugua
2006-04-30 12:42
2007.01.28
Ansi сортировка в PFastStrListEx и PStrList.


1-1165487765
sdram
2006-12-07 13:36
2007.01.28
С обьявлениями хомуты


15-1168029800
ZiTRaX
2007-01-05 23:43
2007.01.28
Просто под впечатлением от прочитанного...


4-1158316591
R_O_O_T
2006-09-15 14:36
2007.01.28
помогите с SETUPAPI.dll )))


15-1168507554
FOX
2007-01-11 12:25
2007.01.28
Вакансия программиста