VPF::температура и загрузка процессора

dumb

Дата 6.4.2008, 22:53 (ссылка)

(нет голосов)

Загрузка ...

sceloglauxalbifacies

Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

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

сий куст не отображается в редакторе. доступ к perf.data через функции regapi сделан исключительно для удобствия.

neweraser

Дата 14.4.2008, 19:04 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

нашел решение проблемы, долго рылся в сети и вот, нашел модуль adCpuUsage, автор Alexey A. Dynnikov
вот код, если кому понадобится, только немного изменил, точнее полностью, как мне и было нужно smile

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  adCpuUsage, Dialogs, ExtCtrls, TeEngine, Series, TeeProcs, Chart, StdCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
  
//  $00 DA E4 7E

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  CollectCPUData;
  for i:=0 to GetCPUCount-1 do
  label1.Caption:=FloatToStr(Round(GetCPUUsage(i)*100))+'%';
end;

end.

модуль тоже тут

Присоединённый файл ( Кол-во скачиваний: 37 )

adCpuUsage.dcu 5,91 Kb

--------------------

Кто ищет, тот всегда найдет.

neweraser

Дата 15.4.2008, 19:37 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

Только вот проблема, все это вроде бы не работает в vista... smile

надо искать другое решение, скорее всего через реестр, сам висту не ставил еще, но слышал, что структура реестра там не изменилась
господа программисты, что вы думаете по этому поводу? smile

--------------------

Кто ищет, тот всегда найдет.

SneG0K

Дата 15.4.2008, 19:39 (ссылка)

(нет голосов)

Загрузка ...

Max Mara

Профиль
Группа: Завсегдатай
Сообщений: 1887
Регистрация: 1.12.2007
Где: Wis Dells

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

Цитата(neweraser @ 15.4.2008, 18:37

)

господа программисты, что вы думаете по этому поводу?

Висту на мыло smile

Старая добрая ХРень спасет мир=)

MetalFan

Дата 15.4.2008, 21:32 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

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

Цитата(neweraser @ 14.4.2008, 19:04

)

модуль тоже тут

пользовать чужие dcu'шки.... брр

--------------------

There are always someone smarter than you...

neweraser

Дата 15.4.2008, 21:46 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

Цитата(MetalFan @ 15.4.2008, 21:32

)

пользовать чужие dcu'шки.... брр

свои еще не научился создавать smile

--------------------

Кто ищет, тот всегда найдет.

virtul

Дата 29.5.2008, 11:05 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

люди VISTA -это зло! насебе пробовал!
в ней реально мудуль adCpuUsage неработает.
в VISTe выходит до 500 сообщений c надписью: Err. process!

AugMaster

Дата 6.10.2011, 07:45 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

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

Вчера озадачился вопросом получения температуры.
WMI мне рассказал что провайдер недоступен - пришлось искать обходные решения.

Вот пример, работающий на интеле, найденный в инете (в теории пашет - проверить не на чем, но комменты о нем положительные)

Код


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
  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
  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
       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.

Вот вариант для двуядерных AMD ( и возможно модных одноядерных) - если быть точным - для процов семейства AMD NPT Family 0Fh Processors

Код


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;
  hSCMan,
  hService,
  hDevice             : SC_HANDLE;
  lpServiceArgVectors : PChar;
  temp                : LongBool;
  serviceStatus       : TServiceStatus;
  DeviceName          : String;

implementation

{$R *.dfm}



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;

{GIVEIO.SYS provides direct access to the I/O ports}
{so this code also works on Windows NT/2000/2003 and XP}

function ReadTemp(corr:integer):dWord;
var
  Temp: dword; // 16-bit unsigned integer
  BusNum:dword;
DevNum:dword;
FuncNum:dword;
RegNum:dword;
resss:dword;
avv:dword;
begin
if corr=0 then //avv:=00000000000000000000000000000100b else avv:=00000000000000000000000000000000b;
        avv:=4 else avv:=0;
BusNum:= 0;
DevNum :=24;
FuncNum    := 3;
RegNum     := $0e4;
resss:=$80000000  or (BusNum shl 16) or (DevNum shl 11) or (FuncNum shl 8) or RegNum;
  asm
mov edx,$0cf8 //CONF_ADDR_REG
mov eax,resss
out dx,eax
mov edx,$0cfc //CONF_DATA_REG
mov eax,avv
out dx,eax
in eax,dx

mov edx,eax
shr eax,16
and eax,$0ff
sub eax,49
mov Temp,eax
end;
result:=temp
end;

function openIO:boolean;
begin
       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(ExtractFilePath(Application.ExeName)+'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(0));//ядро 1
  Label2.Caption :=IntToStr(ReadTemp(1));//ядро 2
  Timer1.Enabled :=True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 DoneDriver;
end;

end.

Код больше 2 ядер не поддерживает, собственно в спецификации данного семейства процов про больше чем 2 ядра ничего не говориться (в плане датчиков температуры)
У меня работает ок (сравнивал с данными эвереста), Win XP Pro Ru SP3 + DualCore AMD Athlon 64 X2 Black Edition, 6400+ Asus M2N68-AM SE2 (1 PCI, 1 PCI-E x1, 1 PCI-E x16, 2 DDR2 DIMM, Audio, Video, LAN)

Оба примера используют драйвер giveio.sys(стандартный скачанный на просторах нета) для доступа к портам, драйвер в папке с экзекой.

Это сообщение отредактировал(а) AugMaster - 6.10.2011, 07:46

Присоединённый файл ( Кол-во скачиваний: 16 )

Temperature.rar 421,27 Kb

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