Developpez.com - Delphi
X

Choisissez d'abord la catégorieensuite la rubrique :

Nono40.developpez.com
Le petit coin du web de Nono40
SOURCES TESTS DELPHI WIN32 AUTOMATISMES DELPHI .NET QUICK-REPORT
Retour à l'accueil
63 - CPUID : INFORMATION SUR LE PROCESSEUR

PRÉSENTATION : Présentation de la fonction CPUID
ZIP : Téléchargez le zip APERÇUS : -1.jpg-

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;
          15Case 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;
          15Case 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.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -