← →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"е данные перестают обновляться и прога закроется.
Определение загрузки процессора перед запуском проги Найти похожие ветки
← →