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

Как получить информацию о процессоре?

01.01.2007

О процессоре можно на любом уровне (приложении или драйвере) получить информацию с помощью команды(машинной) CPUID(386+):

Например(Вставка на асм в языке Паскаль):

{Получить тип процессора}

 
asm
  mov eax
,0
  cpuid
{Или db 0Fh, 0A2h}
 
{Теперь регистры EBX:ECX:EDX содержат строку "Genu-inel-ntel" (например)}
end;

Передать в Паскаль содержимое регистров можно, например, так:

var
 
EBXstr,ECXstr,EDXstr: string[5];

 
begin
 
asm
    mov eax
,0
    cpuid
    mov dword ptr
EBXstr+1,EBX
    mov
byte ptr EBXstr,4
    mov dword ptr
ECXstr+1,ECX
    mov
byte ptr ECXstr,4
    mov dword ptr
EDXstr+1,EDX
    mov
byte ptr EDXstr,4
 
end;
 
writeln
(EBSstr,ECXstr,EDXstr);

Автор: Chingachguk


unit CpuId; 
interface
uses
Windows, Mmsystem, Sysutils, Math, Dialogs;
type
   
TCpuRec=record
       
Name:string[128];
       
Vendor:string[12];
       
Frequency:word;
       
Family:integer;
       
Model:integer;
       
Stepping:integer;
       L1DCache
:word;
       L1ICache
:word;
       L2Cache
:word;
     
end;
   
TCpuType = (cpu8086, cpu286, cpu386, cpu486, cpuPentium);
   
TCpuData=object
     
function GetCPUIDSupport:Boolean;
     
function GetVendorString:string;
     
function GetCPUFrequency:word;
      procedure
GetFMS(var Family,Model,Stepping:byte);
     
function GetMaxCpuId:dword;
     
function CheckFPU:Boolean;
     
function CheckTSC:Boolean;
     
function CheckMSR:Boolean;
     
function CheckMPS:Boolean;
     
function GetNoCpus:cardinal;
     
function CheckPN:Boolean;
     
function CheckCMPXCHG8B:Boolean;
     
function CheckCMOVe:Boolean;
     
function CheckSelfSnoop:Boolean;
     
function CheckDebugTraceStore:Boolean;
     
function CheckFXSAVEFXRSTOR:Boolean;
     
function CheckMMX:Boolean;
     
function CheckMMXplus:Boolean;
     
function CheckSSE:Boolean;
     
function CheckSSE2:Boolean;
     
function CheckAMD3DNow:Boolean;
     
function CheckAMD3DNowPlus:Boolean;
     
function GetMaxExtendedFunctions:dword;
      procedure
GetExtendedFMS(var Family,Model,Stepping:byte);
     
function GetExtendedCpuName:string;
     
function GetExtendedL1DCache:word;
     
function GetExtendedL1ICache:word;
     
function GetExtendedL2Cache:word;
 
     
function CheckCeleron:Boolean;
     
function CheckPentiumIII:Boolean;
     
function CheckXeon:Boolean;
     
function CheckPentium4:Boolean;
     
function CheckIthanium:Boolean;
 
//****Aici am conrectat****
     
function IntelP5N:string;
     
function IntelP6N:string;
//****Pana aici****
     
function AMDK5N:string;
     
function Cyrix686N:string;
     
function GenericCpuN:string;
     
function P5CacheL1DI:word;
     
function P6CacheL1DI:word;
     
function P6CacheL2:word;
 
     
function AuthenticAMD:TCpuRec;
 
     
function GenuineIntel:TCpuRec;
     
function CyrixInstead:TCpuRec;
     
function GenericCPU:TCpuRec;
     
end;
const
Intel486
:array[0..8] of string=
(''Intel 486 DX'',
 
''Intel 486 DX'',
 
''Intel 486 SX'',
 
''Intel 486 DX2'',
 
''Intel 486 SL'',
 
''Intel 486 SX2'',
 
''Intel 486 DX2'',
 
''Intel 486 DX4'',
 
''Intel 486 DX4'');
UMC486
:array[0..1] of string=
(''UMC U5D'',
 
''UMC U5S'');
AMD486
:array[0..5] of string=
(''AMD 486 DX2'',
 
''AMD 486 DX2'',
 
''AMD 486 DX4'',
 
''AMD 486 DX4'',
 
''AMD 5x86'',
 
''AMD 5x86'');
IntelP5
:array[0..6] of string=
(''Intel Pentium P5 A-Step'',
 
''Intel Pentium P5'',
 
''Intel Pentium P54C'',
 
''Intel Pentium P24T Overdrive'',
 
''Intel Pentium MMX P55C'',
 
''Intel Pentium P54C'',
 
''Intel Pentium MMX P55C'');
  NexGenNx586
=''NexGen Nx586'';
  Cyrix4x86
=''VIA Cyrix 4x86'';
  Cyrix5x86
=''VIA Cyrix 5x86'';
 
CyrixMediaGX=''VIA Cyrix Media GX'';
  CyrixM1
=''VIA Cyrix 6x86'';
  CyrixM2
=''VIA Cyrix 6x86MX'';
 
CyrixIII=''VIA Cyrix III'';
  AMDK5
:array[0..3] of string=
 
(''AMD SSA5 (PR75/PR90/PR100)'',
   
''AMD 5k86 (PR120/PR133)'',
   
''AMD 5k86 (PR166)'',
   
''AMD 5k86 (PR200)'');
  AMDK6
:array[0..4] of string=
 
(''AMD K6 (166~233)'',
   
''AMD K6 (266~300)'',
   
''AMD K6-2'',
   
''AMD K6-III'',
   
''AMD K6-2+ or K6-III+'');
   
Centaur:array[0..2] of string=
   
(''Centaur C6'',
   
''Centaur C2'',
   
''Centaur C3'');
   
Rise:array[0..1] of string=
   
(''Rise mP6'',
   
''Rise mP6'');
   IntelP6
:array[0..7] of string=
   
