:: 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;
|
При использовании материала - ссылка на сайт обязательна
|
|