ALCPU Forums

Code: Select all

{
    Sample source code for reading CORETEMP shared memory written in Borland Delphi
    Copyright (C) 2008  Tiu Hathor

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

Contact: tiu-hathor@web.de
http://www.alcpu.com/CoreTemp/developers.html
                  Arthur_Liberman@hotmail.com

}

unit CTread;

interface

uses
  Windows,
  StdCtrls,
  Controls,
  Classes,
  Forms,
  SysUtils,
  ExtCtrls;

//Core Temp shared memory Translation C++ > DELPHI : (c) 2008 Tiu Hathor
Type
  TCTInfo =  record
  uiLoad : array [0..255] of Cardinal;  //256             = 1024 bytes
	uiTjMax : array [0..127] of Cardinal; //128             =  512 bytes
	uiCoreCnt :Cardinal;                  // 4 bytes
	uiCPUCnt :Cardinal;                   // 4 bytes
	fTemp : array [0..255] of single;     //256 *  4 bytes  = 1024 bytes
	fVID : single;                        //real   4 bytes
	fCPUSpeed : single;                   //real   4 bytes
	fFSBSpeed : single;                   //real   4 bytes
	fMultiplier : single;                 //real   4 bytes
	sCPUName : array [0..99] of Char;     //String[100];    = 100 bytes
	ucFahrenheit : Boolean;               // 1 byte
	ucDeltaToTjMax: Boolean;              // 1 byte
  end;                                  // 2686  bytes

  PCTInfo   = ^TCTInfo;

  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  CTInfo   : PCTInfo;
  myHandle : Integer;
//20080623---------------------------------------------------------------------
  N, CIS, MIS : Cardinal;

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;
var
  CPUFrequency: TCPUFrequency;
//END--------------------------------------------------------------------------

implementation

{$R *.DFM}

//20080623---------------------------------------------------------------------
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;
    N:= ppi.Number;
    CIS:= ppi.CurrentIdleState;
    MIS:= ppi.MaxIdleState;
  end;
  result := err;
end;

function ReadFREQ : Boolean;
var
  err: DWORD;
begin
  ZeroMemory(@CPUFrequency, sizeof(TCPUFrequency));
  err := GetCPUFrequency(CPUFrequency);
  if err = 0 then result:= true else result:= false;
end;
//END--------------------------------------------------------------------------

function ReadCTInfo : Boolean;
begin
  myHandle :=  OpenFileMapping(FILE_MAP_READ, False, 'CoreTempMappingObject');
  if myHandle > 0 then
  begin
    CTInfo := MapViewOfFile(myHandle, FILE_MAP_READ, 0, 0, 0);
    Result := True;
  end else result := false;
  CloseHandle(myHandle);
end;
//-----------------------------------------------------------------------------
procedure TForm1.FormShow(Sender: TObject);
begin
  Memo1.Clear;
  if ReadCTInfo = True then
  BEGIN
    Memo1.Lines.Add('CTInfo: ok');
    Timer1.Enabled:= true;
  END  else
    Memo1.Lines.Add('CTInfo: ERROR. CORETEMP is NOT running!');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnmapViewOfFile(CTInfo);
  CloseHandle(myHandle);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Memo1.Clear;

Memo1.Lines.Add('CTInfo: CpuName: '+ CTInfo.sCPUName);
Memo1.Lines.Add('');
Memo1.Lines.Add('CTInfo: Core0: '+ FloatToStr(CTInfo.fTemp[0])+ ' °C');
Memo1.Lines.Add('CTInfo: Core1: '+ FloatToStr(CTInfo.fTemp[1])+ ' °C');
Memo1.Lines.Add('CTInfo: Core2: '+ FloatToStr(CTInfo.fTemp[2])+ ' °C');
Memo1.Lines.Add('CTInfo: Core3: '+ FloatToStr(CTInfo.fTemp[3])+ ' °C');
Memo1.Lines.Add('');
Memo1.Lines.Add('CTInfo: Load-Core0: '+ IntToStr(CTInfo.uiLoad[0])+ ' %');
Memo1.Lines.Add('CTInfo: Load-Core1: '+ IntToStr(CTInfo.uiLoad[1])+ ' %');
Memo1.Lines.Add('CTInfo: Load-Core2: '+ IntToStr(CTInfo.uiLoad[2])+ ' %');
Memo1.Lines.Add('CTInfo: Load-Core3: '+ IntToStr(CTInfo.uiLoad[3])+ ' %');
Memo1.Lines.Add('');
Memo1.Lines.Add('CTInfo: TjMax: '+ IntToStr(CTInfo.uiTjMax[0])+ ' °C');
Memo1.Lines.Add('CTInfo: CpuCoreCount: '+ IntToStr(CTInfo.uiCoreCnt));
Memo1.Lines.Add('CTInfo: CpuCount: '+ IntToStr(CTInfo.uiCPUCnt));
Memo1.Lines.Add('CTInfo: CpuVID: '+ Format('%.5g', [CTInfo.fVID]) + ' Volt');
Memo1.Lines.Add('CTInfo: CpuSpeed: '+ Format('%.6g', [CTInfo.fCPUSpeed]) + ' MHz');
Memo1.Lines.Add('CTInfo: CpuFSBSpeed: '+ Format('%.3g', [CTInfo.fFSBSpeed]) + ' MHz');
Memo1.Lines.Add('CTInfo: CpuMultiplier: '+ FloatToStr(CTInfo.fMultiplier));
Memo1.Lines.Add('CTInfo: Fahrenheit: '+ BoolToStr(CTInfo.ucFahrenheit));
Memo1.Lines.Add('CTInfo: DeltaToTjMax: '+ BoolToStr(CTInfo.ucDeltaToTjMax));
//20080623---------------------------------------------------------------------
Memo1.Lines.Add('');
If ReadFREQ = true then
BEGIN
Memo1.Lines.Add('Current frequency: '+IntToStr(Round(CPUFrequency.CurrentMhz div 100 +1)* 100)+' MHz');
Memo1.Lines.Add('Max frequency: '+IntToStr(Round(CPUFrequency.MaxMhz div 100 +1)* 100)+' MHz');
Memo1.Lines.Add('System processor number: '+IntToStr(N));
Memo1.Lines.Add('CurrentIdleState: '+IntToStr(CIS));
Memo1.Lines.Add('MaxIdleState: '+IntToStr(MIS));
END;
//20080623-END-----------------------------------------------------------------
end;

end.

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;