Форум: "WinAPI";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];
ВнизКак узнать загрузку процессора? Найти похожие ветки
← →
YuS (2009-03-10 05:01) [0]Уважаемые мастера, подскажите, как можно программно узнать процент загрузки процессора(ЦП).
← →
Rouse_ © (2009-03-10 11:46) [1]http://rouse.drkb.ru/winapi.php#taskmon
← →
DVM © (2009-03-10 21:42) [2]
unit cpusage;
interface
uses windows, messages;
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 GetCPUUsage: Double;
implementation
//------------------------------------------------------------------------------
function Li2Double(x: LARGE_INTEGER): Double;
begin
Result := x.HighPart * 4.294967296E9 + x.LowPart
end;
//------------------------------------------------------------------------------
function GetCPUUsage: Double;
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");
if @NtQuerySystemInformation = nil then exit;
status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil);
if status <> 0 then exit;
status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0);
if status <> 0 then Exit;
status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil);
if status <> 0 then Exit;
liOldIdleTime := SysPerfInfo.liIdleTime;
liOldSystemTime := SysTimeInfo.liKeSystemTime;
sleep(1000);
status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0);
if status <> 0 then Exit;
status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil);
if status <> 0 then Exit;
dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime);
dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);
dbIdleTime := dbIdleTime / dbSystemTime;
dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;
result := dbIdleTime;
end;
//------------------------------------------------------------------------------
end.
← →
DVM © (2009-03-10 21:43) [3]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, cpusage;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := floattostr(GetCPUUsage);
end;
end.
← →
Denis__ © (2009-03-18 14:31) [4]Щас начнут говорить, что "показывает не так, как диспетчер задач"
← →
DVM © (2009-03-18 19:46) [5]
> Denis__ © (18.03.09 14:31) [4]
Да нет, у меня практически также получалось.
Страницы: 1 вся ветка
Форум: "WinAPI";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.058 c