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

Dreyka

Дата 11.8.2004, 09:11 (ссылка)

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

Загрузка ...

Новичок

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

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

Привет всем!!!
Хочу узнать загрузку процессора, но не могу открыть ключ реестра...

<Spawn>

Дата 11.8.2004, 12:22 (ссылка)

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

Загрузка ...

Око кары:)

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

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

Код в подобных вопросах очень приветствуется...

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

"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.

Дата 11.8.2004, 12:35 (ссылка)

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

Загрузка ...

Брутальный буратина

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

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

http://www.aldyn.ru/demos/0017/CpuUsage.zip

Dreyka

Дата 11.8.2004, 14:51 (ссылка)

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

Загрузка ...

Новичок

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

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

Вот код

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Registry, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TKernelInfo = record
  CpuUsagePcnt:dword;
  Numthreads:dword;
  NumVMS:dword;
end;

type
  TSysInfo = class(TComponent)
  private
   fDialupAdapterInfo:TDialupAdapterInfo;
   fKernelInfo:TKernelInfo;
   ftimer:TTimer;
   fupdateinterval:integer;
   tmp:dword;
   vsize:dword;
   pkey:hkey;
   regtype:pdword;
   fstopped:boolean;
   procedure fupdatinginfo(sender:tobject);
   procedure fsetupdateinterval(aupdateinterval:integer);
  protected
   fsysInfoChanged:TNotifyEvent;
  public
   constructor Create(Aowner:Tcomponent);override;
   destructor  Destroy;override;

   property DialupAdapterInfo: TDialupAdapterInfo read fDialupAdapterInfo;
   property KernelInfo: TKernelInfo read fKernelInfo;
   procedure StartRecievingInfo;
   procedure StopRecievingInfo;
  published
   property SysInfoChanged:TNotifyEvent read fsysInfoChanged write
    fsysInfoChanged;//Это событие вызывается после определённого интервала времени.
   property UpdateInterval:integer read fupdateInterval write
    fsetupdateinterval default 5000;
  end;
var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TSysInfo.Create(Aowner:Tcomponent);
begin
inherited;
ftimer:=ttimer.Create(self);
ftimer.enabled:=false;
ftimer.OnTimer:=fupdatinginfo;
vsize:=4;
fstopped:=true;
StartRecievingInfo;
end;

procedure TSysInfo.startrecievingInfo;
var
 res:integer;
begin
 res:=RegOpenKeyEx(HKEY_DYN_DATA,'PerfStats\StartStat',0,KEY_ALL_ACCESS,pkey);
 if res<>0 then
   raise exception.Create('Could not open registry key');
 fstopped:=false;

 RegQueryValueEx(pkey,'KERNEL\CPUUsage',nil,regtype,@tmp,@vsize);
 RegCloseKey(pkey);
 ftimer.enabled:=true;
end;

procedure tsysinfo.fupdatinginfo(sender:tobject);
var
  res:integer;
begin
 res:=RegOpenKeyEx(HKEY_DYN_DATA,'PerfStats\StatData',0,KEY_ALL_ACCESS,pkey);
 if res<>0 then
   raise exception.Create('Could not open registry key');

 RegQueryValueEx(pkey,'KERNEL\CPUUsage',nil,regtype,@fkernelinfo.cpuusagepcnt,@vsize);
 RegCloseKey(pkey);
 if assigned(SysInfoChanged) then
 SysInfoChanged(self);
end;

procedure TSysInfo.stoprecievingInfo;
var
 res:integer;
begin
 res:=RegOpenKeyEx(HKEY_DYN_DATA,'PerfStats\StopStat',0,KEY_ALL_ACCESS,pkey);
 if not fstopped then
   begin
    if res<>0 then
     raise exception.Create('Could not open registry key');
    
    RegQueryValueEx(pkey,'KERNEL\CPUUsage',nil,regtype,@tmp,@vsize);
    RegCloseKey(pkey);
    ftimer.enabled:=false;
    fstopped:=true;
  end;
end;

procedure tsysinfo.fsetupdateinterval(aupdateinterval:integer);
begin
 if (ftimer<>nil) and(aupdateinterval>0) then
   begin
     ftimer.Interval:=aupdateinterval;
     fupdateinterval:=aupdateinterval;
   end;
 if (ftimer<>nil) and(aupdateinterval=0) then
 begin
   ftimer.Interval:=500;
   fupdateinterval:=500;
 end;
end;

destructor tsysinfo.Destroy;
begin
 StopRecievingInfo;
 ftimer.Destroy;
 inherited;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TSysInfo]);
end;

Это сообщение отредактировал(а) Dreyka - 11.8.2004, 14:54

Dreyka

Дата 13.8.2004, 15:17 (ссылка)

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

Загрузка ...

Новичок

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

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

По моему я всё понял

Этот код работает только на 9x и миллениум, я проверил это у знакомого...

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