| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Получить температуру процессора [Win2k, WinXP]
DelphiN! © (2004-12-22 13:49:00)Народ не поделитесь ф-иями получения температуры датчиков процессора.
Также буду благодарен за ф-ии получения температуры видеокарт 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;
Однако мне нужно получить температуры, без дополнительных программ
Заранее благодарен !
DelphiN! (2004-12-30 14:41:00) [1]Да, WMI конечно инструмент очень хороший, но в этой глобальной проблемме он помоч не может(я пересмотрел абсолютно все классы, но работающие ф-ии, которые возвращают температуру датчиков процессора не нашел).
Кто еще что может посоветовать ?
Как-то же работает эта программа MBM5 !
DelphiN! (2004-12-28 13:53:00) [2]http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/computer_system_hardware_classes.asp
Тут все классы WMI, но ничего подходящего вроде нет, может я плохо искал ?
Дмитрий Ботвин (2004-12-28 13:13:00) [3]Парни, ну убейте меня нахрен :-)) Надо прочитать в MSDN, что для
этого надо. Я замерял температуру на серваке. У меня 2-процессорная система на P4 Xenon и мать интеловская. Операционка
Win2k Server. На нём работает.
P.S. На моей рабочей станции тоже не показывает....
-=SS=- (2004-12-28 13:08:00) [4]Для Win32_Processor, Win32_VideoController работает, а для Win32_TemperatureProbe — нет :(
-=SS=- (2004-12-28 13:05:00) [5]Фиг там на Атлоне 1.7 тоже не работает
Дмитрий Ботвин (2004-12-28 13:02:00) [6]Попробуйте в GetInfo(Trim(Edit1.Text),'Win32_TemperatureProbe')
вместо Win32_TemperatureProbe поставить, например Win32_Processor, или Win32_VideoController. Если прокатит, значит
у вас на компах че-то не установлено. Может на мать не стоят
дрова чипсетовские? Я точно не знаю, к чему именно обращается
Win32_TemperatureProbe....
msw (2004-12-28 12:43:00) [7]Кстати цикл и у меня невыполнился ни разу
DelphiN! (2004-12-28 11:30:00) [8]Кстати компьютер я как '.' указал
DelphiN! (2004-12-28 11:29:00) [9]Все, откомпилировал, ыполнил, но условие
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 = ''
:((((
Почему ?
Ктонибудь еще проверял на Атлоне или Бартоне? Мамка Шатл у меня(модель непомню)
Дмитрий Ботвин (2004-12-28 10:12:00) [10]Вот эта функция:
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 10:08:00) [11]У меня там есть только :
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 стандартный вроде
DelphiN! (2004-12-28 10:06:00) [12]
> [14] Дмитрий Ботвин (28.12.04 09:56)
Где вы такой модуль Varians взяли, у меня там нет, может скините эту ф-ию ..
Дмитрий Ботвин (2004-12-28 09:56:00) [13]VarTypeAsText описан в модуле Variants, если ты его заюзал, то
он должен "знать" чё это такое....
DelphiN! (2004-12-28 09:53:00) [14]В любом случае директива тут не причем, на найдена ф-ия VarTypeAsText. Может кто скажет в каком она модуле или скинет ее сюда или на мыло ...
Заранее благодарен !
BiN (2004-12-28 09:43:00) [15]В D7 http://www.workshop-alex.org/sources/WbemScripting_TLB/WbemScripting_TLB.htmlпрекрасно компилится, остальные не проверял
DelphiN! (2004-12-28 09:39:00) [16]
> [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:30:00) [17]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:27:00) [18]
> [8] Дмитрий Ботвин (28.12.04 07:51)
Оромное спасибо!! Только вот проверить не смог, у меня модуля WbemScripting_TLB нет, может кто кинет на мыло delphin1986@yandex.ru или ссылочку, если не трудно ..
Заранее благодарен !
Дмитрий Ботвин (2004-12-28 07:51:00) [19]Извиняюсь, в TForm12.Button1Click(Sender: TObject) лишнюю 2 написал - рука дрогнула...
Дмитрий Ботвин (2004-12-28 07:42:00) [20]Я это делал через 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 драйвера.
| |
Страницы: 