DELPHI source code: current frequency of each core

Updates on developement of new features and user input/requests

Moderator: imposter

Post Reply
hathor
Registered User
Registered User
Posts: 31
Joined: Fri Aug 25, 2006 7:02 am
Location: Berlin, Germany

DELPHI source code: current frequency of each core

Post by hathor »

We can get the current frequency of each core with this DELPHI-code:

Code: Select all

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;

  TCPUFrequency = packed record
    CurrentMhz: Cardinal;
    MaxMhz: Cardinal;
    MhzLimit: Cardinal;
  end;

  TPowerInfoArray = array[0..0] of PROCESSOR_POWER_INFORMATION;
  PPowerInfoArray = ^TPowerInfoArray;

var
  CPUFrequency: TCPUFrequency;
  PowerInfos: Pointer;
  SysInfo: SYSTEM_INFO;
  PowerInfoArray: PPowerInfoArray absolute PowerInfos;

implementation

{$R *.dfm}

function CallNtPowerInformation(InformationLevel: DWORD; InPutBuffer: Pointer; InputBufferSize: ULONG; OutPutBuffer:
  Pointer; OutPutBufferSize: ULONG): DWORD; stdcall; external powrproflib;

function GetCPUFrequency(var CPUFrequency: TCPUFrequency): DWORD;
var
  ppi: PROCESSOR_POWER_INFORMATION;
  err: DWORD;
begin
  ZeroMemory(@ppi, sizeof(PROCESSOR_POWER_INFORMATION));
  err := CallNTPowerInformation(11, nil, 0, @ppi, 
sizeof(PROCESSOR_POWER_INFORMATION));
  if err = 0 then
  begin
    CPUFrequency.CurrentMhz := ppi.CurrentMhz;
    CPUFrequency.MaxMhz := ppi.MaxMhz;
    CPUFrequency.MhzLimit := ppi.MhzLimit;
  end;
  result := err;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Button1Click(Self);
end;

procedure TForm1.Button1Click(Sender: TObject);
var size, ret: Cardinal;
    CURR, i :Integer;
begin
  GetSystemInfo(SysInfo);
  size := SizeOf(PROCESSOR_POWER_INFORMATION) * 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 SysInfo.dwNumberOfProcessors - 1 do
      begin  
        CURR:= Round(PowerInfoArray^[i].CurrentMhz div 100 +1)* 100;
       case i of
       0: CurrentMhz0.Caption:= IntToStr(CURR); // Core 0
       1: CurrentMhz1.Caption:= IntToStr(CURR); // Core 1
       end;
      end;
    end
  else
  FreeMem(PowerInfos, size);
end;
Greetings from BERLIN, GERMANY!
tiu-hathor

Post Reply

Return to “Core Temp - Development”