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

neweraser

Дата 1.4.2008, 17:34 (ссылка)

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

Загрузка ...

Опытный

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

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

Как можно программно узнать температуру и загрузку процессора? и еще, можно это все как-нибудь считать с реестра?

Это сообщение отредактировал(а) neweraser - 2.4.2008, 17:08

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

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

neweraser

Дата 2.4.2008, 17:08 (ссылка)

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

Загрузка ...

Опытный

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

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

Неужели нельзя?

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

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

Rennigth

Дата 2.4.2008, 17:29 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

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

Цитата(neweraser @ 1.4.2008, 17:34

)

загрузку процессора

Загрузку не сложно, алгоритм вроде реализован в програмке ProcessMon или ProcessHunter, точно не помню, но в сети легко найти.
Температуру сложнее, тут врятли WMI даже поможет, нужно отдельно подходить к разным типам материнок.
п.с. Хотя это конечно имхо... плотно этим никогда не занималься

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

(* Honesta mors turpi vita potior *)

neweraser

Дата 2.4.2008, 18:47 (ссылка)

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

Загрузка ...

Опытный

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

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

а к какому ключу в реестре нужно обращаться, и как это вообще реализовать, не подскажете?

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

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

SandyProgrammer

Дата 2.4.2008, 19:20 (ссылка)

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

Загрузка ...

Новичок

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

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

