Главная страница
    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.033 c
1-1108152524
GreySerg
2005-02-11 23:08
2005.02.27
Как узнать языковую версию Windows 2000, XP, 2003 ?


6-1102929897
Шишкин Илья
2004-12-13 12:24
2005.02.27
Сеть в WinApi приложении


1-1108402517
Гость
2005-02-14 20:35
2005.02.27
Почему не прорисовывается форма?


14-1107471384
Чайник
2005-02-04 01:56
2005.02.27
Кто знает где скачать документацию PhotoshopSDK


14-1107530105
Pat
2005-02-04 18:15
2005.02.27
Колонтитулы в Excel е





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