1 Востаннє редагувалося koala (08.01.2015 23:19:15)

Тема: Отримання завантаження процесора в Delphi під Windows 7/8/8.1

Мене попросили розібратися в цьому питанні; зрештою, довелося (вперше за 10 з гаком років) встановлювати Delphi на власному компі, то не хочеться, щоб код загубився. Комусь точно буде корисним.
Трохи теорії: коли програмі більше нема роботи, вона може "відпочити" (повідомити системі, щоб найближчий час, чи до певної події, її не виконували). Якщо всі програми "відпочивають", то процесор простоює, економлячи електрику. Це можна більш-менш зручно переглянути в менеджері програм Windows (чи в Process Hacker, чи іншій програмі). Питання - як отримати значення відсотку бездії (чи, що те саме, значення завантаженості процесора, що дорівнює 100 мінус бездія) в програмі на Delphi? Всі форуми радять користуватися функцією NtQuerySystemInformation; але в останніх версіях Windows ця функція працює трохи не так, а виставляти сумісність зі старими системами - не добре. Тому ось мій код, що використовує GetSystemTimes (тільки суттєва частина):

Прихований текст

type
  TfrmMain = class(TForm)
    getCPU: TButton; {кнопка, що, власне, запускає що нам треба}
    edSleep: TEdit; {період для обчислення}
    tiRepeat: TTimer; {таймер для виставлення періоду}
    procedure getCPUClick(Sender: TObject);
    procedure tiRepeatTimer(Sender: TObject); 
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    kernel32 : HMODULE; {дескриптор dll}
    oldTime, oldIdle : double; {час і показник попереднього запиту}
    processors : integer; {кількість процесорів}

    procedure GetCPUUsage; {отримати завантаженість}
  public
    { Public declarations }
  end;

implementation

var
  GetNativeSystemInfo: {процедура для отримання загальної інформації про систему}
      procedure( var lpSystemInfo : _SYSTEM_INFO ); stdcall = nil;  {параметр - посилання на структуру}
  GetSystemTimes: {процедура для отримання інформації про завантаженість}
      procedure( var lpIdleTime,
                     lpKernelTime,
                     lpUserTime : _FILETIME ); stdcall = nil; {параметри - посилання на загальні часи, витрачені системою від запуску
                        на бездію, ядро системи і користувацькі процеси відповідно, в форматі _FILETIME}

function FT2Double( x: _FILETIME ): Double; {перетворення формату _FILETIME в Double в секундах}
begin
  Result := ( x.dwHighDateTime shl 32 + x.dwLowDateTime ) / 10000000;
end;

function TDT2Double( x: TDateTime ) : Double; {перетворення формату TDateTime в Double в секундах}
begin
  Result := x * 24 * 60 * 60;
end;

procedure TfrmMain.GetCPUUsage;
var
  idleTime, kernelTime, userTime: _FILETIME;
  currentTime, currentIdle, percent : double;

begin
  GetSystemTimes( idleTime, kernelTime, userTime ); {отримуємо дані завантаженості}
  currentIdle := FT2Double( idleTime ); {переводимо час, витрачений на недіяння системи, в секунди}
  currentTime := TDT2Double( Now ); { переводимо поточний час в секунди}
  {час недіяння по всім процесорам/ядрам сумується, тому треба ділити; решта ніби очевидо}
  percent := 100 * ( (currentIdle - oldIdle)/(currentTime-oldTime) ) / processors; 
  {вівід даних; якщо треба в іншому форматі чи вивести деінде - змінюйте тут}
  ShowMessage( Format( 'Бездіяльність за останні %3.4f секунди: %2.2f%%',
               [currentTime-oldTime, percent] ) );
{ якщо будете викликати цю функцію періодично - увімкніть ці рядки
  oldTime := currentTime; {запам'ятовуємо час і завантаженість для наступного виклику}
  oldIdle := currentIdle;
}
end;

procedure TfrmMain.FormCreate(Sender: TObject);
  SystemInfo : _SYSTEM_INFO; {системна структура для отримання загальної інформації - зокрема, про кількість процесорів}
begin

  kernel32 := GetModuleHandle( 'kernel32.dll' ); {під'єднуємо kernel32.dll}
  if kernel32 = 0 then begin
    ShowMessage('Не можу відкрити kernel32.dll, помилка ' + IntToStr(GetLastError) );
    Exit;
  end;

  GetNativeSystemInfo := GetProcAddress(kernel32, 'GetNativeSystemInfo'); {під'єднуємо процедуру GetNativeSystemInfo}
  if not Assigned( GetNativeSystemInfo ) then begin
    ShowMessage('Не можу під'єдантися до GetNativeSystemInfo, помилка ' + IntToStr(GetLastError) );
    Exit;
  end;
  GetNativeSystemInfo( SystemInfo ); {отримуємо кількість процесорів}
  processors := SystemInfo.dwNumberOfProcessors;

  GetSystemTimes := GetProcAddress(kernel32, 'GetSystemTimes');{під'єднуємо процедуру GetSystemTimes}
  if not Assigned( GetSystemTimes )then begin
    ShowMessage('Не можу під'єдантися до GetSystemTimes, помилка ' + IntToStr(GetLastError) );
    Exit;
  end;

end;

procedure TfrmMain.getCPUClick(Sender: TObject);
var delay: integer;
  idleTime, kernelTime, userTime: _FILETIME;
begin
  delay := StrToIntDef( edSleep.Text, 0 ); {читаємо час затримки}
  if delay = 0 then begin
    ShowMessage('Затримка - час в мілісекундах!');
    Exit;
  end;
  GetSystemTimes( idleTime, kernelTime, userTime ); {виставляємо час на початку затримки}
  oldIdle := FT2Double( idleTime );
  oldTime := TDT2Double( Now );
  tiRepeat.Interval := delay; {виставляємо затримку}
  tiRepeat.Enabled := true; {вмикаємо таймер}
end;

procedure TfrmMain.tiRepeatTimer(Sender: TObject);
var delay: integer;
begin
  delay := StrToIntDef( edSleep.Text, 0 );
  if delay = 0 then begin
    ShowMessage('Задержка должна быть числом больше 0 в милисекундах!');
    Exit;
  end;
  tiRepeat.Interval := delay;
  tiRepeat.Enabled := false;{вимкніть цей рядок, щоб постійно отримувати дані; при цьому обов'язково змініть останні рядки GetCPUUsage на те, що вам треба}
  GetCPUUsage; 
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeLibrary( kernel32 ); {при виході звільняємо dll - просто для порядку}
end;

end.

Подякували: 0xDADA11C7, A.N.Onim, Torbins4