Получить температуру процессора

← →
DelphiN! © (2004-12-22 13:49) [0]

Народ не поделитесь ф-иями получения температуры датчиков процессора.

Также буду благодарен за ф-ии получения температуры видеокарт GForceFX 5200 и хардов Seagate Barakuda 160GB

У меня есть код выдирания температуры датчиков процессора из программы MBM5 из Mapping файлов(это программа хранит информацию там)
Вот код, кому надо :

type
TBusType = (btISA, btSMBus, btVIA686ABus, btDirectIO);
TSMBType = (smtSMBIntel, smtSMBAMD, smtSMBALi, smtSMBNForce, smtSMBSIS);
TSensorType = (stUnknown, stTemperature, stVoltage, stFan, stMhz,
stPercentage);

TSharedIndex = record
iType: TSensorType; // type of sensor
Count: integer; // number of sensor for that type
end;

TSharedSensor = record
ssType: TSensorType; // type of sensor
ssName: array[0..11] of AnsiChar; // name of sensor
sspadding1: array[0..2] of Char; // padding of 3 byte
ssCurrent: Double; // current value
ssLow: Double; // lowest readout
ssHigh: Double; // highest readout
ssCount: LongInt; // total number of readout
sspadding2: array[0..3] of Char; // padding of 4 byte
ssTotal: Extended; // total amout of all readouts
sspadding3: array[0..5] of Char; // padding of 6 byte
ssAlarm1: Double; // temp & fan: high alarm; voltage: % off;
ssAlarm2: Double; // temp: low alarm
end;

TSharedInfo = record
siSMB_Base: Word; // SMBus base address
siSMB_Type: TBusType; // SMBus/Isa bus used to access chip
siSMB_Code: TSMBType; // SMBus sub type, Intel, AMD or ALi
siSMB_Addr: Byte; // Address of sensor chip on SMBus
siSMB_Name: array[0..40] of AnsiChar; // Nice name for SMBus
siISA_Base: Word; // ISA base address of sensor chip on ISA
siChipType: Integer; // Chip nr, connects with Chipinfo.ini
siVoltageSubType: Byte; // Subvoltage option selected
end;

TSharedData = record
sdVersion: Double; // version number (example: 51090)
sdIndex: array[0..9] of TSharedIndex; // Sensor index
sdSensor: array[0..99] of TSharedSensor; // sensor info
sdInfo: TSharedInfo; // misc. info
sdStart: array[0..40] of AnsiChar; // start time
sdCurrent: array[0..40] of AnsiChar; // current time
sdPath: array[0..255] of AnsiChar; // MBM path
end;

PSharedData = ^TSharedData;

var

SharedIndex: TSharedIndex;
SharedSensor: TSharedSensor;
SharedInfo: TSharedInfo;
SharedData: PSharedData;

var
myHandle, i, TotalCount: Integer;
S: string;
begin
result := false;
myHandle := OpenFileMapping(FILE_MAP_READ, False, "$M$B$M$5$S$D$");
if myHandle = 0 then
Exit;

SharedData := MapViewOfFile(myHandle, FILE_MAP_READ, 0, 0, 0);
with SharedData^ do
begin
Label1.Caption := FloatToStr(sdVersion);
TotalCount := sdIndex[0].Count +
sdIndex[1].Count +
sdIndex[2].Count +
sdIndex[3].Count +
sdIndex[4].Count;
DataGrid.RowCount := TotalCount + 1;
for i := 0 to TotalCount - 1 do
begin
DataGrid.Cells[0, i + 1] := IntToStr(i);
with sdSensor[i] do
begin
case ssType of
stUnknown: S := "unknown";
stTemperature: S := "temperature";
stVoltage: S := "voltage";
stFan: S := "fanspeed";
stMhz: S := "clockspeed";
stPercentage: S := "percentage";
end;
DataGrid.Cells[1, i + 1] := S;
DataGrid.Cells[2, i + 1] := ssName;
DataGrid.Cells[3, i + 1] := Format("%.7g", [ssCurrent]);
DataGrid.Cells[4, i + 1] := Format("%.7g", [ssLow]);
DataGrid.Cells[5, i + 1] := Format("%.7g", [ssHigh]);
DataGrid.Cells[6, i + 1] := Format("%.7g", [ssAlarm1]);
DataGrid.Cells[7, i + 1] := Format("%.7g", [ssAlarm2]);
DataGrid.Cells[8, i + 1] := IntToStr(ssCount);
end;
end;
end;

Однако мне нужно получить температуры, без дополнительных программ

Заранее благодарен !

← →
dimaxx © (2004-12-22 23:30) [1]

MSDN, раздел по WMI.

← →
DelphiN! © (2004-12-23 06:59) [2]

Вот что я нашел в MSDN, в разделе WMI про процессор : http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_processor.asp

Но там температуры я не нашел ...

← →
dimaxx © (2004-12-23 22:07) [3]

Через WMI можно получить доступ ко всем датчикам (вращения, тем-ры), прочитать идентификаторы устройств и т.п. Вот тока грамотного порта на Паскаль с примерами я так и не нашел.

← →
DelphiN! © (2004-12-24 06:02) [4]

> [3] dimaxx © (23.12.04 22:07)

Подкинь ссылочку ... Я нашел структуру, которую можно получить о процессоре (в WMI), но температуры датчиков там не видел.

← →
DelphiN! © (2004-12-24 10:46) [5]

Вот нашел, http://www.delphikingdom.com/asp/viewitem.asp?UrlItem=/mastering/wmi.htm#054
Но на моем AMD Athlon неудается получить температуру, говорят, что данный прием работает только на Intel-овских процессорах.

А как получить информацию с датчиков на AMD Athlon ???

← →
DelphiN! © (2004-12-28 06:43) [6]

Ну и всеже вопрос остается открытым, выскажите пожалуйста свои рекомендации ... Программа MBM5 как-то же определяет эту температуру(может даже и не точно, но все-же определяет ...)

← →
Дмитрий Ботвин (2004-12-28 07:42) [7]

Я это делал через WMI. Вот рабочий пример:

unit Unit1;

interface

uses
Windows, SysUtils, Variants, ActiveX, ComCtrls,
Classes, Controls, Forms, StdCtrls, WbemScripting_TLB,
ExtCtrls;

function ADsEnumerateNext(pEnumVariant: IEnumVARIANT; cElements:
ULONG; var pvar: OleVARIANT; var pcElementsFetched: ULONG):
HRESULT; safecall; external "activeds.dll";

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Edit1: TEdit;
StatusBar1: TStatusBar;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure GetInfo(WMIname:string);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

//Разделитель триад
function TriadStr(Str: string): String;
var len,i: integer;
begin
len:=Length(Str);
if len<=3 then
begin
Result:=Str;
exit;
end;
for i:=1 to len do
begin
if (i mod 3)=0 then insert(" ",str,len-i+1);
end;
Result:=str;
end;

//Ищем спецсимволы
function FindSymbol(Str: string): boolean;
var i, len: integer;
begin
Result:=false;
len:=Length(Str);
for i:=1 to len do
if not(Str[i] in ["0".."9"]) then
begin
Result:=true;
exit;
end;
end;

//Обращение к WMI
procedure DumpWMI_Process(Process: SWBemObject;Memo:TMemo);
var
Enum: IEnumVARIANT;
varArr: OleVariant;
lNumElements: ULong;
SProp: ISWbemProperty;
Prop: OleVariant;
PropName, PropValue: string;
begin
Memo.Lines.Add("*********************************************************");
Memo.Lines.Add(" WMI Path: " + Process.Path_.Path);
Memo.Lines.Add("*********************************************************");
Enum := Process.Properties_._NewEnum as IEnumVariant;
while (Succeeded(ADsEnumerateNext(Enum, 1, VarArr, lNumElements))) and (lNumElements > 0) do
if Succeeded(IDispatch(varArr).QueryInterface(SWBemProperty, SProp)) and Assigned(SProp) then
begin
PropName := SProp.Name;
Prop := SProp.Get_Value;
if VarTypeAsText(VarType(Prop))="Array Variant" then continue
else
if VarTypeAsText(VarType(Prop))="Integer" then PropValue := TriadStr(VarToStr(Prop))
else if VarTypeAsText(VarType(Prop))="OleStr" then
begin
if FindSymbol(VarToStr(Prop)) then PropValue := VarToStr(Prop)
else PropValue := TriadStr(VarToStr(Prop));
end
else PropValue := VarToStr(Prop);
if Length(PropValue)=0 then continue;
Memo.Lines.Add(PropName + " = " + Trim(PropValue));
Application.ProcessMessages;
end;
end;

