Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007

Пример взят из рассылки: СообЧА. Программирование на Delphi (https://Subscribe.Ru/catalog/comp.soft.prog.delphi2000)

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

Взято с Vingrad.ru https://forum.vingrad.ru


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;

Взято из https://forum.sources.ru


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;

Взято из https://forum.sources.ru


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;

Взято из https://forum.sources.ru


Данная тема уже обсуждалась, но у меня есть своя реализация сабжа. Начиная с Pentium MMX, Intel ввели в процессор счетчик тактов на 64 бита (Присутствуэт точно и в К6). Для того чтобы посотреть на его содержание, была введена команда "rdtsc" (подробное описание в интеловской мануале). Эту возможность можно использовать для реализации сабжа. Посоку Делфя не вкурсе насчет rdtsc, то пришлось юзать опкод (0F31). Привожу простенький примерчик юзания, Вы уж извините - немножко кривоват получился, да и ошибка компалера какая-то вылезла :( (V4 Bld5.104 Upd 2). Кому интересно, поделитесь своими соображениями по этому поводу. Особенно интерисует работа в режиме когда меняется частота процессора (Duty Cycle, StandBy).

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

Проверялось под еНТями на Пне 2 333.

https://delphiworld.narod.ru/

DelphiWorld 6.0


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;

Автор: Shady

https://delphiworld.narod.ru/

DelphiWorld 6.0