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

Вниз

Процессор   Найти похожие ветки 

 
Oddin ©   (2005-01-13 22:24) [0]

Здраствуйте. Как можно вывести загруженность процессора в ProgressBar или Gauge и обновлять результаты загрузки процессора  через определенный интервал времени.


 
bulkas   (2005-01-13 22:44) [1]


procedure TForm1.Timer1Timer(Sender: TObject);

var m: TMemoryStatus; temp: integer;

begin m.dwLength:=sizeof(m);

GlobalMemoryStatus(m);

with m do begin //Загруженность памяти

label1.caption:=IntToStr (dwMemoryLoad)+" %"; // Всего физической

label2.caption:=IntToStr (dwTotalPhys)+" байт"; // Свободно физической

label3.caption:=IntToStr (dwAvailPhys)+" байт"; // Всего страничной

label4.caption:=IntToStr (dwTotalPageFile)+" байт"; // Свободно страничной

label5.caption:=IntToStr (dwAvailPageFile)+" байт"; // Всего выиртуальной

label6.caption:=IntToStr (dwTotalVirtual)+" байт"; //Свободно виртуальной

label7.caption:=IntToStr (dwAvailVirtual)+" байт"; //Загруженность на ProgressBar1

progressbar1.Max:= dwTotalPhys;

progressbar1.Position:=dwTotalPhys-dwAvailPhys;

end;

end;



 
Вариант ©   (2005-01-14 17:14) [2]

Можно читать из реестра HKEY_DYN_DATA\PerfStats\StatData соответствующий ключ Kernel \CPUUsage(самый быстрый вариант).
Но можно и другим способом:
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;
   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 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;

 // Show some information
 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;

   //достаём новое значение CPU
   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;

     //Останавить процесс при нажатиии на Escape(необязательно)
     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;



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

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

Наверх




Память: 0.47 MB
Время: 0.116 c
6-1103016904
Змей
2004-12-14 12:35
2005.02.27
Chat


1-1108534328
hgd
2005-02-16 09:12
2005.02.27
Копирование "поверхности" компонента


1-1108542363
Игорь нтк
2005-02-16 11:26
2005.02.27
как сохранить выбор кнопки из radiogroup


4-1105013665
ScrewDriver
2005-01-06 15:14
2005.02.27
Проблема выгрузки DLL


1-1108022785
O.O
2005-02-10 11:06
2005.02.27
Смена шрифтов





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