Главная страница
    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.019 c
2-1149092376
Loginov Dmitry
2006-05-31 20:19
2006.06.18
Работа с пакетами


15-1148124508
Другой
2006-05-20 15:28
2006.06.18
Может ли один программист создать Информационную Систему?


15-1147874944
flad
2006-05-17 18:09
2006.06.18
как задать в командной строке "Wordpad file.txt" то что


15-1148233357
Ig
2006-05-21 21:42
2006.06.18
Поговорим об играх..


1-1147354573
vidiv
2006-05-11 17:36
2006.06.18
Формулы в Edit





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский