Форум: "WinAPI";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.04.08;
Скачать: [xml.tar.bz2];




Вниз

Определение загрузки процессора перед запуском проги 


Tosov   (2002-02-06 16:18) [4]


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Gauge1: TGauge;
Timer1: TTimer;
Button1: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type SYSTEM_BASIC_INFORMATION=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
SYSTEM_PERFORMANCE_INFORMATION=record
liIdleTime : LARGE_INTEGER;
dwSpare : array[0..76] of DWORD;
end;

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

const
SystemBasicInformation =0;
SystemPerformanceInformation =2;
SystemTimeInformation =3;
var
Form1: TForm1;

function NtQuerySystemInformation(l:UINT;buff:Pointer;buffl:UINT;u:UINT):CARDINAL;stdcall;external "ntdll.dll";


implementation

{$R *.dfm}
function Li2Double(const x:LARGE_INTEGER):Double;
begin
Result:=x.HighPart*4.294967296E9 + x.LowPart;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
SysBaseInfo : SYSTEM_BASIC_INFORMATION;
SysTimeInfo : SYSTEM_TIME_INFORMATION;
SysPerfInfo : SYSTEM_PERFORMANCE_INFORMATION;
liOldIdleTime :LARGE_INTEGER;
liOldSystemTime :LARGE_INTEGER;
dbIdleTime :double;
dbSystemTime :double;
begin
liOldIdleTime.QuadPart:=0;
liOldSystemTime.QuadPart:=0;
if NtQuerySystemInformation(SystemBasicInformation,@SysBaseInfo,sizeof(SysBaseInfo),0)<>NO_ERROR
then exit;
repeat
if NtQuerySystemInformation(SystemTimeInformation,@SysTimeInfo,sizeof(SysTimeInfo),0)<>NO_ERROR
then exit;
if NtQuerySystemInformation(SystemPerformanceInformation,@SysPerfInfo,sizeof(SysPerfInfo),0)<>NO_ERROR
then exit;
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;

Gauge1.Progress:=Round(dbIdleTime);
end;
// store new CPU"s idle and system time
liOldIdleTime := SysPerfInfo.liIdleTime;
liOldSystemTime := SysTimeInfo.liKeSystemTime;


// wait one second
Sleep(1000);

Application.ProcessMessages;
if CheckBox1.Checked then exit;
until false;
end;

end.

Я не помню насколько близко к оригиналу я перевел, но по моему работало нормально (давно это было :)
На форме Gauge CheckBox и Button. В Gauge показывается загрузка проца (почти как в NT"шном таск менеджере). Прога вудет подвисать, т.к. не использовались потоки. При установке флажка в checkbox"е данные перестают обновляться и прога закроется.




Форум: "WinAPI";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.04.08;
Скачать: [xml.tar.bz2];




Наверх





Память: 0.72 MB
Время: 0.03 c
7-22859           Filat                 2002-01-09 13:08  2002.04.08  
Как переделать или что добавить в прогу, чтобы она работала на 2000 проф. и не требовала ntdll.dll, исходники есть.


3-22586           Роман Василенко       2002-03-08 11:56  2002.04.08  
Сохранение измененных посредством TQuery таблиц


4-22886           Котелок               2002-02-07 06:13  2002.04.08  
Api по Com порту и модему


3-22541           MVVD                  2002-03-14 10:04  2002.04.08  
Быстрота поиска


1-22626           Good Man              2002-03-27 19:04  2002.04.08  
Подскажите, где взять Grid?