|
PRÉSENTATION :
Présentation de la fonction CPUID
NOTES :
Cette fonction permet de déterminer le type de processeur installé.
Ce code suppose que le processeur est un 386 au minimum, et il ne fonctionne pour le momment qu'avec les processeurs des marques Intel et AMD.
Le type de processeur en dessous de 486 DX4, n'est pas détaillé car ce type de processeur ne supporte pas la fonction CPUID.
CODE :
Unit Unit1;
//
// Sujet : Détermination du type de processeur
//
// Par Nono40 : http://nono40.developpez.com http://nono40.fr.st
// mailTo:nono40@fr.st
//
// Le 03/08/2003
//
Interface
Uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
Type
TForm1 = Class(TForm)
GroupBox1: TGroupBox;
Label6: TLabel;
Label5: TLabel;
lProcesseur: TLabel;
lCPUID: TLabel;
PanelDetail1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
lStepping: TLabel;
lModele: TLabel;
lFamille: TLabel;
lType: TLabel;
Label7: TLabel;
lVendeur: TLabel;
Label8: TLabel;
lSN: TLabel;
Label9: TLabel;
lChaine: TLabel;
Procedure FormShow(Sender: TObject);
Private
{ Déclarations privées }
Public
{ Déclarations publiques }
End;
Var
Form1: TForm1;
Implementation
{$R *.dfm}
Type
TInfoProc = Packed Record
ipCPUID : Boolean; // True si CPUID existe
ipVendeur : String[12]; // Chaine déterminant le constructeur
ipEstIntel : Boolean; // True si le processeur est Intel
ipEstAMD : Boolean; // True si le processeur est AMD
ipFamille : Integer; // Intel : Famille
ipModele : Integer; // Intel : Modèle dans la famille
ipType : Integer; // Intel : Type dans le modèle
ipFamilleEx : Integer;
ipModeleEx : Integer;
ipVersion : Integer; // Intel : Numéro de version
ipFlags1 : DWord; // Intel : flags de foncionnalités
ipFlags2 : DWord; // Intel : flags de foncionnalités
ipAvecSN : Boolean; // True si un numéro de série existe
ipSN : Array[0..4]Of Word; // Numéro de série
ipAvecChaine : Boolean; // True si une chaine d'identification existe
ipChaine : Array[0..47]Of Char;// Chaine d'identification
End;
Const
InfoProcSize = SizeOf(TInfoProc);
Procedure LireInfosProcesseur(Var Infos:TInfoProc);Register;
// L'adresse de Infos est contenue dans EAX
Const
// Chaine type pour les processeur Intel
VendeurIntel:ShortString='GenuineIntel';
// Chaine type pour les processeur AMD
VendeurAMD :ShortString='AuthenticAMD';
Asm
PUSH EBX
PUSH EDI
// Mise à 0 de la structure
MOV EDI,EAX // EDI va pointer vers Infos dans le reste du code
PUSH EDI
XOR EAX,EAX
MOV ECX,InfoProcSize
CLD
REP STOSB
POP EDI
// Test de la possiblité d'utiliser CPUID
// Cette méthode est directement tirée de la doc Intel
PUSHFD // Obtentions des Etats actuels
POP EAX
MOV ECX,EAX // Sauvegarde...
XOR EAX, 200000h // Changement du bit ID
PUSH EAX // Sauvegarde des Etats dans le proc
POPFD //
PUSHFD // Obtentions des Etats actuels
POP EAX //
XOR EAX,ECX // Test si le bit ID a été conservé
JE @@FIN // Fin si le processeur ne supporte pas CPUID
MOV TInfoProc([EDI]).ipCPUID,True
// Obtention du Vendeur
// La "fonction" 0 demande le numéro maximum de fonction
// utilisable, mais aussi le vendeur sur 12 caractères
MOV EAX,0
CPUID
MOV Byte Ptr TInfoProc([EDI]).ipVendeur[0],12
MOV DWord Ptr TInfoProc([EDI]).ipVendeur[1],EBX
MOV DWord Ptr TInfoProc([EDI]).ipVendeur[5],EDX
MOV DWord Ptr TInfoProc([EDI]).ipVendeur[9],ECX
// Test si le vendeur est Intel
CMP DWord Ptr VendeurIntel[1],EBX
JNE @@AMD
CMP DWord Ptr VendeurIntel[5],EDX
JNE @@AMD
CMP DWord Ptr VendeurIntel[9],ECX
JNE @@AMD
MOV TInfoProc([EDI]).ipEstIntel,True
JMP @@Intel
@@AMD:
// Test si le vendeur est AMD
CMP DWord Ptr VendeurAMD[1],EBX
JNE @@Fin
CMP DWord Ptr VendeurAMD[5],EDX
JNE @@Fin
CMP DWord Ptr VendeurAMD[9],ECX
JNE @@Fin
MOV TInfoProc([EDI]).ipEstAMD,True
@@Intel:
// Obtention des informations de base qui permettent
// de déterminer le type de processeur aussi que les
// Flags de fonctionnalités
MOV EAX,1
CPUID
MOV TInfoProc([EDI]).ipFlags1,EDX // Sauvegarde des flags
MOV TInfoProc([EDI]).ipFlags2,ECX
MOV EDX,EAX // EDX contient une copie de EAX
AND EAX,$0000000F // Les bits 0..3 contiennent StepID
MOV TInfoProc([EDI]).ipVersion,EAX
SHLD EAX,EDX,28 // Les bits 4..7 contiennent le modèle
AND EAX,$0000000F
MOV TInfoProc([EDI]).ipModele,EAX
CMP EAX,$0000000F // Si la modèle est à 15 ...
JB @@L001
SHLD EAX,EDX,16 // ... alors les bit 16..19
AND EAX,$0000000F // contiennent le modèle étendu
MOV TInfoProc([EDI]).ipModeleEx,EAX
@@L001:
SHLD EAX,EDX,24 // Les bits 8..11 Contiennent la famille
AND EAX,$0000000F
MOV TInfoProc([EDI]).ipFamille,EAX
CMP EAX,$0000000F // Si la famille est à 15 ...
JB @@L002
SHLD EAX,EDX,12 // ... alors les bit 20..27
AND EAX,$000000FF // Contiennent la famille étendue
MOV TInfoProc([EDI]).ipFamilleEx,EAX
@@L002:
SHLD EAX,EDX,20 // Les bits 12..13 contiennent le type
AND EAX,$00000003
MOV TInfoProc([EDI]).ipType,EAX
// Test de la possiblité d'un numéro de série
TEST TInfoProc([EDI]).ipFlags1,$00040000
JZ @@NOSN // Le bit 18 des Flags indiquent la présence
// du numéro de série
MOV TInfoProc([EDI]).ipAvecSN,True
MOV EAX,1
CPUID
SHR EAX,16
MOV Word Ptr TInfoProc([EDI]).ipSN[4],AX
MOV EAX,3
CPUID
MOV DWord Ptr TInfoProc([EDI]).ipSN[0],ECX
MOV DWord Ptr TInfoProc([EDI]).ipSN[2],EDX
@@NOSN:
// Test de la chaine de description
// pour les PIV minimum
{ CMP DWord Ptr TInfoProc([EDI]).ipFamille,15
JNE @@NOCHAINE // Seuls les PIV et supérieurs ont une chaine}
MOV EAX,$80000000
CPUID
CMP EAX,$80000004 // Mais il faut quand tester si la fonctions
JB @@NOCHAINE // est disponible
MOV TInfoProc([EDI]).ipAvecChaine,True
MOV EAX,$80000002
CPUID
MOV DWord Ptr TInfoProc([EDI]).ipChaine[ 0],EAX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[ 4],EBX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[ 8],ECX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[12],EDX
MOV EAX,$80000003
CPUID
MOV DWord Ptr TInfoProc([EDI]).ipChaine[16],EAX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[20],EBX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[24],ECX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[28],EDX
MOV EAX,$80000004
CPUID
MOV DWord Ptr TInfoProc([EDI]).ipChaine[32],EAX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[36],EBX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[40],ECX
MOV DWord Ptr TInfoProc([EDI]).ipChaine[44],EDX
@@NOCHAINE:
@@Fin:
POP EDI
POP EBX
End;
Procedure TForm1.FormShow(Sender: TObject);
Var Infos:TInfoProc;
Begin
LireInfosProcesseur(Infos);
With Infos Do
Begin
If ipCPUID Then
Begin
lCPUID .Caption := 'Instruction CPUID supportée';
lVendeur .Caption := ipVendeur;
If ipEstIntel Then
Begin
PanelDetail1 .Visible := True;
PanelDetail1 .Caption := 'Détail processeur Intel';
lStepping .Caption := IntToStr(ipVersion);
lModele .Caption := IntToStr(ipModele );
lFamille .Caption := IntToStr(ipFamille);
lType .Caption := IntToStr(ipType);
Case ipFamille Of
4 : Case ipModele Of
0..7 : lProcesseur.Caption := '486 SX/DX/DX2';
8 : lProcesseur.Caption := '486 DX4';
Else
lProcesseur.Caption := '486 ( modèle indéfini )';
End;
5 : Case ipModele Of
1 : lProcesseur.Caption := 'Pentium (60,66)';
2 : lProcesseur.Caption := 'Pentium (75 et plus)';
3 : lProcesseur.Caption := 'Pentium (OverDrive pour 486)';
4 : lProcesseur.Caption := 'Pentium MMX';
Else
lProcesseur.Caption := 'Pentium ( modèle indéfini )';
End;
6 : Case ipModele Of
1 : lProcesseur.Caption := 'Pentium Pro';
3 : lProcesseur.Caption := 'Pentium II (Modèle 3)';
5 : lProcesseur.Caption := 'Pentium II / Céléron (Modèle 5)';
6 : lProcesseur.Caption := 'Céléron (Modèle 6)';
7 : lProcesseur.Caption := 'Pentium III (Modèle 7)';
8 : lProcesseur.Caption := 'Pentium III / Céléron (Modèle 8)';
9 : lProcesseur.Caption := 'Pentium M';
10 : lProcesseur.Caption := 'Pentium III Xéon ( Modèle A )';
11 : lProcesseur.Caption := 'Pentium III ( Modèle B )';
Else
lProcesseur.Caption := 'Pentium II/III ( modèle indéfini )';
End;
15: Case ipModele Of
0 : lProcesseur.Caption := 'Pentium IV, Xéon ( 0.18µ )';
1 : lProcesseur.Caption := 'Pentium IV, Xéon ,MP ,Céléron ( 0.18µ )';
2 : lProcesseur.Caption := 'Pentium IV, Xéon ,MP ,Céléron ( 0.13µ )';
Else
lProcesseur.Caption := 'Pentium IV ( modèle indéfini )';
End;
Else
lProcesseur.Caption := '( processeur indéterminé )';
End;
If ipType=1
Then lProcesseur.Caption := lProcesseur.Caption + ' [OverDrive]';
If ipAvecSN
Then lSn.Caption := IntToHex(ipSN[4],4)+
'-'+IntToHex(ipSN[3],4)+
'-'+IntToHex(ipSN[2],4)+
'-'+IntToHex(ipSN[1],4)+
'-'+IntToHex(ipSN[0],4)
Else lSN.Caption := 'Aucun ou désactivé';
If ipAvecChaine
Then lChaine.CAption := ipChaine
Else lChaine.Caption := '( Pas de chaine d''identification )';
End Else
If ipEstAMD Then
Begin
PanelDetail1 .Visible := True;
PanelDetail1 .Caption := 'Détail processeur AMD';
lStepping .Caption := IntToStr(ipVersion);
lModele .Caption := IntToStr(ipModele );
lFamille .Caption := IntToStr(ipFamille);
lType .Caption := IntToStr(ipType);
Case ipFamille Of
4 : lProcesseur.Caption := 'AM486 ou AM5x86';
5 : Case ipModele Of
0 : lProcesseur.Caption := 'AMD-K5 Modèle 0';
1 : lProcesseur.Caption := 'AMD-K5 Modèle 1';
2 : lProcesseur.Caption := 'AMD-K5 Modèle 2';
3 : lProcesseur.Caption := 'AMD-K5 Modèle 3';
6 : lProcesseur.Caption := 'AMD-K6 Modèle 6';
7 : lProcesseur.Caption := 'AMD-K6 Modèle 7';
8 : lProcesseur.Caption := 'AMD-K6-2 Modèle 8';
9 : lProcesseur.Caption := 'AMD-K6-III Modèle 9';
Else
lProcesseur.Caption := 'AMD K5/K6 ( modèle indéfini )';
End;
6 : Case ipModele Of
1 : lProcesseur.Caption := 'AMD-Athlon Modèle 1';
2 : lProcesseur.Caption := 'AMD-Athlon Modèle 2';
3 : lProcesseur.Caption := 'AMD-Duron Modèle 3';
4 : lProcesseur.Caption := 'AMD-Athlon Modèle 4';
6 : lProcesseur.Caption := 'AMD-Athlon/Duron Modèle 6';
7 : lProcesseur.Caption := 'AMD-Duron Modèle 7';
8 : lProcesseur.Caption := 'AMD-Athlon Modèle 8';
10 : lProcesseur.Caption := 'AMD-Athlon/Duron Modèle 10';
Else
lProcesseur.Caption := 'AMD-Athlon/Duron ( modèle indéfini )';
End;
15: Case ipModele Of
5 : lProcesseur.Caption := 'AMD-Opteron ( Modèle 5 )';
Else
lProcesseur.Caption := 'AMD-Opteron ( modèle indéfini )';
End;
Else
lProcesseur.Caption := '( processeur indéterminé )';
End;
lSN.Caption := 'Pas de numéro de série sur AMD';
If ipAvecChaine
Then lChaine.CAption := ipChaine
Else lChaine.Caption := '( Pas de chaine d''identification )';
End Else
Begin
PanelDetail1.Visible := False;
lProcesseur .Caption := '( processeur non Intel )';
End;
End Else
Begin
lCPUID .Caption := 'Instruction CPUID non supportée';
lVendeur .Caption := 'Inconnu';
lProcesseur .Caption := '( processeur inconnu )';
PanelDetail1.Visible := False;
End;
End;
End;
end.
|
| |
