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

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