Исходник показателей температуры показывает с потолка , Исходник показателей температуры показывает с потолка

[s2004]

Перебрал исходники по показателям температуры процессора и матери с удивлением увидел что их практически нет, только два нашёл вот вроде подходящий, но показания ... температура процессора на одном компе 80градусов другом 0, матери 150 и 255 соответственно. запуск от вин98, но это от асм там на 16 бит версию показывает которую вин 95 эмулировала, если не ошибаюсь.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Forms, Graphics,
  Dialogs, Registry, StdCtrls, StrUtils, ComCtrls, Controls, ExtCtrls,
  ShellAPI, Menus, winsvc;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  AverageTemp:Array[0..4] of Integer;
  hSCMan,
  hService,
  hDevice             : SC_HANDLE;
  lpServiceArgVectors : PChar;
  temp                : LongBool;
  serviceStatus       : TServiceStatus;
  DeviceName          : String;  
 
implementation
 
{$R *.dfm}
const
 IntelBasePort:Integer = $290;
 
  Procedure DoneDriver;
  Begin
    CloseHandle(hDevice);
    hService := OpenService(hSCMan,PChar(DeviceName), SERVICE_ALL_ACCESS);
    if hService <> 0 then
    Temp := ControlService(hService,SERVICE_CONTROL_STOP,ServiceStatus);
    if (hService <> 0) then
    CloseServiceHandle(hService);
    hService := OpenService(hSCMan,PChar(DeviceName), SERVICE_ALL_ACCESS);
    temp := DeleteService(hService);
    CloseServiceHandle(hService);
  end;
 
  function InPort(port:word):byte;assembler;stdcall;
  asm
    mov dx,port
    in al,dx
    mov Result,al
  end;
 
  Procedure OutPort(port:word; value:byte);assembler;stdcall;
  asm
    mov al, value
    mov dx, port
    out dx, ax
  end;
 
 // Возвращает температуру материнской платы для "INTEL"!
 Function Temperature:Integer;
 begin
  OutPort(IntelBasePort+5,$27);
  Result:=(InPort(IntelBasePort+6));
 end;
 
{GIVEIO.SYS provides direct access to the I/O ports}
{so this code also works on Windows NT/2000/2003 and XP}
 
 
function ReadTemp:Word;
var
  tmp1: byte;
  tmp2: byte;
  Temp: word; // 16-bit unsigned integer 16 бит для дос и вин98? поменял на dword запустил только с вин98
  Temp1: integer;
  i:integer;
begin
  asm    
    mov cx,128    //decimal, poll busy flag max. 128 times
    mov dx,$0295
@WaitReady1:
    in  al,dx
    and al,128 //decimal
    jz  @ExitWait
    dec cx
    jnz @WaitReady1
@ExitWait:
    mov dx,$0295
    mov al,78 // 78 dec. is the bank select register
    out dx,al
    inc dx
    mov al,1 // select bank 1
    out dx,al
    mov dx,0295h
    mov al,80 // 80 dec. is the temperature High register
    out dx,al
    inc dx
    in  al,dx // fetch temp Hi from 81 dec.
    shl al,1
    mov tmp1,al
    mov dx,0295h
    mov al,81 // 81 dec. is the temperature Low register
    out dx,al
    inc dx
    in  al,dx // fetch temp Lo from 82 dec.
    shr al,7
    mov tmp2,al
  // calculate reading
    xor ah,ah
    xor cx,cx
    mov al,tmp1
    mov cl,tmp2
    add ax,cx
    shr ax,1
  mov Temp,ax  // поменял на eax но запуск только вин98, хорошо бы если запуск был бы хотя бы вин ХР.
  end;
{ Calculate average temp over a 5 second period, using a 5-position circular buffer }
  Temp1:=0;
  if (Temp>0) and (Temp<100) then
  begin
    for i:=0 to 3 do AverageTemp[i]:=AverageTemp[i+1];
    AverageTemp[4]:=Temp;
    if AverageTemp[0]=0 then for i:=0 to 3 do AverageTemp[i]:=AverageTemp[4];
    for i:=0 to 4 do Temp1:=Temp1+AverageTemp[i];
    Temp1:=round(Temp1 / 5);
  end;
  if Temp1<0 then Temp1:=0;
  if Temp1>65536 then Temp1:=0;
  Result:=Temp1; // Result is not a variable but holds the function return value
end;
 
function openIO:boolean;
begin
Result:=true;
       lpServiceArgVectors:=nil;
       DeviceName:='giveio';
       hSCMan:=OpenSCManager(Nil,Nil,SC_MANAGER_CREATE_SERVICE);
       IF hSCMan <> 0 Then
       hService:=CreateService(
       hSCMan,
       pChar(DeviceName),
       pChar(DeviceName),
       SERVICE_ALL_ACCESS,
       SERVICE_KERNEL_DRIVER,
       SERVICE_DEMAND_START,
       SERVICE_ERROR_NORMAL,
       PChar('c:\windows\system32\giveio.sys'),nil,nil,nil,nil,nil);
       If hService<>0 then
        CloseServiceHandle(hService);
        hService:=OpenService(hSCMan,pChar(DeviceName),SERVICE_ALL_ACCESS);
       If hService<>0 then
       begin
        StartService(hService,0,PChar(lpServiceArgVectors));
        CloseServiceHandle(hService);
       end;
        hDevice:=CreateFile(pChar('\\.\'+DeviceName),
        GENERIC_READ or GENERIC_WRITE,0,PSECURITY_DESCRIPTOR(nil),
        OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
openIO;
sleep(5000);
Timer1.Enabled:=True;
end;
 
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled :=False;
  Label1.Caption :=IntToStr(ReadTemp);
  Label2.Caption :=IntToStr(Temperature);
  Timer1.Enabled :=True;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 DoneDriver;
end;
 
end.

показания счётчиков от потолка.

[Romtek]

По-моему, GiveIO.sys - это старьё, написанное ещё для Windows NT. Да и коде вместе с ассемблером - источник многих проблем. Лучше выкинуть и использовать безопасные системные вызовы.

Различную системную информацию можно получить через интерфейс WMI. Допустим, с примером на С++: http://www.cplusplus.com/forum/general/146576/#msg771172
или https://msdn.microsoft.com/en-us/library/aa...493(VS.85).aspx

[s2004]

Рабочий код с винграда

function GetHDDTemp (HDDNum : byte) : integer;
var
  h : THandle;
  scop : PSendCmdOutParams;
  scip : TSendCmdInParams;
  i : integer;
  da : PDriveAttribute;
begin
  Result := -1;
  GetMem (scop, SizeOf(TSendCmdOutParams)+READ_ATTRIBUTE_BUFFER_SIZE-1);
  h := GetPhysicalDriveHandle(HDDNum, GENERIC_READ or GENERIC_WRITE);
  DoReadAttributesCmd(h, scip, scop^, HDDNum);
  i := 2;
  repeat
    da := @scop.bBuffer[i];
    if da.bAttrID = $C2 then
    begin
      Result := da.bAttrValue;
      Break;
    end;
    Inc(i, SizeOf(da^));
  until scop.bBuffer[i] = 0;
  CloseHandle(h);
  FreeMem (scop);
end;

надо скачать файлы компонент IdeInfo2

температуру 150 показала вероятно 75 http://home.earthlink.net/~akonshin/delphi_ru.htm