FAQ VCL
Железо\Процессор

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как определить тактовую частоту процессора?

function TForm1.getCPUSpeed: string;
const
  DelayTime = 500;
var
  TimerHi, TimerLo: dword;
  PriorityClass, Priority: integer;
  Speed: double;
begin
   PriorityClass := GetPriorityClass( GetCurrentProcess );
   Priority := GetThreadPriority( GetCurrentThread );
   SetPriorityClass( GetCurrentProcess, REALTIME_PRIORITY_CLASS );
   SetThreadPriority( GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL );
   Sleep( 10 );
   asm
      dw  310Fh
      mov TimerLo, eax
      mov TimerHi, edx
   end;
   Sleep( DelayTime );
   asm
      dw  310Fh
      sub eax, TimerLo
      sbb edx, TimerHi
      mov TimerLo, eax
      mov TimerHi, edx
   end;
   SetThreadPriority( GetCurrentThread, Priority );
   SetPriorityClass( GetCurrentProcess, PriorityClass );
   Speed := TimerLo / ( 1000.0 * DelayTime );
   Result := Format( '%f MHz', [Speed] );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( getCPUSpeed );
end;


Поддерживает ли процессор набор команд MMX?

// Способ первый
function TForm1.CheckMMX: boolean;
var
  Temp: dword;
begin
   Temp := 1;
   asm
      push ebx
      mov eax,1
      db $0F,$A2
      test edx,$800000
      jz @NOMMX
      mov edx,0
      mov Temp,edx
      @NOMMX:
      pop ebx
   end;
   CheckMMX := Temp = 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if CheckMMX then
      ShowMessage( 'Поддерживается' )
   else
      ShowMessage( 'Неподдерживается' )
end;

// Способ второй
function SupportsMMX: boolean;
begin
   Result := false;
   try
      asm
         push     eax
         push     ebx
         push     ecx
         push     edx
         pushfd
         pop      eax
         mov      ebx,eax
         xor      eax,$00200000
         push     eax
         popfd
         pushfd
         pop      eax
         xor      eax,ebx
         je       @NoMMX
         mov      eax,$01
         test     edx,$800000
         jz       @NoMMX
         mov byte ptr[Result],1
         @NoMMX:
         pop      edx
         pop      ecx
         pop      ebx
         pop      eax
      end;
   except
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if SupportsMMX then
      ShowMessage( 'Поддерживается' )
   else
      ShowMessage( 'Неподдерживается' )
end;


Поддерживает ли процессор набор команд SSE?

function TForm1.CheckSSE: boolean;
var
  Temp: dword;
begin
   Temp := 1;
   asm
      push ebx
      mov eax,1
      db $0F,$A2
      test edx,$2000000
      jz @NOSSE
      mov edx,0
      mov Temp,edx
      @NOSSE:
      pop ebx
   end;
   CheckSSE := Temp = 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if CheckSSE then
      ShowMessage( 'Поддерживается' )
   else
      ShowMessage( 'Неподдерживается' )
end;


Поддерживает ли процессор набор команд SSE2?

function TForm1.CheckSSE2: boolean;
var
  Temp: dword;
begin
   Temp := 1;
   asm
      push ebx
      mov eax,1
      db $0F,$A2
      test edx,$4000000
      jz @NOSSE2
      mov edx,0
      mov Temp,edx
      @NOSSE2:
      pop ebx
   end;
   CheckSSE2 := Temp = 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if CheckSSE2 then
      ShowMessage( 'Поддерживается' )
   else
      ShowMessage( 'Неподдерживается' )
end;


Поддерживает ли процессор набор команд 3DNow!?

// Способ первый
function TForm1.Check3DNow: boolean;
var
  Temp: dword;
begin
   Temp := 1;
   asm
      push ebx
      mov eax, $80000000
      dw $A20F
      cmp eax, $80000000
      jbe @NOEXTENDED
      mov eax, $80000001
      dw $A20F
      test edx, $80000000
      jnz @EXIT
      @NOEXTENDED:
      mov Temp, 0
      @EXIT:
      pop ebx
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if Check3DNow then
      ShowMessage( 'Поддерживается' )
   else
      ShowMessage( 'Неподдерживается' )
