Внимание !!!

При работе под Windows задача определения точного времени выполнения программы в общем случае не имеет решения... Дело в том, что в Windows существует планировщик заданий, который может в любой момент переключиться с Вашего приложения на другое. MSDN советует не делать никаких предположений о моменте переключения задач, следовательно, всегда существует вероятность того, что в определенный момент времени после запоминания начального этапа работы программы, но перед запоминанием конечного этапа произойдет вытеснение Вашей задачи планировщиком, и результат засекания времени окажется непредсказуемым...

Будем надеяться, что этого не произойдет...

Использование процедуры GetTime

Function GetTime: LongInt;
Var h, m, s, ms: Word;
begin
  Dos.GetTime(h, m, s, ms);
  GetTime := ms + 100 * (s + 60 * (m + 60 * h));
end;

...
{ Вызывать вот так: }
start := GetTime;
  ... { Здесь - алгоритм, время выполнения которого надо замерить }
WriteLn('Время выполнения = ', GetTime - start);
...

Работа с ячейкой памяти $0000:$046C

Var time: LongInt;
...

time := MemL[0:$046C];
  ... { Здесь - собственно программа }
time := MemL[0:$046C] - Time;

If time < 0 Then time := time + $1800B0;
WriteLn('Время выполнения = ', (time / 18.2):6:2);
...

Использование счетчика тактов процессора (RDTSC)

        .MODEL LARGE
        .CODE
        .386c
PUBLIC  READTSC
READTSC PROC FAR
        enter 0, 0
        push ds
        db   0fh, 31h; RDTSC opcode
        mov  bx, ss:[bp+8]
        mov  ds, bx
        mov  bx, ss:[bp+6]
        mov  [bx], eax
        mov  [bx+4], edx
        pop ds
        leave
        retf 4
READTSC ENDP
        END

{$N+}

procedure ReadTSC(Var counter : Comp); far; external;
{$L tsc.obj}

Var a1, a2, a3 : Comp;
begin
   ReadTSC(a1);
   Writeln('Working :)'); { <--- Засекаем время выполнения этой строки }
   ReadTSC(a2);
   Writeln(a1:20:0, ', ', a2:20:0, ', ', (a2-a1):20:0)
end.

function rdtsc:Int64;
asm
  rdtsc
  mov    dword ptr [Result], eax
  mov    dword ptr [Result + 4], edx
end;

var
  Start, Finish, Duration:Int64;

begin
  Start := rdtsc;

  writeln('test'); // Посмотрим, за сколько тактов выполняется WriteLn

  Finish := rdtsc;
  Duration := (Finish - Start);
  WriteLn('Время выполнения (в тактах) = ', Duration);
end.

Использование GetTickCount() (32-битные компиляторы)

uses Windows;
var Duration: Cardinal;

begin
  Duration := GetTickCount();
  
  ... // замеряемый блок
  
  Duration := GetTickCount() - Duration;
  WriteLn('Время выполнения = ', Duration);
end.

Использование QueryPerformanceCounter() (32-битные компиляторы)

Uses
  Windows, SysUtils;
Var
 t1, t2, Res: int64;
 bOk: BOOL;

Procedure StartTimer;
Begin
  t1 := 0; t2 := 0; Res := 0;
  bOK := QueryPerformanceFrequency(Res);
  If bOK Then QueryPerformanceCounter(t1);
 end;

Procedure StopTimer;
Begin
  If bOK Then QueryPerformanceCounter(t2);
End;

{ Время выполнения этой процедуры будет засекаться }
Procedure SomeProc;
Var
  i: Integer;
  a, b, T: Integer;
Begin
  For i := 1 To 10000 Do Begin
    a := 100; b := 250;
    T := a; a := b; b := T;
  End;
End;

Procedure CheckExecutionTime;
Begin
  StartTimer;
  SomeProc; // Запускаем тестируемую процедуру
  StopTimer;
  
  If bOK Then Writeln('Execution time: ' + Format('%g sec.',[(t2 - t1) / Res]));
End;

{ Изменяем приоритет потока на TIME_CRITICAL для увеличения точности }
Procedure Check_Time;
Var tp, pc: DWORD;
Begin
  tp := GetThreadPriority(GetCurrentThread());
  pc := GetPriorityClass(GetCurrentProcess());
  SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_TIME_CRITICAL);
  SetPriorityClass(GetCurrentProcess(), REALTIME_PRIORITY_CLASS);
  Try
    CheckExecutionTime()
  Finally
    SetThreadPriority(GetCurrentThread(), tp);
    SetPriorityClass(GetCurrentProcess(), pc);
  End
End;

{ Основная программа }
begin
  check_time();
end.