//Получаем нужную инфу
procedure TForm1.GetInfo(CompName, WMIname: string);
var
Enum: IEnumVARIANT;
varArr: OleVariant;
lNumElements: ULong;
begin
Memo1.Lines.Clear;
Memo1.Lines.BeginUpdate;
try
Enum := CoSWbemLocator.Create.ConnectServer(CompName, "root\cimv2",
"","", "", "", 0, nil).ExecQuery("Select * from "+WMIName+"", "WQL",
wbemFlagBidirectional, nil)._NewEnum as IEnumVariant;
while (Succeeded(ADsEnumerateNext(Enum, 1, varArr, lNumElements))) and (lNumElements > 0) do
begin
DumpWMI_Process(IUnknown(varArr) as SWBemObject,Memo1);
Application.ProcessMessages;
end;
finally
Memo1.Lines.EndUpdate;
end;
end;

//Обработчик кнопки
procedure TForm12.Button1Click(Sender: TObject);
begin
GetInfo(Trim(Edit1.Text),"Win32_TemperatureProbe");
end;

end.

Можешь вместо Win32_TemperatureProbe подставлять любой класс WMI
и получать любую инфу об аппаратно-программных ресурсах.
Здесь Edit1.Тext - это имя компа, на котором ты хочешь узнать температуру. Если поставишь "."-посмотришь на своём. Это не работает на NT4.0 и на Win9x. Для них надо качать с микрософта WMI драйвера.

← →
Дмитрий Ботвин (2004-12-28 07:51) [8]

Извиняюсь, в TForm12.Button1Click(Sender: TObject) лишнюю 2 написал - рука дрогнула...

← →
DelphiN! © (2004-12-28 09:27) [9]

> [8] Дмитрий Ботвин (28.12.04 07:51)

Оромное спасибо!! Только вот проверить не смог, у меня модуля WbemScripting_TLB нет, может кто кинет на мыло delphin1986@yandex.ru или ссылочку, если не трудно ..

Заранее благодарен !

← →
BiN © (2004-12-28 09:30) [10]

STFN

http://www.google.ru/search?hl=ru&q=WbemScripting_TLB&btnG=%D0%9F%D0%BE%D0%B8%D1%81%D0%BA&lr=

← →
DelphiN! © (2004-12-28 09:39) [11]

> [10] BiN © (28.12.04 09:30)

Thx, а yandex ниче не нашел :))

Вот взял модуль отсюда :

http://www.truth4all.org/WbemScripting_TLB.pas.txt

Но при компиляции модуля рунается что нет директивы {$VARPROPSETTER ON}
Я ее закоментировал, но теперь в примере Дмитрия Ботвина ругается на строчку if VarTypeAsText(VarType(Prop))="Array Variant" then continue

Говорит, незнаю че за : VarTypeAsText

Как решить проблемму ?

← →
BiN © (2004-12-28 09:43) [12]

В D7 http://www.workshop-alex.org/sources/WbemScripting_TLB/WbemScripting_TLB.html прекрасно компилится, остальные не проверял

← →
DelphiN! © (2004-12-28 09:53) [13]

В любом случае директива тут не причем, на найдена ф-ия VarTypeAsText. Может кто скажет в каком она модуле или скинет ее сюда или на мыло ...

Заранее благодарен !

← →
Дмитрий Ботвин (2004-12-28 09:56) [14]

VarTypeAsText описан в модуле Variants, если ты его заюзал, то
он должен "знать" чё это такое....

← →
DelphiN! © (2004-12-28 10:06) [15]

> [14] Дмитрий Ботвин (28.12.04 09:56)

Где вы такой модуль Varians взяли, у меня там нет, может скините эту ф-ию ..

← →
DelphiN! © (2004-12-28 10:08) [16]