end;

// Способ второй
function is3DNowSupport: boolean; assembler;
asm
   push ebx
   mov @Result, true
   mov eax, $80000000
   dw $A20F
   cmp eax, $80000000
   jbe @NOEXTENDED      // 3DNow не поддерживается
   mov eax, $80000001
   dw $A20F
   test edx, $80000000
   jnz @EXIT            // 3DNow поддерживается
   @NOEXTENDED:
   mov @Result, false
   @EXIT:
   pop ebx
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if is3DNowSupport then
      ShowMessage( 'Поддерживается' )
   else
      ShowMessage( 'Неподдерживается' )
end;


Как определить класс процессора?

function GetClassProcessor: string;
var
  lpSystemInfo: TSystemInfo;
begin
   GetSystemInfo( lpSystemInfo );
   Result := Format( '%d', [lpSystemInfo.dwProcessorType] );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( 'Процессор класса x' + GetClassProcessor );
end;


Как определить фирму производителя CPU?

// Способ первый
type
  TVendor = array[0..11] of AnsiChar;

implementation

function GetCPUVendor: TVendor; assembler; register;
asm
   push ebx      // save affected register
   push edi
   mov edi, eax   // @result (tvendor)
   mov eax, 0
   dw $A20f      // cpuid command
   mov eax, ebx
   xchg ebx, ecx  // save ecx result
   mov ecx, 4
@1:
   stosb
   shr eax, 8
   loop @1
   mov eax, edx
   mov ecx, 4
@2:
   stosb
   shr eax, 8
   loop @2
   mov eax, ebx
   mov ecx, 4
@3:
   stosb
   shr eax, 8
   loop @3
   pop edi       // restore registers
   pop ebx
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetCPUVendor );
end;

// Способ второй
function GetCPUVendor: string;
var
  str_ebx, str_ecx, str_edx: AnsiString;
  _ebx, _ecx, _edx: Longword;
  i: Integer;
  b: Byte;
begin
   asm
      mov eax, 0
      db $0F, $A2
      mov _ebx, ebx
      mov _ecx, ecx
      mov _edx, edx
   end;
   for i := 0 to 3 do
   begin
      b := Lo( _ebx );
      str_ebx := str_ebx + Chr( b );
      b := Lo( _ecx );
      str_ecx := str_ecx + Chr( b );
      b := Lo( _edx );
      str_edx := str_edx + Chr( b );
      _ebx := _ebx shr 8;
      _ecx := _ecx shr 8;
      _edx := _edx shr 8;
   end;
   Result := str_ebx+str_edx+str_ecx;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetCPUVendor );
end;


Как определить количество CPU?

function GetCPUCount: byte;
var
  si: TSystemInfo;
begin
   GetSystemInfo( si );
   Result := si.dwNumberOfProcessors;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( IntToStr( GetCPUCount ) );
end;


Как получить количество тактов процессора, прошедших с момента его загрузки?

// Способ первый
function RDTSC: int64; assembler;
asm
   db $0F,$31
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Caption := IntToStr( RDTSC );
end;

// Способ второй
function GetCPUTact: int64;
asm
   rdtsc
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Caption := IntToStr( GetCPUTact );
end;


Как определить наличие сопроцессора?

uses
  {...} {$IFDEF WIN32}, Registry {$ENDIF};

function HasCoProcesser: bool;
{$IFDEF WIN32}
var
  TheKey: hKey;
{$ENDIF}
begin
   Result := true;
   {$IFNDEF WIN32}
   if GetWinFlags and Wf_80x87 = 0 then
      Result := false;
   {$ELSE}
   if RegOpenKeyEx( HKEY_LOCAL_MACHINE, 'HARDWARE\DESCRIPTION\System\FloatingPointProcessor',
                    0, KEY_EXECUTE, TheKey ) = ERROR_SUCCESS then
      Result := false;
   RegCloseKey( TheKey );
   {$ENDIF}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if HasCoProcesser then
      ShowMessage( 'Сопроцессор присутствует' )
   else
      ShowMessage( 'Сопроцессор отсутствует' );
end;

При использовании материала - ссылка на сайт обязательна