Как найти скорость процессора?

Code:

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

Code:

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;

Code:

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;

Code:

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;

Code:

// (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;             

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

Previous: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-Previous)/(Timer1.Interval*1000)]);

     CurRate:=Round(((i-Previous)*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.

Code:

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;