function GetCPUSpeed: Double;

 const DelayTime = 500;

var TimerHi : DWORD;

  TimerLo : DWORD;

  PriorityClass : Integer;

  Priority : Integer;

begin

 PriorityClass := GetPriorityClass(GetCurrentProcess);

 Priority := GetThreadPriority(GetCurrentThread);

 SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);

 SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

 Sleep(10);

 asm

  DW 310Fh // rdtsc

  MOV TimerLo, EAX

  MOV TimerHi, EDX

 end;

 Sleep(DelayTime);

 asm

  DW 310Fh // rdtsc

  SUB EAX, TimerLo

  SBB EDX, TimerHi

  MOV TimerLo, EAX

  MOV TimerHi, EDX

 end;

 SetThreadPriority(GetCurrentThread, Priority);

 SetPriorityClass(GetCurrentProcess, PriorityClass);

 Result := TimerLo / (1000.0 * DelayTime);

end;

// Usage ...

LabelCPUSpeed.Caption := Format('CPU speed: %f MHz', [GetCPUSpeed]);

function GetCPUSpeed: real;
 function IsCPUID_Available: Boolean; assembler; register;
 asm
  PUSHFD { прямой доступ к флагам невозможен, только через стек }
  POP EAX { флаги в EAX }
  MOV EDX,EAX { сохраняем текущие флаги }
  XOR  EAX,$200000  { бит ID не нужен }
  PUSH EAX { в стек }
  POPFD { из стека в флаги, без бита ID }
  PUSHFD { возвращаем в стек }
  POP EAX { обратно в EAX }
  XOR  EAX,EDX { проверяем, появился ли бит ID }
  JZ @exit { нет, CPUID не доступен }
  MOV AL,True { Result=True }
  @exit:
 end;
 function hasTSC: Boolean;
 var
  Features: Longword;
 begin
  asm
  MOV Features,0  { Features = 0 }
  PUSH EBX
  XOR  EAX,EAX
  DW $A20F
  POP EBX
  CMP EAX,$01
  JL @Fail
  XOR  EAX,EAX
  MOV EAX,$01
  PUSH EBX
  DW $A20F
  MOV Features,EDX
  POP EBX
  @Fail:
  end;
  hasTSC := (Features and $10) <> 0;
 end;
const
 DELAY = 500;
var
 TimerHi, TimerLo: Integer;
 PriorityClass, Priority: Integer;
begin
 Result := 0;
 if not (IsCPUID_Available and hasTSC) then Exit;
 PriorityClass := GetPriorityClass(GetCurrentProcess);
 Priority := GetThreadPriority(GetCurrentThread);
 SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
 SetThreadPriority(GetCurrentThread,
  THREAD_PRIORITY_TIME_CRITICAL);
 SleepEx(10, FALSE);
 asm
  DB $0F  { $0F31 op-code for RDTSC Pentium инструкции }
  DB $31  { возвращает 64-битное целое (Integer) }
  MOV TimerLo,EAX
  MOV TimerHi,EDX
 end;
 SleepEx(DELAY, FALSE);
 asm
  DB $0F  { $0F31 op-code для RDTSC Pentium инструкции }
  DB $31  { возвращает 64-битное целое (Integer) }
  SUB EAX,TimerLo
  SBB EDX,TimerHi
  MOV TimerLo,EAX
  MOV TimerHi,EDX
 end;
 SetThreadPriority(GetCurrentThread, Priority);
 SetPriorityClass(GetCurrentProcess, PriorityClass);
 Result := TimerLo / (1000 * DELAY);
end;

const
ID_BIT=$200000; // EFLAGS ID bit
function GetCPUSpeed: Double;
const
 DelayTime = 500;
var
 TimerHi, TimerLo: DWORD;
 PriorityClass, Priority: Integer;
begin
try
 PriorityClass := GetPriorityClass(GetCurrentProcess);
 Priority := GetThreadPriority(GetCurrentThread);
 SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriorit(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL);
 Sleep(10);
 asm
  dw 310Fh // rdtsc
  mov TimerLo, eax
  mov TimerHi, edx
 end;
 Sleep(DelayTime);
 asm
  dw 310Fh // rdtsc
  sub eax, TimerLo
  sbb edx, TimerHi
  mov TimerLo, eax
  mov TimerHi, edx
 end;
 SetThreadPriority(GetCurrentThread, Priority);
 SetPriorityClass(GetCurrentProcess, PriorityClass);
 Result := TimerLo / (1000.0 * DelayTime);
 except end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var cpuspeed:string;
