Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2006.06.18;
Скачать: [xml.tar.bz2];

Вниз

CPU Usage   Найти похожие ветки 

 
KALqYAN   (2006-03-20 14:21) [0]

Подскажите пожалуйста, как определить степень загрузки ЦП???


 
Rouse_ ©   (2006-03-20 14:29) [1]

http://rouse.front.ru/taskmon.zip


 
Handle   (2006-03-20 15:31) [2]

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
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;
type
 TForm1 = class(TForm)
   Label1: TLabel;
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 NtQuerySystemInformation: function(infoClass: DWORD;
   buffer: Pointer;
   bufSize: DWORD;
   returnSize: TPDword): DWORD; stdcall = nil;

 liOldIdleTime: LARGE_INTEGER = ();
 liOldSystemTime: LARGE_INTEGER = ();
implementation

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

procedure GetCPUUsage;
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");
 status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo,
   SizeOf(SysBaseInfo), nil);
 if status <> 0 then
   Exit;
 with SysBaseInfo do
 begin
   ShowMessage(
     Format("uKeMaximumIncrement: %d"#13"uPageSize: %d"#13   +
     "uMmNumberOfPhysicalPages: %d" + #13 + "uMmLowestPhysicalPage: %d" + #13 +
     "uMmHighestPhysicalPage: %d" + #13 + "uAllocationGranularity: %d"#13 +
     "uKeActiveProcessors: %d"#13"bKeNumberProcessors: %d"  ,
     [uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages,
     uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity,
       uKeActiveProcessors, bKeNumberProcessors]));
 end;
 bLoopAborted := False;
 while not bLoopAborted do
 begin
   status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo,
     SizeOf(SysTimeInfo), 0);
   if status <> 0 then
     Exit;
   status := NtQuerySystemInformation(SystemPerformanceInformation,
     @SysPerfInfo, SizeOf(SysPerfInfo), nil);
   if status <> 0 then
     Exit;
   if (liOldIdleTime.QuadPart <> 0) then
   begin
     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;
     Form1.Label1.Caption := FormatFloat("CPU Usage: 0.0 %", dbIdleTime);
     Application.ProcessMessages;
     bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or
       Application.Terminated;
   end;
   liOldIdleTime := SysPerfInfo.liIdleTime;
   liOldSystemTime := SysTimeInfo.liKeSystemTime;
   Sleep(1000);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GetCPUUsage

end;

end.


 
VirEx ©   (2006-03-20 22:18) [3]

function GetCPUSpeed: Double;
const

DelayTime = 500;
var

TimerHi : DWORD;
TimerLo : DWORD;
PriorityClass : Integer;
Priority : Integer;
begin

PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);

asm
DW 310Fh // rdtsc
MOV TimerLo, EAX
MOV TimerHi, EDX
end;

Sleep(DelayTime);

asm
DW 310Fh // rdtsc
SUB EAX, TimerLo
SBB EDX, TimerHi
MOV TimerLo, EAX
MOV TimerHi, EDX
end;

SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);

Result := TimerLo / (1000.0 * DelayTime);
end;

===========================================
// Usage ...

LabelCPUSpeed.Caption := Format("CPU speed: %f MHz", [GetCPUSpeed]);



Страницы: 1 вся ветка

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

Наверх




Память: 0.46 MB
Время: 0.012 c
2-1148990487
Std
2006-05-30 16:01
2006.06.18
Напоминалка


2-1148893538
Mozgan
2006-05-29 13:05
2006.06.18
Защита файла от удаления


15-1148799853
Ega23
2006-05-28 11:04
2006.06.18
С Днём рождения! 27 мая


2-1148826660
Галинка
2006-05-28 18:31
2006.06.18
Вопрос к TUser и остальным знатокам ООП (навеяно соседней веткой)


4-1142930728
Nike
2006-03-21 11:45
2006.06.18
использование ToolHelp на WinNT





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский