Codec By GeNiUS !
genius@turkiye.com
Bilgisayardaki mikro işlemcinin tipinin ve üreticisinin tepit edilmesi için, aşağıdaki unit kullanılabilir.
unit CpuInfo;
interface
type
TFeatures = record
case integer of
0: (RegEAX,
RegEBX,
RegEDX,
RegECX:integer);
1 : (I :array [0..3] of integer);
2 : (C :array [0..15] of char);
3 : (B :array [0..15] of byte)
end;
const
{$IFNDEF WIN32}
i8086 = 1;
i80286 = 2;
i80386 = 3;
{$ENDIF}
i80486=4;
Chip486=4;
iPentium= 5;
Chip586=5;
iPentiumPro=6;
Chip686=6;
Intel='GenuineIntel';
AMD='AuthenticAMD';
var
CpuType:byte = 0;
VendorId:string [12]= '';
Features:TFeatures
procedure LoadFeatures (I : integer);
implementation
{$O-}
const
CpuId = $0a20f;
var
CpuIdFlag:boolean = false; MaxCPUId:integer;
procedure GetF;
asm
dw CpuId
mov [Features.RegEAX], eax
mov [Features.RegEBX], ebx
mov [Features.RegECX], ecx
mov [Features.RegEDX], edx
end;
procedure ClearF;
asm
mov edi, offset Features
xor eax, eax
mov ecx, eax
mov cl, 4
cld
rep stosd
end;
procedure CheckOutCpu;
asm
{$IFNDEF WIN32}
pushf
pop ax
mov cx, ax
and ax, 0fffh
push ax
popf
pushf
pop ax
and ax, 0f000h
cmp ax, 0f000h
mov [CPUType], 1
je @@2
or cx, 0f000h
push cx
popf
push
pop ax
and ax, 0f000h
mov [CPUType], 2
jz @@2
pushfd
pop eax
mov ecx, eax
xor eax, 40000h
push eax
popfd
pushfd
pop eax
xor eax, ecx
mov [CPUType], 3
jz @@2
push ecx
popfd
{$ENDIF}
mov [CPUType], 4
mov eax, ecx
xor eax, 200000h
push eax
popfd
pushfd
pop eax
xor eax, ecx
je @@2
mov [CPUIdFlag], 1
push ebx
mov eax,0
dw CpuId
mov [MaxCPUId], eax
mov [byte ptr VendorId], 12
mov [dword ptr VendorId+1], ebx
mov [dword ptr VendorId+5], edx
mov [dword ptr VendorId+9], ecx
callClearF
mov eax, 1
cal GetF
shr eax, 8
and eax, 0fh
mov [CPUType], al
@@1: pop ebx
@@2:
end;
procedure LoadFeatures (I : integer);
asm
call ClearF
cmp [CpuIdFlag], 0
je @@1
mov eax, [I]
cmp [MaxCpuId], eax
jl @@1
call GetF
@@1:
end;
initialization
CheckOutCPU;
end.
CPU tipi ile ilgili bilgiler, "Cputype", ve "vendorid" değişkenlerine yüklenmektedirler.;
Aynı maksatla kullanılabilecek başka bir kod örneği de şudur.
unit cpuinfo;
interface
uses
Windows, SysUtils;
type
Freq_info = Record
Raw_Freq: Cardinal; // Ham CPU frekansı MHz.
Norm_Freq: Cardinal; // Ortalama CPU frekansı MHz.
In_Cycles: Cardinal; // Sistem saati hizi
Ex_Ticks: Cardinal; // Test süresi
end;
TCpuInfo = Record
VendorIDString: String;
Manufacturer: String;
CPU_Name: String;
PType: Byte;
Family: Byte;
Model: Byte;
Stepping: Byte;
Features: Cardinal;
MMX: Boolean;
Frequency_Info: Freq_Info;
IDFDIVOK: Boolean;
end;
Const
InfoStrings: Array[0..1] of String = ('FDIV instruction is Flawed',
'FDIV instruction is OK');
Const
// CPU değerlerinin tespitinde kullanılacak sabitler
// Örnek IF (Features and FPU_FLAG = FPU_FLAG) ise CPU'da Floating-Point birim vardır.
FPU_FLAG = $00000001;
VME_FLAG = $00000002;
DE_FLAG = $00000004;
PSE_FLAG = $00000008;
TSC_FLAG = $00000010;
MSR_FLAG = $00000020;
PAE_FLAG = $00000040;
MCE_FLAG = $00000080;
CX8_FLAG = $00000100;
APIC_FLAG = $00000200;
BIT_10 = $00000400;
SEP_FLAG = $00000800;
MTRR_FLAG = $00001000;
PGE_FLAG = $00002000;
MCA_FLAG = $00004000;
CMOV_FLAG = $00008000;
BIT_16 = $00010000;
BIT_17 = $00020000;
BIT_18 = $00040000;
BIT_19 = $00080000;
BIT_20 = $00100000;
BIT_21 = $00200000;
BIT_22 = $00400000;
MMX_FLAG = $00800000;
BIT_24 = $01000000;
BIT_25 = $02000000;
BIT_26 = $04000000;
BIT_27 = $08000000;
BIT_28 = $10000000;
BIT_29 = $20000000;
BIT_30 = $40000000;
BIT_31 = $80000000;
Procedure GetCPUInfo(Var CPUInfo: TCpuInfo);
Function GetRDTSCCpuSpeed: Freq_Info;
Function CPUID: TCpuInfo;
Function TestFDIVInstruction: Boolean;
implementation
Procedure GetCPUInfo(Var CPUInfo: TCpuInfo);
begin
CPUInfo := CPUID;
CPUInfo.IDFDIVOK := TestFDIVInstruction;
IF (CPUInfo.Features and TSC_FLAG = TSC_FLAG) then
CPUInfo.Frequency_Info := GetRDTSCCpuSpeed;
If (CPUInfo.Features and MMX_FLAG) = MMX_FLAG then
CPUInfo.MMX := True
else
CPUInfo.MMX := False;
end;
Function GetRDTSCCpuSpeed: Freq_Info;
var
Cpu_Speed: Freq_Info;
t0, t1: TLargeInteger;
freq, freq2, freq3, Total: Cardinal;
Total_Cycles, Cycles: Cardinal;
Stamp0, Stamp1: Cardinal;
Total_Ticks, Ticks: Cardinal;
Count_Freq: TLargeInteger;
Tries, IPriority, hThread: Integer;
begin
freq := 0;
freq2 := 0;
freq3 := 0;
tries := 0;
total_cycles := 0;
total_ticks := 0;
Total := 0;
hThread := GetCurrentThread();
if (Not QueryPerformanceFrequency(count_freq)) then
begin
Result := cpu_speed;
end
else
begin
while ((tries < 3 ) or ((tries < 20) and ((abs(3 * freq - total) > 3) or
(abs(3 * freq2-total) > 3) or (abs(3 * freq3-total) > 3)))) do
begin
inc(tries);
freq3 := freq2;
freq2 := freq;
QueryPerformanceCounter(t0);
t1.LowPart := t0.LowPart;
t1.HighPart := t0.HighPart;
iPriority := GetThreadPriority(hThread);
if ( iPriority <> THREAD_PRIORITY_ERROR_RETURN ) then
begin
SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
end;
while ((t1.LowPart - t0.LowPart) < 50) do
begin
QueryPerformanceCounter(t1);
asm
push eax
push edx
db 0Fh
db 31h
MOV stamp0, EAX
pop edx
pop eax
end;
end;
t0.LowPart := t1.LowPart;
t0.HighPart := t1.HighPart;
while ((t1.LowPart - t0.LowPart) < 1000) do
begin
QueryPerformanceCounter(t1);
asm
push eax
push edx
db 0Fh
db 31h
MOV stamp1, EAX
pop edx
pop eax
end;
end;
if ( iPriority <> THREAD_PRIORITY_ERROR_RETURN ) then
begin
SetThreadPriority(hThread, iPriority);
end;
cycles := stamp1 - stamp0;
ticks := t1.LowPart - t0.LowPart;
ticks := ticks * 100000;
ticks := Round(Ticks / (count_freq.LowPart/10));
total_ticks := Total_Ticks + ticks;
total_cycles := Total_Cycles + cycles;
freq := Round(cycles / ticks);
total := (freq + freq2 + freq3);
end;
freq3 := Round((total_cycles * 10) / total_ticks);
freq2 := Round((total_cycles * 100) / total_ticks);
If (freq2 - (freq3 * 10) >= 6) then
inc(freq3);
cpu_speed.raw_freq := Round(total_cycles / total_ticks);
cpu_speed.norm_freq := cpu_speed.raw_freq;
freq := cpu_speed.raw_freq * 10;
if((freq3 - freq) >= 6) then
inc(cpu_speed.norm_freq);
cpu_speed.ex_ticks := total_ticks;
cpu_speed.in_cycles := total_cycles;
Result := cpu_speed;
end;
end;
Function CPUID: TCpuInfo;
type
regconvert = record
bits0_7: Byte;
bits8_15: Byte;
bits16_23: Byte;
bits24_31: Byte;
end;
var
CPUInfo: TCpuInfo;
TEBX, TEDX, TECX: Cardinal;
TString: String;
VString: String;
temp: regconvert;
begin
asm
MOV [CPUInfo.PType], 0
MOV [CPUInfo.Model], 0
MOV [CPUInfo.Stepping], 0
MOV [CPUInfo.Features], 0
MOV [CPUInfo.Frequency_Info.Raw_Freq], 0
MOV [CPUInfo.Frequency_Info.Norm_Freq], 0
MOV [CPUInfo.Frequency_Info.In_Cycles], 0
MOV [CPUInfo.Frequency_Info.Ex_Ticks], 0
push eax
push ebp
push ebx
push ecx
push edi
push edx
push esi
@@Check_80486:
MOV [CPUInfo.Family], 4
MOV TEBX, 0
MOV TEDX, 0
MOV TECX, 0
PUSHFD
POP EAX
MOV ECX, EAX
XOR EAX, 200000H
PUSH EAX
POPFD
PUSHFD
POP EAX
XOR EAX, ECX
JE @@DONE_CPU_TYPE
@@Has_CPUID_Instruction:
MOV EAX, 0
DB 0FH
DB 0A2H
MOV TEBX, EBX
MOV TEDX, EDX
MOV TECX, ECX
MOV EAX, 1
DB 0FH
DB 0A2H
MOV [CPUInfo.Features], EDX
MOV ECX, EAX
AND EAX, 3000H
SHR EAX, 12
MOV [CPUInfo.PType], AL
MOV EAX, ECX
AND EAX, 0F00H
SHR EAX, 8
MOV [CPUInfo.Family], AL
MOV EAX, ECX
AND EAX, 00F0H
SHR EAX, 4
MOV [CPUInfo.MODEL], AL
MOV EAX, ECX
AND EAX, 000FH
MOV [CPUInfo.Stepping], AL
@@DONE_CPU_TYPE:
pop esi
pop edx
pop edi
pop ecx
pop ebx
pop ebp
pop eax
end;
If (TEBX = 0) and (TEDX = 0) and (TECX = 0) and (CPUInfo.Family = 4) then
begin
CPUInfo.VendorIDString := 'Unknown';
CPUInfo.Manufacturer := 'Unknown';
CPUInfo.CPU_Name := 'Generic 486';
end
else
begin
With regconvert(TEBX) do
begin
TString := CHR(bits0_7) + CHR(bits8_15) + CHR(bits16_23) + CHR(bits24_31);
end;
With regconvert(TEDX) do
begin
TString := TString + CHR(bits0_7) + CHR(bits8_15) + CHR(bits16_23) + CHR(bits24_31);
end;
With regconvert(TECX) do
begin
TString := TString + CHR(bits0_7) + CHR(bits8_15) + CHR(bits16_23) + CHR(bits24_31);
end;
VString := TString;
CPUInfo.VendorIDString := TString;
If (CPUInfo.VendorIDString = 'GenuineIntel') then
begin
CPUInfo.Manufacturer := 'Intel';
Case CPUInfo.Family of
4: Case CPUInfo.Model of
1: CPUInfo.CPU_Name := 'Intel 486DX Processor';
2: CPUInfo.CPU_Name := 'Intel 486SX Processor';
3: CPUInfo.CPU_Name := 'Intel DX2 Processor';
4: CPUInfo.CPU_Name := 'Intel 486 Processor';
5: CPUInfo.CPU_Name := 'Intel SX2 Processor';
7: CPUInfo.CPU_Name := 'Write-Back Enhanced Intel DX2 Processor';
8: CPUInfo.CPU_Name := 'Intel DX4 Processor';
else CPUInfo.CPU_Name := 'Intel 486 Processor';
end;
5: CPUInfo.CPU_Name := 'Pentium';
6: Case CPUInfo.Model of
1: CPUInfo.CPU_Name := 'Pentium Pro';
3: CPUInfo.CPU_Name := 'Pentium II';
else CPUInfo.CPU_Name := PChar(Format('P6 (Model %d)', [CPUInfo.Model]));
end;
else CPUInfo.CPU_Name := Format('P%d', [CPUInfo.Family]);
end;
end
else if (CPUInfo.VendorIDString = 'CyrixInstead') then
begin
CPUInfo.Manufacturer := 'Cyrix';
Case CPUInfo.Family of
5: CPUInfo.CPU_Name := 'Cyrix 6x86';
6: CPUInfo.CPU_Name := 'Cyrix M2';
else CPUInfo.CPU_Name := Format('%dx86', [CPUInfo.Family]);
end;
end
else if (CPUInfo.VendorIDString = 'AuthenticAMD') then
begin
CPUInfo.Manufacturer := 'AMD';
Case CPUInfo.Family of
4: CPUInfo.CPU_Name := 'Am486 or Am5x86';
5: Case CPUInfo.Model of
0: CPUInfo.CPU_Name := 'AMD-K5 (Model 0)';
1: CPUInfo.CPU_Name := 'AMD-K5 (Model 1)';
2: CPUInfo.CPU_Name := 'AMD-K5 (Model 2)';
3: CPUInfo.CPU_Name := 'AMD-K5 (Model 3)';
6: CPUInfo.CPU_Name := 'AMD-K6';
else CPUInfo.CPU_Name := 'Unknown AMD Model';
end;
else CPUInfo.CPU_Name := 'Unknown AMD Chip';
end;
end
else
begin
CPUInfo.VendorIDString := TString;
CPUInfo.Manufacturer := 'Unknown';
CPUInfo.CPU_Name := 'Unknown';
end;
end;
Result := CPUInfo;
end;
Function TestFDIVInstruction: Boolean;
var
TestDividend: Double;
TestDivisor: Double;
TestOne: Double;
ISOK: Boolean;
begin
TestDividend := 4195835.0;
TestDivisor := 3145727.0;
TestOne := 1.0;
asm
PUSH EAX
FLD [TestDividend]
FDIV [TestDivisor]
FMUL [TestDivisor]
FSUBR [TestDividend]
FCOMP [TestOne]
FSTSW AX
SHR EAX, 8
AND EAX, 01H
MOV ISOK, AL
POP EAX
end;
Result := ISOK;
end;
end.