(''Intel Pentium Pro A-Step'',
   
''Intel Pentium Pro'',
   
''Intel Pentium II'',
   
''Intel Pentium II'',
   
''Intel Pentium II'',
   
''Intel Pentium III'',
   
''Intel Pentium III'',
   
''Intel Pentium III'');
   AMDK7
:array[0..3] of string=
   
(''AMD Athlon(tm) Processor'',
     
''AMD Athlon(tm) Processor'',
     
''AMD Duron(tm) Processor'',
     
''AMD Thunderbird Processor'');
   IntelP4
=''Intel Pentium 4'';
var CpuData:TCpuData;
implementation
function TCpuData.GetCPUIDSupport:Boolean;
var TempDetect:dword;
begin
asm
  pushf
  pushfd
  push eax
  push ebx
  push ecx
  push edx
 
  pushfd
  pop eax
  mov ebx
,eax
  xor eax
,$00200000
  push eax
  popfd
  pushfd
  pop eax
  push ebx
  popfd
  xor eax
,ebx
  mov
TempDetect,eax
 
  pop edx
  pop ecx
  pop ebx
  pop eax
  popfd
  popf
end;
GetCPUIDSupport:=(TempDetect=$00200000);
end;
function TCpuData.GetVendorString:string;
var s1,s2,s3:array[0..3] of char;
   
TempVendor:string;
    i
:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,0
  db $0F
,$A2                /// cpuid
  mov s1
,ebx
  mov s2
,edx
  mov s3
