unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ExtCtrls,
Vcl.StdCtrls, System.Win.Registry;
type
TForm1 =
class(TForm)
Memo1: TMemo;
Button1: TButton;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
procedure RUN(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
const
powrproflib = '
powrprof.dll';
type
PROCESSOR_POWER_INFORMATION =
packed record
Number: Cardinal;
MaxMhz: Cardinal;
CurrentMhz: Cardinal;
MhzLimit: Cardinal;
MaxIdleState: Cardinal;
CurrentIdleState: Cardinal;
end;
PPROCESSOR_POWER_INFORMATION = ^PROCESSOR_POWER_INFORMATION;
TPowerInfoArray =
array[0..0]
of PROCESSOR_POWER_INFORMATION;
PPowerInfoArray = ^TPowerInfoArray;
var
PowerInfos: Pointer;
PowerInfoArray: PPowerInfoArray
absolute PowerInfos;
HIGHEST, LOWEST : INTEGER;
SysInfo: SYSTEM_INFO;
implementation
{$R *.dfm}
procedure MM(s:
string);
begin Form1.Memo1.Lines.Add(s);
end;
Function GetProzessorName:
String;
Var Reg: TRegistry;
Begin
Result := '
Processor ?';
Reg := TRegistry.Create(KEY_READ);
Try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('
Hardware\Description\System\CentralProcessor\0', False);
Result := Reg.ReadString('
ProcessorNameString');
Finally
Reg.free;
End;
End;
function CallNtPowerInformation(InformationLevel: DWORD; InPutBuffer: Pointer; InputBufferSize: ULONG; OutPutBuffer:
Pointer; OutPutBufferSize: ULONG): DWORD;
stdcall;
external powrproflib;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HIGHEST:= 0;
LOWEST:= 10000;
Label3.Caption:= GetProzessorName;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Memo1.clear; MM('
');
RUN(Self);
Label1.Caption:= '
HIGHEST FREQ: '+INTTOSTR(HIGHEST)+'
MHz';
Label2.Caption:= '
LOWEST FREQ: '+INTTOSTR(LOWEST)+'
MHz';
Button1.SetFocus;
end;
procedure TForm1.RUN(Sender: TObject);
var size, ret: Cardinal;
CURR,HIGH,LIMIT, i :Integer;
begin
// GetNativeSystemInfo(SysInfo);
// Caption:= 'Cores: '+INTTOSTR(SysInfo.dwNumberOfProcessors);
size := SizeOf(PROCESSOR_POWER_INFORMATION) * 24;
//or SysInfo.dwNumberOfProcessors;
GetMem(PowerInfos, size);
ZeroMemory(PowerInfos, size);
ret := CallNTPowerInformation(11,
nil, 0, PowerInfos, size);
if ret = ERROR_SUCCESS
then
begin
PowerInfoArray := PowerInfos;
for i := 0
to 23
do // 24 Cores - enough ?
begin
if i> PowerInfoArray^[i].Number
then EXIT;
Label6.Caption:= '
Idle: '+INTTOSTR(PowerInfoArray^[i].CurrentIdleState);
CURR:= Round(PowerInfoArray^[i].CurrentMhz
div 10)* 10;
HIGH:= Round(PowerInfoArray^[i].MaxMhz
div 10)* 10;
LIMIT:= Round(PowerInfoArray^[i].MhzLimit
div 10)*10;
Label4.Caption:= '
MaxMhz: '+INTTOSTR(HIGH)+ '
MHz';
Label5.caption:= '
MhzLimit: '+INTTOSTR(LIMIT)+ '
MHz';
if CURR > HIGHEST
then HIGHEST:= CURR;
if CURR < LOWEST
then LOWEST:= CURR;
case PowerInfoArray^[i].Number
of
0: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 0
1: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 1
2: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 2
3: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 3
4: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 4
5: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 5
6: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 6
7: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 7
8: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 8
9: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 9
10: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 10
11: MM('
CORE '+ IntToStr(i)+'
: ' + IntToStr(CURR)+'
MHz');
// Core 11
// extent to 23
end;
end;
end
else
FreeMem(PowerInfos, size);
end;
end.