Delphi programming-use the cpuid command to obtain CPU Information

Unit CPU;

Interface

Uses types;

Const

// Version information bitmask
Bitmask_extendedfamilyid = $0ff00000;
Bitmask_extendedmodelid = $000f0000;
Bitmask_processortype = $00003000;
Bitmask_familyid = $00000f00;
Bitmask_modelid = $000000f0;
Bitmask_steppingid = $ 0000000f;

// Processor type
Processortype_originaloemprocessor =00000000;
Processortype_inteloverdriveprocessor = $00001000;
Processortype_dualprocessor = $00002000;
Processortype_intelreserved = $00003000;

Type

// Register used in cpuid instruction
Tcpuidregister = packed record
Eax: DWORD;
Case INTEGER
0: // register
(
EBX: DWORD;
ECX: DWORD;
EdX: DWORD;
);
1: // version information string
(
Vis1: array [1 .. 4] of char;
Vis2: array [1 .. 4] of char;
Vis3: array [1 .. 4] of char;
);
End;

Pcpuidregister = ^ tcpuidregister;

// Basic Cupid Information
Tcpuidbasicinformation = packed record
// Eax = 0
Highestbasicprocessorinformationvalue: Cardinal;
Vendoridentificationstring: String [12];
// Eax = 1
Extendedfamileyid,
Extendedmodelid,
Processortype,
Familyid,
Modelid,
Steppingid: DWORD;
End;

Pcpuidbasicinformation = ^ tcpuidbasicinformation;

Tcpuinfo = Class
Private
Fsupportforcpuid: Boolean;
Private
Function cpuid (value: DWORD): tcpuidregister;
Function get_cpuidbasicinformation: tcpuidbasicinformation;
Public
Constructor create;
Public
Property supportforcpuid: Boolean read fsupportforcpuid;
Property cpuidbasicinformation: tcpuidbasicinformation read get_cpuidbasicinformation;
End;

Implementation

Uses dialogs, sysutils;

{Tcpuinfo}

function tcpuinfo. cpuid (value: DWORD): tcpuidregister;
var
veax, vebx, vecx, vedx: DWORD;
begin
ASM
pushad
mov eax, value
cpuid
mov veax, eax
mov vebx, EBX
mov vecx, ECx
mov vedx, EDX
popad
end;
with result do
begin
eax: = veax;
EBX: = vebx;
ECx: = vecx;
edX: = vedx;
end;

constructor tcpuinfo. create;
const
ef_id: DWORD = $200000;
var
efid: DWORD;
begin
fsupportforcpuid: = false;
ASM
// save current register
pushad
// move old eflags to EBX
pushfd
pop eax
// move old eflags to EBX
mov EBX, eax
// revert ef_id
XOR eax, ef_id
push eax
popfd
// move New eflags to eax
pushfd
pop eax
// test ef_id
XOR eax, EBX
mov efid, eax
// restore register
popad
end;
If (efid XOR ef_id) = 0 then fsupportforcpuid: = true;
end;

Function tcpuinfo. get_cpuidbasicinformation: tcpuidbasicinformation;
VaR
Cpuidregister: tcpuidregister;
Begin
Cpuidregister: = cpuid (0 );
With cpuidregister, result do
Begin
Highestbasicprocessorinformationvalue: = eax;
Vendoridentificationstring: = vis1 + vis3 + vis2;
End;
Cpuidregister: = cpuid (1 );
With cpuidregister, result do
Begin
Extendedfamileyid: = eax and bitmask_extendedfamilyid;
Extendedmodelid: = eax and bitmask_extendedmodelid;
Processortype: = eax and bitmask_processortype;
Familyid: = eax and bitmask_familyid;
Modelid: = eax and bitmask_modelid;
Steppingid: = eax and bitmask_steppingid;
End;
End;

End.