У меня там есть только :
function VarType(const V: Variant): TVarType; function VarAsType(const V: Variant; AVarType: TVarType): Variant; function VarIsType(const V: Variant; AVarType: TVarType): Boolean; overload; function VarIsType(const V: Variant; const AVarTypes: array of TVarType): Boolean; overload; function VarIsByRef(const V: Variant): Boolean; function VarIsEmpty(const V: Variant): Boolean; procedure VarCheckEmpty(const V: Variant); function VarIsNull(const V: Variant): Boolean; function VarIsClear(const V: Variant): Boolean; function VarIsCustom(const V: Variant): Boolean; function VarIsOrdinal(const V: Variant): Boolean; function VarIsFloat(const V: Variant): Boolean; function VarIsNumeric(const V: Variant): Boolean; function VarIsStr(const V: Variant): Boolean; function VarToStr(const V: Variant): string; function VarToStrDef(const V: Variant; const ADefault: string): string; function VarToWideStr(const V: Variant): WideString; function VarToWideStrDef(const V: Variant; const ADefault: WideString): WideString; function VarToDateTime(const V: Variant): TDateTime; function VarFromDateTime(const DateTime: TDateTime): Variant; function VarInRange(const AValue, AMin, AMax: Variant): Boolean; function VarEnsureRange(const AValue, AMin, AMax: Variant): Variant;

А VarTypeAsText нету.

У меня 6-я делфи, и модуль Varians стандартный вроде

← →
Дмитрий Ботвин (2004-12-28 10:12) [17]

Вот эта функция:

function VarTypeAsText(const AType: TVarType): string;
const
CText: array [varEmpty..varInt64] of string = ("Empty", "Null", "Smallint", //Do not localize
"Integer", "Single", "Double", "Currency", "Date", "OleStr", "Dispatch", //Do not localize
"Error", "Boolean", "Variant", "Unknown", "Decimal", "$0F", "ShortInt", //Do not localize
"Byte", "Word", "LongWord", "Int64"); //Do not localize
var
LHandler: TCustomVariantType;
begin
if AType and varTypeMask <= varInt64 then
Result := CText[AType and varTypeMask]
else if AType = varString then
Result := "String" //Do not localize
else if AType = varAny then
Result := "Any" //Do not localize
else if FindCustomVariantType(AType, LHandler) then
Result := Copy(LHandler.ClassName, 2, High(Integer))
else
Result := HexDisplayPrefix + IntToHex(AType and varTypeMask, 4);

if AType and varArray <> 0 then
Result := "Array " + Result; //Do not localize
if AType and varByRef <> 0 then
Result := "ByRef " + Result; //Do not localize
end;

И в разделе public замени procedure GetInfo(WMIname:string) на
procedure GetInfo(CompName, WMIname:string).....

← →
DelphiN! © (2004-12-28 11:29) [18]

Все, откомпилировал, ыполнил, но условие

while (Succeeded(ADsEnumerateNext(Enum, 1, varArr, lNumElements))) and (lNumElements > 0) do begin DumpWMI_Process(IUnknown(varArr) as SWBemObject,Memo1); Application.ProcessMessages; end;

В процедуре GetInfo не выполнилось ниразу, в следствии чего Memo1.text = ""

:((((

Почему ?

Ктонибудь еще проверял на Атлоне или Бартоне? Мамка Шатл у меня(модель непомню)

Кстати компьютер я как "." указал

← →
msw (2004-12-28 12:43) [20]

Кстати цикл и у меня невыполнился ни разу

← →
Дмитрий Ботвин (2004-12-28 13:02) [21]

Попробуйте в GetInfo(Trim(Edit1.Text),"Win32_TemperatureProbe")
вместо Win32_TemperatureProbe поставить, например Win32_Processor, или Win32_VideoController. Если прокатит, значит
у вас на компах че-то не установлено. Может на мать не стоят
дрова чипсетовские? Я точно не знаю, к чему именно обращается
Win32_TemperatureProbe....

Фиг там на Атлоне 1.7 тоже не работает

Для Win32_Processor, Win32_VideoController работает, а для Win32_TemperatureProbe — нет :(

← →
Дмитрий Ботвин (2004-12-28 13:13) [24]

Парни, ну убейте меня нахрен :-)) Надо прочитать в MSDN, что для
этого надо. Я замерял температуру на серваке. У меня 2-процессорная система на P4 Xenon и мать интеловская. Операционка
Win2k Server. На нём работает.

P.S. На моей рабочей станции тоже не показывает....

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/computer_system_hardware_classes.asp

Тут все классы WMI, но ничего подходящего вроде нет, может я плохо искал ?

Да, WMI конечно инструмент очень хороший, но в этой глобальной проблемме он помоч не может(я пересмотрел абсолютно все классы, но работающие ф-ии, которые возвращают температуру датчиков процессора не нашел).

Кто еще что может посоветовать ?

Как-то же работает эта программа MBM5 !

Получить температуру процессора Найти похожие ветки