,ecx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
TempVendor:='''';
for i:=0 to 3 do
 
TempVendor:=TempVendor+s1[i];
for i:=0 to 3 do
 
TempVendor:=TempVendor+s2[i];
for i:=0 to 3 do
 
TempVendor:=TempVendor+s3[i];
GetVendorString:=TempVendor;
end;
function TCpuData.GetCPUFrequency:word;
var TimeStart:integer;
   
TimeStop:integer;
   
StartTicks:dword;
   
EndTicks:dword;
   
TotalTicks:dword;
    cpuSpeed
:dword;
   
NeverExit:Boolean;
begin
TimeStart:=0;
TimeStop:=0;
StartTicks:=0;
EndTicks:=0;
TotalTicks:=0;
cpuSpeed
:=0;
NeverExit:=True;
TimeStart:=timeGetTime;
while NeverExit do
 
begin
 
TimeStop:=timeGetTime;
 
if ((TimeStop-TimeStart)>1) then
     
begin
       
asm
        xor eax
,eax
        xor ebx
,ebx
        xor ecx
,ecx
        xor edx
,edx
        db $0F
,$A2                /// cpuid
        db $0F
,$31                /// rdtsc
        mov
StartTicks,eax
       
end;
     
Break;
     
end;
 
end;
 
TimeStart:=TimeStop;
 
while NeverExit do
   
begin
   
TimeStop:=timeGetTime;
   
if ((TimeStop-TimeStart)>1000) then
       
begin
       
asm
         xor eax
,eax
         xor ebx
,ebx
         xor ecx
,ecx
         xor edx
,edx
         db $0F
,$A2                /// cpuid
         db $0F
,$31                /// rdtsc
         mov
EndTicks,eax
       
end;
       
Break;
       
end;
   
end;
   
TotalTicks:=EndTicks-StartTicks;
   cpuSpeed
:=TotalTicks div 1000000;
   
GetCPUFrequency:=cpuSpeed;
end;
procedure
TCpuData.GetFMS(var Family,Model,Stepping:byte);
var TempFlags:dword;
   
BinFlags:array[0..31] of byte;
    i
,pos:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  mov
TempFlags,eax
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
 
begin
   
BinFlags[i]:=TempFlags mod 2;
   
TempFlags:=TempFlags div 2;
 
end;
family
:=0;
model
:=0;
stepping
:=0;
  pos
:=0;
 
for i:=0 to 3 do
   
begin
    stepping
:=stepping+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc
(pos);
   
end;
  pos
:=4;
 
for i:=0 to 3 do
   
begin
    model
:=model+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc
(pos);
   
end;
  pos
:=8;
 
for i:=0 to 3 do
   
begin
    family
:=family+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc
(pos);
   
end;
end;
function TCpuData.GetMaxCpuId:dword;
var TempMax:dword;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,0
  db $0F
,$A2                /// cpuid
  mov
TempMax,eax
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
GetMaxCpuId:=TempMax;
end;
function TCpuData.CheckFPU:Boolean;
label
NoFpu;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$1
  jz
NoFpu
  mov edx
,0
  mov
TempCheck,edx
NoFpu:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckFpu:=(TempCheck=0);
end;
function TCpuData.CheckTSC:Boolean;
label
NoTSC;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$10
  jz
NoTSC
  mov edx
,0
  mov
TempCheck,edx
NoTSC:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckTSC:=(TempCheck=0);
end;
function TCpuData.CheckMSR:Boolean;
label
NoMSR;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$20
  jz
NoMSR
  mov edx
,0
  mov
TempCheck,edx
NoMSR:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckMSR:=(TempCheck=0);
end;
function TCpuData.CheckMPS:Boolean;
var SysInfo:TSystemInfo;
begin
GetSysTemInfo(SysInfo);
CheckMPS:=(SysInfo.dwNumberOfProcessors>1);
end;
function TCpuData.GetNoCpus:cardinal;
var SysInfo:TSystemInfo;
begin
GetSystemInfo(SysInfo);
GetNoCpus:=SysInfo.dwNumberOfProcessors;
end;
function TCpuData.CheckPN:Boolean;
label
NoPN;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$40000
  jz
NoPN
  mov edx
,0
  mov
TempCheck,edx
NoPN:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckPN:=(TempCheck=0);
end;
function TCpuData.CheckCMPXCHG8B:Boolean;
label NoCMPXCHG8B
;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$100
  jz NoCMPXCHG8B
  mov edx
,0
  mov
TempCheck,edx
NoCMPXCHG8B
:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckCMPXCHG8B
:=(TempCheck=0);
end;
function TCpuData.CheckCMOVe:Boolean;
label
NoCMOVe;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$8000
  jz
NoCMOVe
  mov edx
,0
  mov
TempCheck,edx
NoCMOVe:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckCMOVe:=(TempCheck=0);
end;
function TCpuData.CheckSelfSnoop:Boolean;
label
NoSelfSnoop;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$8000000
  jz
NoSelfSnoop
  mov edx
,0
  mov
TempCheck,edx
NoSelfSnoop:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckSelfSnoop:=(TempCheck=0);
end;
function TCpuData.CheckDebugTraceStore:Boolean;
label
NoDebugTraceStore;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$200000
  jz
NoDebugTraceStore
  mov edx
,0
  mov
TempCheck,edx
NoDebugTraceStore:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckDebugTraceStore:=(TempCheck=0);
end;
function TCpuData.CheckFXSAVEFXRSTOR:Boolean;
label
NoFXSAVEFXRSTOR;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$1000000
  jz
NoFXSAVEFXRSTOR
  mov edx
,0
  mov
TempCheck,edx
NoFXSAVEFXRSTOR:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckFXSAVEFXRSTOR:=(TempCheck=0);
end;
function TCpuData.CheckMMX:Boolean;
label
NoMMX;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$800000
  jz
NoMMX
  mov edx
,0
  mov
TempCheck,edx
NoMMX:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckMMX:=(TempCheck=0);
end;
function TCpuData.CheckMMXplus:Boolean;
label
NoMMXplus;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000001
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  test edx
,$400000
  jz
NoMMXplus
  mov edx
,0
  mov
TempCheck,edx
NoMMXplus:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckMMXplus:=(TempCheck=0);
end;
function TCpuData.CheckSSE:Boolean;
label
NoSSE;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$2000000
  jz
NoSSE
  mov edx
,0
  mov
TempCheck,edx
NoSSE:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckSSE:=(TempCheck=0);
end;
function TCpuData.CheckSSE2:Boolean;
label NoSSE2
;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  test edx
,$4000000
  jz NoSSE2
  mov edx
,0
  mov
TempCheck,edx
NoSSE2
:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckSSE2
:=(TempCheck=0);
end;
function TCpuData.CheckAMD3DNow:Boolean;
label NoAMD3DNow
;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000001
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  test edx
,$80000000
  jz NoAMD3DNow
  mov edx
,0
  mov
TempCheck,edx
NoAMD3DNow
:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckAMD3DNow
:=(TempCheck=0);
end;
function TCpuData.CheckAMD3DNowPlus:Boolean;
label NoAMD3DNowPlus
;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000001
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  test edx
,$40000000
  jz NoAMD3DNowPlus
  mov edx
,0
  mov
TempCheck,edx
NoAMD3DNowPlus
:
  pop edx
  pop ecx
  pop ebx
  pop eax
 
end;
CheckAMD3DNowPlus
:=(TempCheck=0);
end;
function TCpuData.GetMaxExtendedFunctions:dword;
var TempExt:dword;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000000
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  shl eax
,1
  shr eax
,1
  mov
TempExt,eax
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
GetMaxExtendedFunctions:=TempExt;
end;
 
procedure
TCpuData.GetExtendedFMS(var family,model,stepping:byte);
var TempFlags:dword;
   
BinFlags:array[0..31] of byte;
    i
,pos:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000001
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  mov
TempFlags,eax
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
 
begin
   
BinFlags[i]:=TempFlags mod 2;
   
TempFlags:=TempFlags div 2;
 
end;
family
:=0;
model
:=0;
stepping
:=0;
  pos
:=0;
 
for i:=0 to 3 do
   
begin
    stepping
:=stepping+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc
(pos);
   
end;
  pos
:=4;
 
for i:=0 to 3 do
   
begin
    model
:=model+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc
(pos);
   
end;
  pos
:=8;
 
for i:=0 to 3 do
   
begin
    family
:=family+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc
(pos);
   
end;
end;
 
function TCpuData.GetExtendedCpuName:string;
var s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12:array[0..3] of char;
   
TempCpuName:string;
    i
:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000002
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  mov s1
,eax
  mov s2
,ebx
  mov s3
,ecx
  mov s4
,edx
  mov eax
,$80000003
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  mov s5
,eax
  mov s6
,ebx
  mov s7
,ecx
  mov s8
,edx
  mov eax
,$80000004
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  mov s9
,eax
  mov s10
,ebx
  mov s11
,ecx
  mov s12
,edx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
 
TempCpuName:='''';
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s1[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s2[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s3[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s4[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s5[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s6[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s7[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s8[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s9[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s10[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s11[i];
 
for i:=0 to 3 do
   
TempCpuName:=TempCpuName+s12[i];
 
GetExtendedCpuName:=TempCpuName;
end;
function TCpuData.GetExtendedL1DCache:word;
var L1D,TempL1D:dword;
   
BinArray:array[0..31] of byte;
    i
,p:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000005
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  mov L1D
,ecx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
 
begin
   
BinArray[i]:=L1D mod 2;
   L1D
:=L1D div 2;
 
end;
TempL1D
:=0;
p
:=0;
for i:=24 to 31 do
 
begin
   TempL1D
:=TempL1D+(BinArray[i]*StrToInt(FloatToStr(Power(2,p))));
   inc
(p);
 
end;
GetExtendedL1DCache
:=TempL1D;
end;
function TCpuData.GetExtendedL1ICache:word;
var L1I,TempL1I:dword;
   
BinArray:array[0..31] of byte;
    i
,p:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000005
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  mov L1I
,edx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
 
begin
   
BinArray[i]:=L1I mod 2;
   L1I
:=L1I div 2;
 
end;
TempL1I
:=0;
p
:=0;
for i:=24 to 31 do
 
begin
   TempL1I
:=TempL1I+(BinArray[i]*StrToInt(FloatToStr(Power(2,p))));
   inc
(p);
 
end;
GetExtendedL1ICache
:=TempL1I;
end;
function TCpuData.GetExtendedL2Cache:word;
var L2,TempL2:dword;
   
BinArray:array[0..31] of byte;
    i
,p:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,$80000006
  mov ebx
,0
  mov ecx
,0
  mov edx
,0
  db $0F
,$A2                /// cpuid
  mov L2
,ecx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
 
begin
   
BinArray[i]:=L2 mod 2;
   L2
:=L2 div 2;
 
end;
TempL2
:=0;
p
:=0;
for i:=16 to 31 do
 
begin
   TempL2
:=TempL2+(BinArray[i]*StrToInt(FloatToStr(Power(2,p))));
   inc
(p);
 
end;
GetExtendedL2Cache
:=TempL2;
end;
function TCpuData.CheckCeleron:Boolean;
var BId:byte;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  mov
BId,bl
  pop edx
  pop ecx
  pop ebx
 
  pop eax
end;
CheckCeleron:=(BId=$1);
end;
function TCpuData.CheckPentiumIII:Boolean;
var BId:byte;
begin
CheckPentiumIII:=(CheckMMX and CheckSSE);
end;
function TCpuData.CheckXeon:Boolean;
var BId:byte;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  mov
BId,bl
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
CheckXeon:=(BId=$3);
end;
function TCpuData.CheckPentium4:Boolean;
var BId:byte;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  mov
BId,bl
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
CheckPentium4
:=(BId=$8);
end;
function TCpuData.CheckIthanium:Boolean;
var res:dword;
   
BinArray:array[0..31] of byte;
    i
:byte;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax
,1
  db $0F
,$A2                /// cpuid
  mov res
,edx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
 
begin
   
BinArray[i]:=res mod 2;
   res
:=res div 2;
 
end;
CheckIthanium:=(CheckPentium4 and (BinArray[30]=1));
end;
function TCpuData.IntelP5N:string;
begin
 
If CheckMMX then IntelP5N:=''Intel Pentium(r) MMX(tm)''
else IntelP5N:=''Intel Pentium(r)'';
end;
function TCpuData.IntelP6N:string;
begin
if CheckCeleron then IntelP6N:=''Intel Celeron(r)''
else
if CheckPentiumIII then IntelP6N:=''Intel Pentium(r) III''
else
if CheckXeon then IntelP6N:=''Intel Pentium(r) III Xeon(tm)''
else
if not CheckMMX then IntelP6N:=''Intel Pentium(r) PRO''
else IntelP6N:=''Intel Pentium(r) II'';  
end;
function TCpuData.AMDK5N:string;
var Family,Model,Stepping:byte;
begin
GetFMS(Family,Model,Stepping);
if Model=0 then AMDK5N:=''AMD K5''
else AMDK5N:=GetExtendedCpuName;
end;
function TCpuData.Cyrix686N:string;
begin
if CpuData.GetMaxExtendedFunctions>0 then Cyrix686N:=GetExtendedCpuName
else
if CheckMMX then Cyrix686N:=''VIA Cyrix 6x86MII''
else
Cyrix686N
:=''VIA Cyrix 6x86'';
end;
function TCpuData.GenericCpuN:string;
var SysInfo:TSystemInfo;
begin
GetSystemInfo(SysInfo);
if SysInfo.dwProcessorType=386
   
then GenericCpuN:=''Generic 386 CPU''
else
if SysInfo.dwProcessorType=486
   
then GenericCpuN:=''Generic 486 CPU''
else
if SysInfo.dwProcessorType=586
   
then GenericCpuN:=''Pentium Class CPU''
else GenericCpuN:=''Unknown CPU'';
end;
function TCpuData.P5CacheL1DI:word;
begin
if CheckMMX then P5CacheL1DI:=16
else P5CacheL1DI:=8;
end;
function TCpuData.P6CacheL1DI:word;
begin
if not CheckMMX then P6CacheL1DI:=8
else P6CacheL1DI:=16;
end;
function TCpuData.P6CacheL2:word;
var Family,Model,Stepping:byte;
begin
if CheckCeleron then P6CacheL2:=128
else
if CheckPentiumIII then begin
                         
GetFMS(Family,Model,Stepping);
                         
if Model=7 then P6CacheL2:=512
                         
else if Model=8 then P6cacheL2:=256
                         
else P6CacheL2:=512;
                         
end
else if not CheckMMX then P6CacheL2:=512
else P6CacheL2:=512;
end;
function TCpuData.AuthenticAMD:TCpuRec;
var Family,Model,Stepping:byte;
   
EFamily,EModel,EStepping:byte;
begin
GetFMS(Family,Model,Stepping);
If Family=4 then begin
                   
AuthenticAMD.Name:=''AMD 486'';
                   
AuthenticAMD.Vendor:=GetVendorString;
                   
AuthenticAMD.Frequency:=0;
                   
AuthenticAMD.Family:=Family;
                   
AuthenticAMD.Model:=Model;
                   
AuthenticAMD.Stepping:=Stepping;
                   
AuthenticAMD.L1DCache:=8;
                   
AuthenticAMD.L1ICache:=8;
                   
AuthenticAMD.L2Cache:=0;
                 
end
else
if Family=5 then begin
                   
if GetMaxExtendedFunctions>4 then
                     
begin
                       
AuthenticAMD.Name:=GetExtendedCpuName;
                       
AuthenticAMD.Vendor:=GetVendorString;
                       
AuthenticAMD.Frequency:=GetCPUFrequency;
                       
GetExtendedFMS(EFamily,EModel,EStepping);
                       
AuthenticAMD.Family:=EFamily;
                       
AuthenticAMD.Model:=EModel;
                       
AuthenticAMD.Stepping:=EStepping;
                       
AuthenticAMD.L1DCache:=GetExtendedL1DCache;
                       
AuthenticAMD.L1ICache:=GetExtendedL1ICache;
                       
AuthenticAMD.L2Cache:=0;
                     
end
                   
else
                   
begin
                   
AuthenticAMD.Name:=AMDK5N;
                   
AuthenticAMD.Vendor:=GetVendorString;
                   
AuthenticAMD.Frequency:=GetCPUFrequency;
                   
AuthenticAMD.Family:=Family;
                   
AuthenticAMD.Model:=Model;
                   
AuthenticAMD.Stepping:=Stepping;
                   
AuthenticAMD.L1DCache:=16;
                   
AuthenticAMD.L1ICache:=16;
                   
AuthenticAMD.L2Cache:=0;
                   
end;
                 
end
else if family>5 then
                 
begin
                 
AuthenticAMD.Name:=GetExtendedCpuName;
                 
AuthenticAMD.Name:=GetExtendedCpuName;
                 
AuthenticAMD.Vendor:=GetVendorString;
                 
AuthenticAMD.Frequency:=GetCPUFrequency;
                 
GetExtendedFMS(EFamily,EModel,EStepping);
                 
AuthenticAMD.Family:=EFamily;
                 
AuthenticAMD.Model:=EModel;
                 
AuthenticAMD.Stepping:=EStepping;
                 
AuthenticAMD.L1DCache:=GetExtendedL1DCache;
                 
AuthenticAMD.L1ICache:=GetExtendedL1ICache;
                 
AuthenticAMD.L2Cache:=GetExtendedL2Cache;
                 
end;
 
 
end;
function TCpuData.GenuineIntel:TCpuRec;
var Family,Model,Stepping:byte;
begin
GetFMS(Family,Model,Stepping);
if Family=4 then begin
                   
GenuineIntel.Name:=''Intel 486'';
                   
GenuineIntel.Vendor:=GetVendorString;
                   
GenuineIntel.Frequency:=0;
                   
GenuineIntel.Family:=Family;
                   
GenuineIntel.Model:=Model;
                   
GenuineIntel.Stepping:=Stepping;
                   
GenuineIntel.L1DCache:=8;
                   
GenuineIntel.L1ICache:=8;
                   
GenuineIntel.L2Cache:=0;
                 
end
else
if Family=5 then begin
                   
GenuineIntel.Name:=IntelP5N;
                   
GenuineIntel.Vendor:=GetVendorString;
                   
GenuineIntel.Frequency:=GetCPUFrequency;
                   
GenuineIntel.Family:=Family;
                   
GenuineIntel.Model:=Model;
                   
GenuineIntel.Stepping:=Stepping;
                   
GenuineIntel.L1DCache:=P5CacheL1DI;
                   
GenuineIntel.L1ICache:=P5CacheL1DI;
                   
GenuineIntel.L2Cache:=0;
                 
end
else
if Family=6 then begin
                   
GenuineIntel.Name:=IntelP6N;
                   
GenuineIntel.Vendor:=GetVendorString;
                   
GenuineIntel.Frequency:=GetCPUFrequency;
                   
GenuineIntel.Family:=Family;
                   
GenuineIntel.Model:=Model;
                   
GenuineIntel.Stepping:=Stepping;
                   
GenuineIntel.L1DCache:=P6CacheL1DI;
                   
GenuineIntel.L1ICache:=P6CacheL1DI;
                   
GenuineIntel.L2Cache:=P6CacheL2;
                 
end
else
if Family=$F then begin
                   
if CheckPentium4 then
                     
begin
                     
GenuineIntel.Name:=''Intel Pentium(r) 4'';
                     
GenuineIntel.Vendor:=GetVendorString;
                     
GenuineIntel.Frequency:=GetCPUFrequency;
                     
GenuineIntel.Family:=32;
                     
GenuineIntel.Model:=Model;
                     
GenuineIntel.Stepping:=Stepping;
                     
GenuineIntel.L1DCache:=8;
                     
GenuineIntel.L1ICache:=12;
                     
GenuineIntel.L2Cache:=256;
                     
end
                   
else if CheckIthanium then
                     
begin
                       
GenuineIntel.Name:=''Intel Ithanium'';
                       
GenuineIntel.Vendor:=GetVendorString;
                       
GenuineIntel.Frequency:=GetCPUFrequency;
                       
GenuineIntel.Family:=64;
                       
GenuineIntel.Model:=Model;
                       
GenuineIntel.Stepping:=Stepping;
                       
GenuineIntel.L1DCache:=0;
                       
GenuineIntel.L1ICache:=0;
                       
GenuineIntel.L2Cache:=0;
                     
end;
                     
end;
end;
function TCpuData.CyrixInstead:TCpuRec;
var Family,Model,Stepping:byte;
   
EFamily,EModel,EStepping:byte;
begin
GetFMS(Family,Model,Stepping);
if Family=4 then begin
                   
CyrixInstead.Name:=''VIA Cyrix 4x86'';
                   
CyrixInstead.Vendor:=GetVendorString;
                   
CyrixInstead.Frequency:=0;
                   
CyrixInstead.Family:=Family;
                   
CyrixInstead.Model:=Model;
                   
CyrixInstead.Stepping:=Stepping;
                   
CyrixInstead.L1DCache:=8;
                   
CyrixInstead.L1ICache:=8;
                   
CyrixInstead.L2Cache:=0;
                 
end
else
if Family=5 then begin
                   
CyrixInstead.Name:=''VIA Cyrix 5x86'';
                   
CyrixInstead.Vendor:=GetVendorString;
                   
CyrixInstead.Frequency:=GetCPUFrequency;
                   
CyrixInstead.Family:=Family;
                   
CyrixInstead.Model:=Model;
                   
CyrixInstead.Stepping:=Stepping;
                   
CyrixInstead.L1DCache:=8;
                   
CyrixInstead.L1ICache:=8;
                   
CyrixInstead.L2Cache:=0;
                 
end
else begin
       
if GetMaxExtendedFunctions>0 then
           
Begin
           
CyrixInstead.Name:=GetExtendedCpuName;
           
CyrixInstead.Vendor:=GetVendorString;
           
CyrixInstead.Frequency:=GetCPUFrequency;
           
GetExtendedFMS(EFamily,EModel,EStepping);
           
CyrixInstead.Family:=EFamily;
           
CyrixInstead.Model:=EModel;
           
CyrixInstead.Stepping:=EStepping;
           
CyrixInstead.L1DCache:=GetExtendedL1DCache;
           
CyrixInstead.L1ICache:=GetExtendedL1ICache;
           
CyrixInstead.L2Cache:=GetExtendedL2Cache;
           
end
       
else begin
             
CyrixInstead.Name:=Cyrix686N;
             
CyrixInstead.Vendor:=GetVendorString;
             
CyrixInstead.Frequency:=GetCPUFrequency;
             
CyrixInstead.Family:=Family;
             
CyrixInstead.Model:=Model;
             
CyrixInstead.Stepping:=Stepping;
             
CyrixInstead.L1DCache:=32;
             
CyrixInstead.L1ICache:=32;
             
CyrixInstead.L2Cache:=0;
           
end;
     
end;
end;
 
function TCpuData.GenericCPU:TCpuRec;
var Family,Model,Stepping:byte;
   
EFamily,EModel,EStepping:byte;
begin
if not GetCPUIDSupport then
   
begin
     
MessageDlg(''This CPU does not support the CPUID instruction!!!'',mtWarning,
     
[mbOk],0);
     
GenericCPU.Name:=''Unidentified CPU'';
     
GenericCPU.Vendor:=''Unidentified'';
     
GenericCPU.Frequency:=0;
     
GenericCPU.Family:=-1;
     
GenericCPU.Model:=-1;
     
GenericCPU.Stepping:=-1;
     
GenericCPU.L1DCache:=0;
     
GenericCPU.L1ICache:=0;
     
GenericCPU.L2Cache:=0;
   
end
else
begin
 
GetFMS(Family,Model,Stepping);
if GetMaxExtendedFunctions>0 then
     
begin
     
GenericCPU.Name:=GetExtendedCPUName;
     
GenericCPU.Vendor:=GetVendorString;
     
GenericCPU.Frequency:=GetCPUFrequency;
     
CpuData.GetExtendedFMS(EFamily,EModel,EStepping);
     
GenericCPU.Family:=EFamily;
     
GenericCPU.Model:=EFamily;
     
GenericCPU.Stepping:=EStepping;
     
GenericCPU.L1DCache:=GetExtendedL1DCache;
     
GenericCPU.L1ICache:=GetExtendedL1ICache;
     
GenericCPU.L2Cache:=GetExtendedL2Cache;
     
end
else begin
       
GenericCPU.Name:=GenericCpuN;
       
GenericCPU.Vendor:=GetVendorString;
       
if Family<=4 then GenericCPU.Frequency:=0
       
else GenericCPU.Frequency:=GetCPUFrequency;
       
GenericCPU.Family:=Family;
       
GenericCPU.Model:=Model;
       
GenericCPU.Stepping:=Stepping;
       
GenericCPU.L1DCache:=0;
       
GenericCPU.L1ICache:=0;
       
GenericCPU.L2Cache:=0;
     
end;
end;
end;
end.

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


Как узнать тип процессора (через реестр)?

function CPUType: string;
var
 
Reg: TRegistry;
begin
 
CPUType := '';
 
Reg := TRegistry.Create;
 
try
   
Reg.RootKey := HKEY_LOCAL_MACHINE;
   
if Reg.OpenKey('\Hardware\Description\System\CentralProcessor\0', False) then
     
CPUType := Reg.ReadString('Identifier');
 
finally
   
Reg.Free;
 
end;
end;

Источник: https://community.borland.com

Прислал p0sol


unit ExpandCPUInfo;
 
interface
 
type
 
TCPUInfo = packed record
IDString : array [0..11] of Char;
Stepping : Integer;
Model    : Integer;
Family   : Integer;
FPU
,
VirtualModeExtensions,
DebuggingExtensions,
PageSizeExtensions,
TimeStampCounter,
K86ModelSpecificRegisters
,
MachineCheckException,
CMPXCHG8B
,
APIC
,
MemoryTypeRangeRegisters,
GlobalPagingExtension,
ConditionalMoveInstruction,
MMX    
: Boolean;
SYSCALLandSYSRET,
FPConditionalMoveInstruction,
AMD3DNow
: Boolean;
CPUName : String;
end;
{информация об идентификации процессора}
function ExistCPUID:Boolean;
function CPUIDInfo(out info: TCPUInfo):Boolean;
{инф-я о технологии процессора}
function ExistMMX:Boolean;
function Exist3DNow:Boolean;
function ExistKNI:Boolean;
{------------------------}
procedure EMMS
;
procedure FEMMS
;
procedure PREFETCH
(p: Pointer); register;
 
implementation
 
function ExistCPUID : Boolean;
asm
 
pushfd
pop eax
mov ebx
, eax
xor eax
, 00200000h
push eax
popfd
pushfd
pop ecx
mov eax
,0
cmp ecx
, ebx
jz @NO_CPUID
inc eax
@NO_CPUID
:
end;
 
function CPUIDInfo(out info: TCPUIDInfo):Boolean;
 
function ExistExtendedCPUIDFunctions:Boolean;
asm
mov eax
,080000000h
db $0F
,$A2
end;
var
 
name
: array [0..47] of Char;
p
: Pointer;
begin
 
if ExistCPUID then asm
jmp
@Start
@BitLoop:
mov al
,dl
and al,1
mov
[edi],al
shr edx
,1
inc edi
loop
@BitLoop
ret
@Start:
mov edi
,info
mov eax
,0
db $0F
,$A2
mov
[edi],ebx
mov
[edi+4],edx
mov
[edi+8],ecx
mov eax
,1
db $0F
,$A2
mov ebx
,eax
and eax,0fh;
mov
[edi+12],eax;
shr ebx
,4
mov eax
,ebx
and eax,0fh
mov
[edi+12+4],eax
shr ebx
,4
mov eax
,ebx
and eax,0fh
mov
[edi+12+8],eax
add edi
,24
mov ecx
,6
call
@BitLoop
shr edx
,1
mov ecx
,3
call
@BitLoop
shr edx
,2
mov ecx
,2
call
@BitLoop
shr edx
,1
mov ecx
,1
call
@BitLoop
shr edx
,7
mov ecx
,1
call
@BitLoop
mov p
,edi
end;
if (info.IDString = 'AuthenticAMD') and ExistExtendedCPUIDFunctions then begin
asm
mov edi
,p
mov eax
,080000001h
db $0F
,$A2
mov eax
,edx
shr eax
,11
and al,1
mov
[edi],al
mov eax
,edx
shr eax
,16
and al,1
mov
[edi+1],al
mov eax
,edx
shr eax
,31
and al,1
mov
[edi+2],al
lea edi
,name
mov eax
,0
mov
[edi],eax
mov eax
,080000000h
db $0F
,$A2
cmp eax
,080000004h
jl
@NoString
mov eax
,080000002h
db $0F
,$A2
mov
[edi],eax
mov
[edi+4],ebx
mov
[edi+8],ecx
mov
[edi+12],edx
add edi
,16
mov eax
,080000003h
db $0F
,$A2
mov
[edi],eax
mov
[edi+4],ebx
mov
[edi+8],ecx
mov
[edi+12],edx
add edi
,16
mov eax
,080000004h
db $0F
,$A2
mov
[edi],eax
mov
[edi+4],ebx
mov
[edi+8],ecx
mov
[edi+12],edx
@NoString:
end;
info
.CPUName:=name;
end else with info do begin
SYSCALLandSYSRET:=False;
FPConditionalMoveInstruction:=False;
AMD3DNow
:=False;
CPUName:='';
end;
Result:=ExistCPUID;
end;
 
function ExistMMX:Boolean;
var
 
info
: TCPUIDInfo;
begin
 
if CPUIDInfo(info) then
Result:=info.MMX
else
Result:=False;
end;
 
function Exist3DNow:Boolean;
var
 
info
: TCPUIDInfo;
begin
 
if CPUIDInfo(info) then
Result:=info.AMD3DNow
else
Result:=False;
end;
 
function ExistKNI:Boolean;
begin
 
Result:=False;
end;
 
procedure EMMS
;
asm
 
db $0F
,$77
end;
 
procedure FEMMS
;
asm
 
db $0F
,$03
end;
 
procedure PREFETCH
(p: Pointer); register;
asm
 
// PREFETCH byte ptr [eax]
end;
 
end.

Взято с https://delphiworld.narod.ru


//Sometimes u need to know some information about the CPU 
//like: brand id, factory speed, wich instruction set supported etc.
//If so, than u can use this code.
//2002 by -=LTi=-
 
unit main
;
 
 
interface
 
 uses
   
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   
StdCtrls, ExtCtrls;
 
 type
   Tfrm_main
= class(TForm)
     img_info
: TImage;
     procedure
FormShow(Sender: TObject);
   
private
     
{ Private declarations }
   
public
     
{ Public declarations }
     procedure info
(s1, s2: string);
   
end;
 
 
var
   frm_main
: Tfrm_main;
   gn_speed_y
: Integer;
   gn_text_y
: Integer;
 
const
   gn_speed_x
: Integer = 8;
   gn_text_x
: Integer  = 15;
   gl_start
: Boolean   = True;
 
 implementation
 
 
{$R *.DFM}
 
 procedure Tfrm_main
.FormShow(Sender: TObject);
 
var
    _eax
, _ebx, _ecx, _edx: Longword;
   i
: Integer;
   b
: Byte;
   b1
: Word;
   s
, s1, s2, s3, s_all: string;
 
begin
   
//Set the startup colour of the image
  img_info
.Canvas.Brush.Color := clblue;
   img_info
.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));
 
 
   gn_text_y
:= 5; //position of the 1st text
 
 
asm                //asm call to the CPUID inst.
    mov eax
,0         //sub. func call
    db $0F
,$A2         //db $0F,$A2 = CPUID instruction
    mov _ebx
,ebx
     mov _ecx
,ecx
     mov _edx
,edx
   
end;
 
   
for i := 0 to 3 do   //extract vendor id
 
begin
     b
:= lo(_ebx);
     s
:= s + chr(b);
     b
:= lo(_ecx);
     s1
:= s1 + chr(b);
     b
:= lo(_edx);
     s2
:= s2 + chr(b);
     _ebx
:= _ebx shr 8;
     _ecx
:= _ecx shr 8;
     _edx
:= _edx shr 8;
   
end;
   info
('CPU', '');
   info
('   - ' + 'Vendor ID: ', s + s2 + s1);
 
   
asm
     mov eax
,1
     db $0F
,$A2
     mov _eax
,eax
     mov _ebx
,ebx
     mov _ecx
,ecx
     mov _edx
,edx
   
end;
   
//06B1
 
//|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|
  b
:= lo(_eax) and 15;
   info
('   - ' + 'Stepping ID: ', IntToStr(b));
   b
:= lo(_eax) shr 4;
   info
('   - ' + 'Model Number: ', IntToHex(b, 1));
   b
:= hi(_eax) and 15;
   info
('   - ' + 'Family Code: ', IntToStr(b));
   b
:= hi(_eax) shr 4;
   info
('   - ' + 'Processor Type: ', IntToStr(b));
   
//31.   28. 27.   24. 23.   20. 19.   16.
 
//  0 0 0 0   0 0 0 0   0 0 0 0   0 0 0 0
  b
:= lo((_eax shr 16)) and 15;
   info
('   - ' + 'Extended Model: ', IntToStr(b));
 
   b
:= lo((_eax shr 20));
   info
('   - ' + 'Extended Family: ', IntToStr(b));
 
   b
:= lo(_ebx);
   info
('   - ' + 'Brand ID: ', IntToStr(b));
   b
:= hi(_ebx);
   info
('   - ' + 'Chunks: ', IntToStr(b));
   b
:= lo(_ebx shr 16);
   info
('   - ' + 'Count: ', IntToStr(b));
   b
:= hi(_ebx shr 16);
   info
('   - ' + 'APIC ID: ', IntToStr(b));
 
   
//Bit 18 =? 1     //is serial number enabled?
 
if (_edx and $40000) = $40000 then
     info
('   - ' + 'Serial Number ', 'Enabled')
   
else
      info
('   - ' + 'Serial Number ', 'Disabled');
 
   s
:= IntToHex(_eax, 8);
   
asm                  //determine the serial number
    mov eax
,3
     db $0F
,$A2
     mov _ecx
,ecx
     mov _edx
,edx
   
end;
   s1
:= IntToHex(_edx, 8);
   s2
:= IntToHex(_ecx, 8);
   
Insert('-', s, 5);
   
Insert('-', s1, 5);
   
Insert('-', s2, 5);
   info
('   - ' + 'Serial Number: ', s + '-' + s1 + '-' + s2);
 
   
asm
     mov eax
,1
     db $0F
,$A2
     mov _edx
,edx
   
end;
   info
('', '');
   
//Bit 23 =? 1
 
if (_edx and $800000) = $800000 then
     info
('MMX ', 'Supported')
   
else
      info
('MMX ', 'Not Supported');
 
   
//Bit 24 =? 1
 
if (_edx and $01000000) = $01000000 then
     info
('FXSAVE & FXRSTOR Instructions ', 'Supported')
   
else
      info
('FXSAVE & FXRSTOR Instructions Not ', 'Supported');
 
   
//Bit 25 =? 1
 
if (_edx and $02000000) = $02000000 then
     info
('SSE ', 'Supported')
   
else
      info
('SSE ', 'Not Supported');
 
   
//Bit 26 =? 1
 
if (_edx and $04000000) = $04000000 then
     info
('SSE2 ', 'Supported')
   
else
      info
('SSE2 ', 'Not Supported');
 
   info
('', '');
 
   
asm     //execute the extended CPUID inst.
    mov eax
,$80000000   //sub. func call
    db $0F
,$A2
     mov _eax
,eax
   
end;
 
   
if _eax > $80000000 then  //any other sub. funct avail. ?
 
begin
     info
('Extended CPUID: ', 'Supported');
     info
('   - Largest Function Supported: ', IntToStr(_eax - $80000000));
     
asm     //get brand ID
      mov eax
,$80000002
       db $0F
       db $A2
       mov _eax
,eax
       mov _ebx
,ebx
       mov _ecx
,ecx
       mov _edx
,edx
     
end;
     s  
:= '';
     s1
:= '';
     s2
:= '';
     s3
:= '';
     
for i := 0 to 3 do
     
begin
       b
:= lo(_eax);
       s3
:= s3 + chr(b);
       b
:= lo(_ebx);
       s
:= s + chr(b);
       b
:= lo(_ecx);
       s1
:= s1 + chr(b);
       b
:= lo(_edx);
       s2
:= s2 + chr(b);
       _eax
:= _eax shr 8;
       _ebx
:= _ebx shr 8;
       _ecx
:= _ecx shr 8;
       _edx
:= _edx shr 8;
     
end;
 
     s_all
:= s3 + s + s1 + s2;
 
     
asm
       mov eax
,$80000003
       db $0F
       db $A2
       mov _eax
,eax
       mov _ebx
,ebx
       mov _ecx
,ecx
     mov _edx
,edx
     
end;
     s  
:= '';
     s1
:= '';
     s2
:= '';
     s3
:= '';
     
for i := 0 to 3 do
     
begin
       b
:= lo(_eax);
       s3
:= s3 + chr(b);
       b
:= lo(_ebx);
       s
:= s + chr(b);
       b
:= lo(_ecx);
       s1
:= s1 + chr(b);
       b
:= lo(_edx);
       s2
:= s2 + chr(b);
       _eax
:= _eax shr 8;
       _ebx
:= _ebx shr 8;
       _ecx
:= _ecx shr 8;
       _edx
:= _edx shr 8;
     
end;
     s_all
:= s_all + s3 + s + s1 + s2;
 
     
asm
       mov eax
,$80000004
       db $0F
       db $A2
       mov _eax
,eax
       mov _ebx
,ebx
       mov _ecx
,ecx
       mov _edx
,edx
     
end;
     s  
:= '';
     s1
:= '';
     s2
:= '';
     s3
:= '';
     
for i := 0 to 3 do
     
begin
       b  
:= lo(_eax);
       s3
:= s3 + chr(b);
       b
:= lo(_ebx);
       s
:= s + chr(b);
       b
:= lo(_ecx);
       s1
:= s1 + chr(b);
       b  
:= lo(_edx);
       s2
:= s2 + chr(b);
       _eax
:= _eax shr 8;
       _ebx
:= _ebx shr 8;
       _ecx
:= _ecx shr 8;
       _edx
:= _edx shr 8;
     
end;
     info
('Brand String: ', '');
     
if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
     info
('', '   - ' + s_all + s3 + s + s1 + s2);
   
end
   
else
      info
('   - Extended CPUID ', 'Not Supported.');
 
end;
 
 procedure Tfrm_main
.info(s1, s2: string);
 
begin
   
if s1 <> '' then
   
begin
     img_info
.Canvas.Brush.Color := clblue;
     img_info
.Canvas.Font.Color  := clyellow;
     img_info
.Canvas.TextOut(gn_text_x, gn_text_y, s1);
   
end;
   
if s2 <> '' then
   
begin
     img_info
.Canvas.Brush.Color := clblue;
     img_info
.Canvas.Font.Color  := clWhite;
     img_info
.Canvas.TextOut(gn_text_x + img_info.Canvas.TextWidth(s1), gn_text_y, s2);
   
end;
   
Inc(gn_text_y, 13);
 
end;
 
 
end.
 

Взято с сайта: https://www.swissdelphicenter.ch


function GetProcessorType: integer;
{Определение типа процессора.
Функция возвращает следующие значения,
определенные в модуле Windows:
PROCESSOR_INTEL_386
PROCESSOR_INTEL_486
PROCESSOR_INTEL_PENTIUM
PROCESSOR_MIPS_R4000
- Windows NT only
PROCESSOR_ALPHA_21064
- Windows NT only}
var
  sysInfo
: TSystemInfo;
begin
 
GetSystemInfo(sysInfo);
 
Result := sysInfo.dwProcessorType;
end;

https://delphiworld.narod.ru/

DelphiWorld 6.0