У меня есть вот такой вот код:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, OleServer, WbemScripting_TLB, ActiveX,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListView1: TListView;
    SWbemLocator1: TSWbemLocator;
    Bevel1: TBevel;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    ListView2: TListView;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    procedure ShowProp(SProp: ISWbemProperty);
    procedure GetProp(Win32ClassName: string; ListNum: integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ListItem:   TListItem;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetProp('Win32_Fan', 1);
end;

procedure TForm1.GetProp(Win32ClassName: string; ListNum: integer);
var
  Service:             ISWbemServices;
  ObjectSet:           ISWbemObjectSet;
  SObject:             ISWbemObject;
  PropSet:             ISWbemPropertySet;
  SProp:               ISWbemProperty;

  PropEnum, Enum:      IEnumVariant;
  TempObj:             OleVariant;
  Value:               Cardinal;
  Column:              TListColumn;
  ListView:            TListView;
begin
  if ListNum = 1 then
    ListView:= ListView1
  else
    ListView:= ListView2;

  StatusBar1.SimpleText:= ' in progress';
  ListView.Items.BeginUpdate;
  ListView.Items.Clear;

  Service:= SWbemLocator1.ConnectServer('.', 'rootCIMV2', '', '', '',
      '', 0, nil);

  SObject:= Service.Get(Win32ClassName, wbemFlagUseAmendedQualifiers, nil);
  ObjectSet:= SObject.Instances_(0, nil);
  Enum:= (ObjectSet._NewEnum) as IEnumVariant;

  if (Enum.Next(1, TempObj, Value) = S_FALSE)  then
  begin
    MessageBox(0, PChar('Отсутствует провайдер или требуемое устройство.'), PChar(Form1.Caption), MB_OK);
    ListView.Items.EndUpdate;
    StatusBar1.SimpleText:= ' Done';
    exit;
  end;

  while (Enum.Next(1, TempObj, Value) = S_OK) do
  begin
    SObject:= IUnknown(TempObj) as SWBemObject;
    PropSet:= SObject.Properties_;
    PropEnum:= (PropSet._NewEnum) as IEnumVariant;
    ListItem:= ListView.Items.Add;
  // начинаю перебирать свойства
    StatusBar1.SimpleText:= StatusBar1.SimpleText + '.';
    while (PropEnum.Next(1, TempObj, Value) = S_OK) do
    begin
      SProp:= IUnknown(TempObj) as SWBemProperty;
      if ListView.Items.Count = 1 then
      begin
        Column:= ListView.Columns.Add;
        Column.Width:= 100;
        Column.Caption:= SProp.Name;
      end;
      ShowProp(SProp);
    end;
  end; { while }
  ListView.Items.EndUpdate;
  StatusBar1.SimpleText:= ' Done';
end;

procedure TForm1.ShowProp(SProp: ISWbemProperty);
var
  StrValue: string;
  Count: Cardinal;
begin
  StrValue:= '';
  if VarIsNull(SProp.Get_Value) then
    StrValue:= '<empty>'
  else
    case SProp.CIMType of
//******************************************************************//
      wbemCimtypeUint8, wbemCimtypeSint8, wbemCimtypeUint16, wbemCimtypeSint16,
      wbemCimtypeUint32, wbemCimtypeSint32, wbemCimtypeSint64:
      if VarIsArray(SProp.Get_Value) then
      begin
        if VarArrayHighBound(SProp.Get_Value, 1) > 0 then
          for Count:= 1 to VarArrayHighBound(SProp.Get_Value, 1) do
            StrValue:= StrValue + ' ' + IntToStr(SProp.Get_Value[Count]);
      end
      else
        StrValue:= IntToStr(SProp.Get_Value);
//******************************************************************//
      wbemCimtypeReal32, wbemCimtypeReal64:
        StrValue:= FloatToStr(SProp.Get_Value);
//******************************************************************//
      wbemCimtypeBoolean:
        if SProp.Get_Value then
          StrValue:= 'True'
        else
          StrValue:= 'False';
//******************************************************************//
        wbemCimtypeString, wbemCimtypeUint64:
          if VarIsArray(SProp.Get_Value) then
          begin
            if VarArrayHighBound(SProp.Get_Value, 1) > 0 then
              for Count := 1 to VarArrayHighBound(SProp.Get_Value, 1) do
                StrValue:= StrValue + ' ' + SProp.Get_Value[Count];
          end
          else
            StrValue:=  SProp.Get_Value;
//******************************************************************//
        wbemCimtypeDatetime:
          StrValue:=  SProp.Get_Value;
//******************************************************************//
        wbemCimtypeReference:
        begin
//
        end;
//******************************************************************//
          wbemCimtypeChar16:
            StrValue:= '16-bit char';
//******************************************************************//
          wbemCimtypeObject:
            StrValue:= 'CIM Object';
//******************************************************************//
      else
        MessageBox(0, PChar('Unknown type'), PChar(Form1.Caption), MB_OK);
    end; {case}
    if ListItem.Caption = '' then
      ListItem.Caption := StrValue
    else
      ListItem.SubItems.Add(StrValue);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  GetProp('Win32_TemperatureProbe', 2);
end;
end.

Но он не работает, при нажатии на Button1 пишет: "Недопустимое пространство имён". Для использования этого кода нужно установить Microsoft WMI Scripting, об этом можно почитать здесь: http://homepage3.nifty.com/KENCH/open/wmi/delphi_wmi.htm

neweraser

Дата 2.4.2008, 19:53 (ссылка)

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

Загрузка ...

Опытный

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

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

а просто, если обратиться к реестру?

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

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

SandyProgrammer

Дата 2.4.2008, 20:16 (ссылка)

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

Загрузка ...

Новичок

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

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

На счёт реестра я не знаю...

neweraser

Дата 2.4.2008, 20:39 (ссылка)

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

Загрузка ...

Опытный

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

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

вот, нашел что-то, пример от Romikgy

Код


const  
  SystemBasicInformation = 0;  
  SystemPerformanceInformation = 2;  
  SystemTimeInformation = 3;  

type  
  TPDWord = ^DWORD;  

  TSystem_Basic_Information = packed record  
    dwUnknown1: DWORD;  
    uKeMaximumIncrement: ULONG;  
    uPageSize: ULONG;  
    uMmNumberOfPhysicalPages: ULONG;  
    uMmLowestPhysicalPage: ULONG;  
    uMmHighestPhysicalPage: ULONG;  
    uAllocationGranularity: ULONG;  
    pLowestUserAddress: Pointer;  
    pMmHighestUserAddress: Pointer;  
    uKeActiveProcessors: ULONG;  
    bKeNumberProcessors: byte;  
    bUnknown2: byte;  
    wUnknown3: word;  
  end;  

type  
  TSystem_Performance_Information = packed record  
    liIdleTime: LARGE_INTEGER; {LARGE_INTEGER}  
    dwSpare: array[0..75] of DWORD;  
  end;  

type  
  TSystem_Time_Information = packed record  
    liKeBootTime: LARGE_INTEGER;  
    liKeSystemTime: LARGE_INTEGER;  
    liExpTimeZoneBias: LARGE_INTEGER;  
    uCurrentTimeZoneId: ULONG;  
    dwReserved: DWORD;  
  end;  

var  
  NtQuerySystemInformation: function(infoClass: DWORD;  
    buffer: Pointer;  
    bufSize: DWORD;  
    returnSize: TPDword): DWORD; stdcall = nil;  


  liOldIdleTime: LARGE_INTEGER = ();  
  liOldSystemTime: LARGE_INTEGER = ();  

function Li2Double(x: LARGE_INTEGER): Double;  
begin  
  Result := x.HighPart * 4.294967296E9 + x.LowPart  
end;  

procedure GetCPUUsage;  
var  
  SysBaseInfo: TSystem_Basic_Information;  
  SysPerfInfo: TSystem_Performance_Information;  
  SysTimeInfo: TSystem_Time_Information;  
  status: Longint; {long}  
  dbSystemTime: Double;  
  dbIdleTime: Double;  

  bLoopAborted : boolean;  

begin  
  if @NtQuerySystemInformation = nil then  
    NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),  
      'NtQuerySystemInformation');  

  // get number of processors in the system  

  status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil);  
  if status <> 0 then Exit;  

  // Show some information  
  with SysBaseInfo do  
  begin  
      ShowMessage(  
      Format('uKeMaximumIncrement: %d'#13'uPageSize: %d'#13+  
      'uMmNumberOfPhysicalPages: %d'+#13+'uMmLowestPhysicalPage: %d'+#13+  
      'uMmHighestPhysicalPage: %d'+#13+'uAllocationGranularity: %d'#13+  
      'uKeActiveProcessors: %d'#13'bKeNumberProcessors: %d',  
      [uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages,  
      uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity,  
      uKeActiveProcessors, bKeNumberProcessors]));  
  end;  


  bLoopAborted := False;  

  while not bLoopAborted do  
  begin  

    // get new system time  
    status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0);  
    if status <> 0 then Exit;  

    // get new CPU's idle time  
    status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil);  
    if status <> 0 then Exit;  

    // if it's a first call - skip it  
    if (liOldIdleTime.QuadPart <> 0) then  
    begin  

      // CurrentValue = NewValue - OldValue  
      dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime);  
      dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);  

      // CurrentCpuIdle = IdleTime / SystemTime  
      dbIdleTime := dbIdleTime / dbSystemTime;  

      // CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors  
      dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;  

      // Show Percentage  
      Form1.Label1.Caption := FormatFloat('CPU Usage: 0.0 %',dbIdleTime);  

      Application.ProcessMessages;  

      // Abort if user pressed ESC or Application is terminated  
      bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated;  

    end;  

    // store new CPU's idle and system time  
    liOldIdleTime := SysPerfInfo.liIdleTime;  
    liOldSystemTime := SysTimeInfo.liKeSystemTime;  

    // wait one second  
    Sleep(1000);  
  end;  