begin
 cpuspeed:=Format('%f MHz', [GetCPUSpeed]);
 edit1.text := cpuspeed;
end;

function RdTSC : int64; register;
asm
 db $0f, $31
end;
function GetCyclesPerSecond : int64;
var
 hF, T, et, sc : int64;
begin
 QueryPerformanceFrequency(hF); // HiTicks / second
 QueryPerformanceCounter(T); // Determine start HiTicks
 et := T + hF; // (Cycles are passing, but we can still USE them!)
 sc := RdTSC; // Get start cycles
 repeat  // Use Hi Perf Timer to loop for 1 second
  QueryPerformanceCounter(T); // Check ticks NOW
 until (T >= et); // Break the moment we equal or exceed et
 Result := RdTSC - sc; // Get stop cycles and calculate result
end;

// (C) 1999 ISV

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics,

 Controls, Forms,Dialogs, StdCtrls, Buttons, ExtCtrls;

type TForm1 = class(TForm)

  Label1: TLabel;

  Timer1: TTimer;

  Label2: TLabel;

  Label3: TLabel;

  Button1: TButton;

  Button2: TButton;

  Label4: TLabel;

  procedure Timer1Timer(Sender: TObject);

  procedure FormActivate(Sender: TObject);

  procedure Button1Click(Sender: TObject);

  procedure Button2Click(Sender: TObject);

 private  

{ Private declarations }

 public  

{ Public declarations }

  Counter:integer;

  //Счетчик срабатывания таймера

Start:int64;

//Начало роботы

:int64;

//Предыдущее значение

PStart,PStop:int64;

 //Для примера выч. времени

 CurRate:integer;

  //Текущая частота проца

function GetCPUClick:int64;

function GetTime(Start,Stop:int64):double;

 end;

var Form1: TForm1;implementation{$R *.DFM}

// Функция работает на пнях ММХ или выше а

// также проверялась на К6

function TForm1.GetCPUClick:int64;

begin

 asm  db 0fh,31h

// Опкод для команды rdtsc

// mov dword ptr result,eax

// mov dword ptr result[4],edx

end;

// Не смешно :(. Без ?той штуки

// Компайлер выдает Internal error C1079

Result:=Result;

end;

// Время в секундах между старт и стоп

function TForm1.GetTime(Start,Stop:int64):double;

begin

 try  result:=(Stop-Start)/CurRate except  result:=0;

 end;

end;

// Обработчик таймера считает текущую частоту, выводит ее, а также

// усредненную частоту, текущий такт с момента старта процессора.

// При постоянной частоте процессора желательно интервал братьпобольше

// 1-5с для точного прощета частоты процессора.

procedure TForm1.Timer1Timer(Sender: TObject);

 var  i:int64;

begin

 i:=GetCPUClick;

 if Counter=0  then Start:=i else

begin

  Label2.Caption:=Format('Частота общая:%2f',

  [(i-Start)/(Counter*Timer1.Interval*1000)]);

  Label3.Caption:=Format('Частота текущая:%2f',

  [(i-)/(Timer1.Interval*1000)]);

  CurRate:=Round(((i-)*1000)/(Timer1.Interval));

  end;

 Label1.Cap примера

procedure TForm1.Button1Click(Sender: TObject);

begin

 PStart:=GetCPUClick;

end;

// Останавливаем отсчет времени и показуем соко

// прошло секунд

procedure TForm1.Button2Click(Sender: TObject);

begin

 PStop:=GetCPUClick;

 Label4.Caption:=Format!

('Время между нажатиями:%gсек',[GetTime(PStart,PStop)])

end;

end.

uses registry;
...
function GetCpuMhz: Word;
begin
 with tregistry.Create do
 begin
  rootkey := HKEY_LOCAL_MACHINE;
  openkey('\hardware\description\system\centralprocessor\0\', false);
  result := readinteger('~mhz');
  free;
 end;
end;