unit MeasureWin;

{
   Модуль измерения процессорного времени,
затраченного программой, в среде Win32.

   Возможно повышение приоритета программы
на время измерений с целью снижения влияния
переключения задач на точность результата.

Для повышения приоритета установить:
   AllowSetPriority = true;

Предупреждение:
   При повышении приоритета возможно зависание
операционной системы на время измерений.

   Исправлены ошибки обработки больших интервалов
времени. Добавлена возможность учета времени ядра,
потраченного на обслуживание приложения.
   Устанавливаемый приориет текущей нити повышен до
критического (TIME_CRITICAL)

Автор:
   Образцов Илья.
   23.03.2007.
   
Факультет Прикладной Математики и Компьютерных Технологий, ВГПУ.
}

interface

uses
  Windows;

const
  AllowSetPriority = true;

  UseKernelTimeCounter = true;

{
Использование

  ...
  StartTimer;       (*Начало измерения*)
  ...
  (*Исследуемый участок программы*)
  ...
  StopTimer;        (*Окончание измерения*)
  ...
  Time := GetTime;  (*Получение результата в миллисекундах *)
}

procedure StartTimer;
{Процедура запуска измерений}

procedure StopTimer;
{Процедура остановки измерений}

function GetTime: real;
{Возврат полученного значения}
{Возвращаемое значение в миллисекундах}


implementation

var
  TT1, TT2, TK1, TK2: _FILETIME;
  ProcessHandle: cardinal;

function ProcessTime(H, L: DWORD): real;
{Процедура преобразования времени}
{Получаемый результат - сотни наносекунд}

var
  Pre: real;

begin
  Pre := exp(32*ln(2));
  Pre := Pre * H;

  ProcessTime := Pre + L

end;

procedure StartTimer;
{Процедура запуска измерений}
var
  P1, P2: _FILETIME;

begin
  ProcessHandle := GetCurrentProcess;

  if AllowSetPriority then begin
    SetPriorityClass(GetCurrentProcess,REALTIME_PRIORITY_CLASS);
    SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL)

  end;

  GetProcessTimes(ProcessHandle, P1, P2, TK1, TT1)

end;

procedure StopTimer;
{Процедура остановки измерений}
var
  P1, P2: _FILETIME;

begin
  GetProcessTimes(ProcessHandle, P1, P2, TK2, TT2);

  if AllowSetPriority then begin
    SetPriorityClass(GetCurrentProcess,NORMAL_PRIORITY_CLASS);
    SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_NORMAL)

  end

end;

function GetTime: real;
{Возврат полученного значения}
var
  CurTime, Time: real;

begin
  Time := ProcessTime(TT1.dwHighDateTime, TT1.dwLowDateTime);
  if UseKernelTimeCounter then
    Time := Time + ProcessTime(TK1.dwHighDateTime, TK1.dwLowDateTime);

  CurTime := ProcessTime(TT2.dwHighDateTime, TT2.dwLowDateTime);
  if UseKernelTimeCounter then
    CurTime := CurTime + ProcessTime(TK2.dwHighDateTime, TK2.dwLowDateTime);

  Time := CurTime - Time;
  GetTime := Time / 10000
  {Перевод ркзультата в миллисекунды}

end;

end.
 