Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Исходник показателей температуры показывает с пото, Исходник показателей температуры показыв 
V
    Опции темы
s2004
Дата 4.2.2017, 19:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 167
Регистрация: 30.10.2006

Репутация: нет
Всего: нет



Перебрал исходники по показателям температуры процессора и матери с удивлением увидел что их практически нет, только два нашёл вот вроде подходящий, но показания ... температура процессора на одном компе 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.




показания счётчиков от потолка. 
PM MAIL   Вверх
s2004
Дата 6.2.2017, 20:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 167
Регистрация: 30.10.2006

Репутация: нет
Всего: нет



На исходниках предложили на С++
Код

#define _WIN32_DCOM
#include <iostream>
using namespace std;
#include <comdef.h>
#include <Wbemidl.h>
 
#pragma comment(lib, "wbemuuid.lib")
 
HRESULT GetCpuTemperature(LPLONG pTemperature)
{
        if (pTemperature == NULL)
                return E_INVALIDARG;
 
        *pTemperature = -1;
        HRESULT ci = CoInitialize(NULL);
        HRESULT hr = CoInitializeSecurity(NULL, -1, NULL, NULL, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IMPERSONATE, NULL, EOAC_NONE, NULL);
        if (SUCCEEDED(hr))
        {
                IWbemLocator *pLocator;
                hr = CoCreateInstance(CLSID_WbemAdministrativeLocator, NULL, CLSCTX_INPROC_SERVER, IID_IWbemLocator, (LPVOID*)&pLocator);
                if (SUCCEEDED(hr))
                {
                        IWbemServices *pServices;
                        BSTR ns = SysAllocString(L"root\\WMI");
                        hr = pLocator->ConnectServer(ns, NULL, NULL, NULL, 0, NULL, NULL, &pServices);
                        pLocator->Release();
                        SysFreeString(ns);
                        if (SUCCEEDED(hr))
                        {
                                BSTR query = SysAllocString(L"SELECT * FROM MSAcpi_ThermalZoneTemperature");
                                BSTR wql = SysAllocString(L"WQL");
                                IEnumWbemClassObject *pEnum;
                                hr = pServices->ExecQuery(wql, query, WBEM_FLAG_RETURN_IMMEDIATELY | WBEM_FLAG_FORWARD_ONLY, NULL, &pEnum);
                                SysFreeString(wql);
                                SysFreeString(query);
                                pServices->Release();
                                if (SUCCEEDED(hr))
                                {
                                        IWbemClassObject *pObject;
                                        ULONG returned;
                                        hr = pEnum->Next(WBEM_INFINITE, 1, &pObject, &returned);
                                        pEnum->Release();
                                        if (SUCCEEDED(hr))
                                        {
                                                BSTR temp = SysAllocString(L"CurrentTemperature");
                                                VARIANT v;
                                                VariantInit(&v);
                                                hr = pObject->Get(temp, 0, &v, NULL, NULL);
                                                pObject->Release();
                                                SysFreeString(temp);
                                                if (SUCCEEDED(hr))
                                                {
                                                        *pTemperature = V_I4(&v);
                                                }
                                                VariantClear(&v);
                                        }
                                }
                        }
                        if (ci == S_OK)
                        {
                                CoUninitialize();
                        }
                }
        }
        return hr;
}
 
int main(int argc, char **argv)
{
        LONG temp;
        GetCpuTemperature(&temp);
        printf("temp=%lf\n", ((double)temp / 10 - 273.15));
        getc(stdin);
        return 0;
 

код благополучно засунул в *.срр запустился  без ошибок  на этом всё, я вообще незнаком с си как можно этот код перевести в дельфи? 


PM MAIL   Вверх
s2004
Дата 8.2.2017, 20:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 167
Регистрация: 30.10.2006

Репутация: нет
Всего: нет



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

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

Это сообщение отредактировал(а) s2004 - 8.2.2017, 20:50
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.1263 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.