end;  


procedure TForm1.Button1Click(Sender: TObject);  
begin  
  GetCPUUsage  
end;

только не доходит, как вытащить отсюда только загрузку проц.?

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

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

neweraser

Дата 2.4.2008, 21:19 (ссылка)

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

Загрузка ...

Опытный

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

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

в той же теме есть пример взятия загрузки из реестра, т.е.

Цитата

Читать из реестра HKEY_DYN_DATA\PerfStats\StatData соответствующий ключ Kernel \CPUUsage

но это, скорее всего, для ранних версий windows, вот бы узнать ключик реестра для XP...

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

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

MetalFan

Дата 3.4.2008, 11:23 (ссылка)

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

Загрузка ...

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

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

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

Цитата(neweraser @ 2.4.2008, 21:19

)

вот бы узнать ключик реестра для XP...

см. HKEY_PERFORMANCE_DATA

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

There are always someone smarter than you...

neweraser

Дата 3.4.2008, 17:08 (ссылка)

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

Загрузка ...

Опытный

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

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

а в какой ветви он находится? Что-то не могу найти

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

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

MetalFan

Дата 3.4.2008, 21:08 (ссылка)

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

Загрузка ...

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

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

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

а как ты его ищешь?

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

There are always someone smarter than you...

neweraser

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

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

Загрузка ...

Опытный

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

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

как обычно, пуск>выполнить>regedit, там нет ничего насчет HKEY_PERFORMANCE_DATA

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

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

MetalFan

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

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

Загрузка ...

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

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

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

ну а ты как думал???
в мсдн же русским языком написано

Цитата(MSDN)

The data is not actually stored in the registry; the registry functions cause the system to collect the data from its source.

Это сообщение отредактировал(а) MetalFan - 6.4.2008, 22:39

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

There are always someone smarter than you...

neweraser

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

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

Загрузка ...

Опытный

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

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

Цитата(MetalFan @ 6.4.2008, 22:38

)

The data is not actually stored in the registry; the registry functions cause the system to collect the data from its source.

не понимаю... и что такое MSDN?

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

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

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