Aktuelle CPUFrequenz abfragen (SpeedStep)

[hathor]

Wer bis zu 24 Cores hat...

Delphi-Quellcode:

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.