Форум: "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.051 c
1-22636           MMarat                2002-03-27 12:31  2002.04.08  
---|Ветка была без названия|---


4-22882           Pete                  2002-02-05 15:54  2002.04.08  
Окно поверх всего и...


1-22723           Goblinus              2002-03-26 19:52  2002.04.08  
ComboBox


3-22554           Sergant               2002-03-15 15:50  2002.04.08  
Не могу совладать c EhLib 2.1


1-22656           Kurt                  2002-03-28 11:51  2002.04.08  
Народ помогите плиз! Вопрос, как узнать ай-пишник машины?