Как узнать загрузку процессора (NT – 2000 - XP)

Delphi , ОС и Железо , Процессор

Автор: http://www.swissdelphicenter.ch

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 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');

  // get number of processors in the system

  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

    // get new system time
    status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo,
      SizeOf(SysTimeInfo), 0);
    if status <> 0 then
      Exit;

    // get new CPU's idle time
    status := NtQuerySystemInformation(SystemPerformanceInformation,
      @SysPerfInfo, SizeOf(SysPerfInfo), nil);
    if status <> 0 then
      Exit;

    // if it's a first call - skip it
    if (liOldIdleTime.QuadPart <> 0) then
    begin

      // CurrentValue = NewValue - OldValue
      dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) -
        Li2Double(liOldIdleTime);
      dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) -
        Li2Double(liOldSystemTime);

      // CurrentCpuIdle = IdleTime / SystemTime
      dbIdleTime := dbIdleTime / dbSystemTime;

      // CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors
      dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors
        + 0.5;

      // Show Percentage
      Form1.Label1.Caption := FormatFloat('CPU Usage: 0.0 %', dbIdleTime);

      Application.ProcessMessages;

      // Abort if user pressed ESC or Application is terminated
      bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or
        Application.Terminated;

    end;

    // store new CPU's idle and system time
    liOldIdleTime := SysPerfInfo.liIdleTime;
    liOldSystemTime := SysTimeInfo.liKeSystemTime;

    // wait one second
    Sleep(1000);
  end;
end;

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

Программа на Delphi, которая использует функцию Windows API NtQuerySystemInformation для получения информации о системе, включая использование процессора.

Программа определяет три типа записей:

• TSystem_ Basic_ Information: представляет собой основную информацию о системе,such as количество процессоров, размер страницы и гранулярность распределения.
• TSystem_Performance_Information: представляет собой информацию о производительности системы, such as время простоя.
• TSystem_Time_Information: представляет собой информацию о времени, связанную с системой, such as время запуска и текущий часовой пояс.

Программа использует цикл для повторного получения информации о системе, вызывая NtQuerySystemInformation с различными классами информации (например, SystemPerformanceInformation, SystemTimeInformation). Она рассчитывает использование процессора, вычитая предыдущее время простоя из нового времени простоя, дели на разницу в системном времени и умножая на 100.

Программа отображает использование процессора в виде процента на форме. Цикл продолжается до тех пор, пока пользователь не нажмет клавишу ESC или приложение не будет остановлено.

Вот некоторые предложения по улучшению:

1. Обработка ошибок: программа предполагает, что NtQuerySystemInformation всегда возвращает корректный результат, но на самом деле она может fail, если система занята или возникла ошибка. Нужно добавить правильную обработку ошибок для таких случаев.
2. Выполнение: цикл может быть слишком частым и может вызвать проблемы с производительностью. Можно рассмотреть уменьшение частоты обновлений или использование более эффективного способа расчета использования процессора.
3. Организация кода: процедура GetCPUUsage является quite длинной и выполняет несколько задач, включая получение системной информации, расчет использования процессора и обновление формы. Лучше было бы разбить ее на более маленькие процедуры с конкретными ответственностями.

Вот альтернативное решение, использующее более современный подход:

uses
  Winapi.Windows,
  Winapi.Psapi;

const
  PROCESSOR_INFO_CLASS = $0004;
  CPU_USAGE_PERCENTAGE = 100.0;

var
  hProcess: THandle;
  cpuUsage: Double;

procedure GetCPUUsage;
begin
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, GetCurrentProcessId);
  if hProcess > 0 then
  begin
    Try
      cpuUsage := GetProcessCpuUsage(hProcess);
      CloseHandle(hProcess);
    Except
      On E: Exception do
        ShowMessage('Error: ' + E.Message);
    End;
  end;
end;

function GetProcessCpuUsage(processHandle: THandle): Double;
var
  buffer: TProcessCpuUsageBuffer;
begin
  ZeroMemory(@buffer, SizeOf(TProcessCpuUsageBuffer));
  if not GetProcessTimes(handle, @buffer) then
    Result := -1.0
  else
    Result := (buffer.CpuUsage / CPU_USAGE_PERCENTAGE);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetCPUUsage;
  Form1.Label1.Caption := FormatFloat('CPU Usage: %.2f %%', cpuUsage);
end;

В этом коде используется функция GetProcessCpuUsage из Windows API для получения использования процессора текущего процесса. Затем обновляется метка на форме с использованием процента.

Обратите внимание, что это код предполагает, что у вас есть необходимые разрешения для чтения информации о использовании процессора, и что система работает под Windows Vista или позднее (поскольку более ранние версии не предоставляют этой информации).

Как узнать загрузку процессора в ОС NT, XP и других операционных системах.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Процессор ::