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

Материал из DRKB

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

О процессоре можно на любом уровне (приложении или драйвере) получить информацию с помощью команды(машинной) 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);
end;


Author: Chingachguk
ID: 01421



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.


Source: Взято из http://forum.sources.ru
ID: 01422



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


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;


Author: p0sol
Source: http://community.borland.com
ID: 01423



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.


Source: Взято с http://delphiworld.narod.ru
ID: 01424



// 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);
  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 &amp; FXRSTOR Instructions ', 'Supported')
  else
    info('FXSAVE &amp; 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.


Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01425



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


Source: http://delphiworld.narod.ru/
ID: 01426