home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d56 / MSYSINFO.ZIP / Source / MSI_CPU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-24  |  33.7 KB  |  1,335 lines
  1.  
  2. {*******************************************************}
  3. {                            }
  4. {    MiTeC System Information Component        }
  5. {        CPU Detection Part            }
  6. {        version 6.0 for Delphi 5,6            }
  7. {                            }
  8. {    Copyright ⌐ 1997,2001 Michal Mutl        }
  9. {                            }
  10. {*******************************************************}
  11.  
  12. {$INCLUDE MITEC_DEF.INC}
  13.  
  14. unit MSI_CPU;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, Windows, Classes;
  20.  
  21. type
  22.   TCPUIDResult = packed record
  23.     EAX: Cardinal;
  24.     EBX: Cardinal;
  25.     ECX: Cardinal;
  26.     EDX: Cardinal;
  27.   end;
  28.  
  29.   TIntelCache = record
  30.     L2Cache: Cardinal;
  31.     CacheDescriptors: array [0..15] of Byte;
  32.   end;
  33.  
  34.   TAMDCache = record
  35.     DataTLB: array [0..1] of Byte;
  36.     InstructionTLB: array [0..1] of Byte;
  37.     L1DataCache: array [0..3] of Byte;
  38.     L1ICache: array [0..3] of Byte;
  39.   end;
  40.  
  41.   TCyrixCache = record
  42.     L1CacheInfo: array [0..3] of Byte;
  43.     TLBInfo: array [0..3] of Byte;
  44.   end;
  45.  
  46.   TFreqInfo = record
  47.     RawFreq: Cardinal;
  48.     NormFreq: Cardinal;
  49.     InCycles: Cardinal;
  50.     ExTicks: Cardinal;
  51.   end;
  52.  
  53. const
  54. { CPUID EFLAGS Id bit }
  55.   CPUIDID_BIT    =    $200000;
  56.  
  57. { CPUID execution levels }
  58.   CPUID_MAXLEVEL    : DWORD = $0;
  59.   CPUID_VENDORSIGNATURE : DWORD = $0;
  60.   CPUID_CPUSIGNATURE    : DWORD = $1;
  61.   CPUID_CPUFEATURESET    : DWORD = $1;
  62.   CPUID_CACHETLB    : DWORD = $2;
  63.   CPUID_CPUSERIALNUMBER : DWORD = $3;
  64.   CPUID_MAXLEVELEX    : DWORD = $80000000;
  65.   CPUID_CPUSIGNATUREEX    : DWORD = $80000001;
  66.   CPUID_CPUMARKETNAME1    : DWORD = $80000002;
  67.   CPUID_CPUMARKETNAME2    : DWORD = $80000003;
  68.   CPUID_CPUMARKETNAME3    : DWORD = $80000004;
  69.   CPUID_LEVEL1CACHETLB    : DWORD = $80000005;
  70.   CPUID_LEVEL2CACHETLB    : DWORD = $80000006;
  71.  
  72. { CPU vendors }
  73.   VENDOR_UNKNOWN    = 0;
  74.   VENDOR_INTEL        = 1;
  75.   VENDOR_AMD        = 2;
  76.   VENDOR_CYRIX        = 3;
  77.   VENDOR_IDT        = 4;
  78.   VENDOR_NEXGEN     = 5;
  79.   VENDOR_UMC        = 6;
  80.   VENDOR_RISE        = 7;
  81.  
  82. { Standard feature set flags }
  83.   SFS_FPU    = 0;
  84.   SFS_VME    = 1;
  85.   SFS_DE     = 2;
  86.   SFS_PSE    = 3;
  87.   SFS_TSC    = 4;
  88.   SFS_MSR    = 5;
  89.   SFS_PAE    = 6;
  90.   SFS_MCE    = 7;
  91.   SFS_CX8    = 8;
  92.   SFS_APIC   = 9;
  93.   SFS_SEP    = 11;
  94.   SFS_MTRR   = 12;
  95.   SFS_PGE    = 13;
  96.   SFS_MCA    = 14;
  97.   SFS_CMOV   = 15;
  98.   SFS_PAT    = 16;
  99.   SFS_PSE36  = 17;
  100.   SFS_SERIAL = 18;
  101.   SFS_MMX    = 23;
  102.   SFS_XSR    = 24;
  103.   SFS_SIMD   = 25;
  104.  
  105. { Extended feature set flags (duplicates removed) }
  106.   EFS_EXMMXA  = 22; { AMD Specific }
  107.   EFS_EXMMXC  = 24; { Cyrix Specific }
  108.   EFS_3DNOW   = 31;
  109.   EFS_EX3DNOW = 30;
  110.  
  111. type
  112.   TCPUFeatures = class(TPersistent)
  113.   private
  114.     FSEP: boolean;
  115.     FMTRR: boolean;
  116.     FMSR: boolean;
  117.     FPSE: boolean;
  118.     FTSC: boolean;
  119.     FMCE: boolean;
  120.     FMMX: boolean;
  121.     FPAT: boolean;
  122.     FPAE: boolean;
  123.     FXSR: boolean;
  124.     FVME: boolean;
  125.     FPGE: boolean;
  126.     FCMOV: boolean;
  127.     FFPU: boolean;
  128.     FCX8: boolean;
  129.     FSIMD: Boolean;
  130.     FMCA: boolean;
  131.     FAPIC: boolean;
  132.     FDE: boolean;
  133.     FPSE36: boolean;
  134.     FSERIAL: Boolean;
  135.     F3DNOW: boolean;
  136.     FEX3DNOW: Boolean;
  137.     FEXMMX: Boolean;
  138.   public
  139.     CPUID: TCPUIDResult;
  140.     procedure GetInfo;
  141.     procedure Report(var sl: TStringList);
  142.   published
  143.     property _3DNOW :Boolean read F3DNOW {$IFNDEF D6PLUS} write F3DNOW {$ENDIF} stored False;
  144.     property EX_3DNOW :Boolean read FEX3DNOW {$IFNDEF D6PLUS} write FEX3DNOW {$ENDIF} stored False;
  145.     property EX_MMX :Boolean read FEXMMX {$IFNDEF D6PLUS} write FEXMMX {$ENDIF} stored False;
  146.     property SIMD :Boolean read FSIMD {$IFNDEF D6PLUS} write FSIMD {$ENDIF} stored False;
  147.     property SERIAL :Boolean read FSERIAL {$IFNDEF D6PLUS} write FSERIAL {$ENDIF} stored False;
  148.     property XSR :Boolean read FXSR {$IFNDEF D6PLUS} write FXSR {$ENDIF} stored false;
  149.     property MMX :Boolean read FMMX {$IFNDEF D6PLUS} write FMMX {$ENDIF} stored false;
  150.     property PSE36 :Boolean read FPSE36 {$IFNDEF D6PLUS} write FPSE36 {$ENDIF} stored false;
  151.     property PAT :Boolean read FPAT {$IFNDEF D6PLUS} write FPAT {$ENDIF} stored false;
  152.     property CMOV :Boolean read FCMOV {$IFNDEF D6PLUS} write FCMOV {$ENDIF} stored false;
  153.     property MCA :Boolean read FMCA {$IFNDEF D6PLUS} write FMCA {$ENDIF} stored false;
  154.     property PGE :Boolean read FPGE {$IFNDEF D6PLUS} write FPGE {$ENDIF} stored false;
  155.     property MTRR :Boolean read FMTRR {$IFNDEF D6PLUS} write FMTRR {$ENDIF} stored false;
  156.     property SEP :Boolean read FSEP {$IFNDEF D6PLUS} write FSEP {$ENDIF} stored false;
  157.     property APIC :Boolean read FAPIC {$IFNDEF D6PLUS} write FAPIC {$ENDIF} stored false;
  158.     property CX8 :Boolean read FCX8 {$IFNDEF D6PLUS} write FCX8 {$ENDIF} stored false;
  159.     property MCE :Boolean read FMCE {$IFNDEF D6PLUS} write FMCE {$ENDIF} stored false;
  160.     property PAE :Boolean read FPAE {$IFNDEF D6PLUS} write FPAE {$ENDIF} stored false;
  161.     property MSR :Boolean read FMSR {$IFNDEF D6PLUS} write FMSR {$ENDIF} stored false;
  162.     property TSC :Boolean read FTSC {$IFNDEF D6PLUS} write FTSC {$ENDIF} stored false;
  163.     property PSE :Boolean read FPSE {$IFNDEF D6PLUS} write FPSE {$ENDIF} stored false;
  164.     property DE :Boolean read FDE {$IFNDEF D6PLUS} write FDE {$ENDIF} stored false;
  165.     property VME :Boolean read FVME {$IFNDEF D6PLUS} write FVME {$ENDIF} stored false;
  166.     property FPU :Boolean read FFPU {$IFNDEF D6PLUS} write FFPU {$ENDIF} stored false;
  167.   end;
  168.  
  169.   TCPUCache = class(TPersistent)
  170.   private
  171.     FLevel2: LongInt;
  172.     FLevel1: LongInt;
  173.     FLevel1Data: LongInt;
  174.     FLevel1Code: LongInt;
  175.   public
  176.     IntelCache: TIntelCache;
  177.     AMDCache: TAMDCache;
  178.     CyrixCache: TCyrixCache;
  179.     procedure GetInfo(AVendor: DWORD);
  180.     procedure Report(var sl :TStringList);
  181.   published
  182.     property L1Data: LongInt read FLevel1Data {$IFNDEF D6PLUS} write FLevel1Data {$ENDIF} stored FALSE;
  183.     property L1Code: LongInt read FLevel1Code {$IFNDEF D6PLUS} write FLevel1Code {$ENDIF} stored FALSE;
  184.     property Level1: LongInt read FLevel1 {$IFNDEF D6PLUS} write FLevel1 {$ENDIF} stored FALSE;
  185.     property Level2: LongInt read FLevel2 {$IFNDEF D6PLUS} write FLevel2 {$ENDIF} stored FALSE;
  186.   end;
  187.  
  188.   TCPU = class(TPersistent)
  189.   private
  190.     FFreq :integer;
  191.     FFeatures: TCPUFeatures;
  192.     FVendorReg: string;
  193.     FVendorIDReg: string;
  194.     FCount: integer;
  195.     FFamily: integer;
  196.     FStepping: integer;
  197.     FModel: integer;
  198.     FVendorID: string;
  199.     FVendor: string;
  200.     FTyp: DWORD;
  201.     FLevel: DWORD;
  202.     FCache: TCPUCache;
  203.     FSerial: string;
  204.     FDIV: Boolean;
  205.     FVendorCPUID: string;
  206.     FVendorIDCPUID: string;
  207.     FBrand: DWORD;
  208.     FCPUVendor: DWORD;
  209.     FCodeName: string;
  210.     FTrans: integer;
  211.     FVendorEx: string;
  212.   public
  213.     constructor Create;
  214.     destructor Destroy; override;
  215.     procedure GetInfo;
  216.     procedure Report(var sl :TStringList);
  217.  
  218.     property Vendor_Reg :string read FVendorReg {$IFNDEF D6PLUS} write FVendorReg {$ENDIF} stored false;
  219.     property VendorID_Reg :string read FVendorIDReg {$IFNDEF D6PLUS} write FVendorIDReg {$ENDIF} stored False;
  220.     property Vendor_CPUID :string read FVendorCPUID {$IFNDEF D6PLUS} write FVendorCPUID {$ENDIF} stored false;
  221.     property VendorID_CPUID :string read FVendorIDCPUID {$IFNDEF D6PLUS} write FVendorIDCPUID {$ENDIF} stored False;
  222.     property Brand: DWORD read FBrand {$IFNDEF D6PLUS} write FBrand {$ENDIF} stored False;
  223.     property Typ: DWORD read FTyp {$IFNDEF D6PLUS} write FTyp {$ENDIF} stored False;
  224.     property Level: DWORD read FLevel {$IFNDEF D6PLUS} write FLevel {$ENDIF} stored False;
  225.     property CPUVendor: DWORD read FCPUVendor {$IFNDEF D6PLUS} write FCPUVendor {$ENDIF} stored False;
  226.     property Vendor :string read FVendor {$IFNDEF D6PLUS} write FVendor {$ENDIF} stored False;
  227.   published
  228.     property Count :integer read FCount {$IFNDEF D6PLUS} write FCount {$ENDIF} stored false;
  229.     property VendorEx :string read FVendorEx {$IFNDEF D6PLUS} write FVendorEx {$ENDIF} stored False;
  230.     property VendorID :string read FVendorID {$IFNDEF D6PLUS} write FVendorID {$ENDIF} stored false;
  231.     property Frequency :integer read FFreq {$IFNDEF D6PLUS} write FFreq {$ENDIF} stored false;
  232.     property Family :integer read FFamily {$IFNDEF D6PLUS} write FFamily {$ENDIF} stored false;
  233.     property Stepping :integer read FStepping {$IFNDEF D6PLUS} write FStepping {$ENDIF} stored false;
  234.     property Model :integer read FModel {$IFNDEF D6PLUS} write FModel {$ENDIF} stored false;
  235.     property Features :TCPUFeatures read FFeatures  {$IFNDEF D6PLUS} write FFeatures {$ENDIF} stored false;
  236.     property Cache: TCPUCache read FCache  {$IFNDEF D6PLUS} write FCache {$ENDIF} stored false;
  237.     property SerialNumber: string read FSerial {$IFNDEF D6PLUS} write FSerial {$ENDIF};
  238.     property FDIVBug: Boolean read FDIV {$IFNDEF D6PLUS} write FDIV {$ENDIF};
  239.     property CodeName: string read FCodeName {$IFNDEF D6PLUS} write FCodeName {$ENDIF};
  240.     property Transistors: integer read FTrans {$IFNDEF D6PLUS} write FTrans {$ENDIF};
  241.   end;
  242.  
  243. var
  244.   CPUID_Level: DWORD;
  245.  
  246. implementation
  247.  
  248. uses
  249.   Registry, INIFiles, MiTeC_Routines;
  250.  
  251. const
  252.   CPUVendorIDs :array[VENDOR_INTEL..VENDOR_RISE] of string =
  253.                     ('GenuineIntel',
  254.                      'AuthenticAMD',
  255.                      'CyrixInstead',
  256.                      'CentaurHauls',
  257.                      'NexGenDriven',
  258.                      'UMC UMC UMC',
  259.                      'RiseRiseRise'
  260.                      );
  261.  
  262.   CPUVendorsEx :array[VENDOR_INTEL..VENDOR_RISE] of string =
  263.                       ('Intel Corporation',
  264.                        'Advanced Micro Devices',
  265.                        'Cyrix Corporation',
  266.                        'IDT/Centaur',
  267.                        'NexGen Inc.',
  268.                        'United Microelectronics Corp',
  269.                        'Rise Technology');
  270.  
  271.   CPUVendors :array[VENDOR_INTEL..VENDOR_RISE] of string =
  272.                       ('Intel',
  273.                        'AMD',
  274.                        'Cyrix',
  275.                        'IDT',
  276.                        'NexGen',
  277.                        'UMC',
  278.                        'Rise');
  279.  
  280.  
  281. function GetCPUVendorID(AVendor, AFamily, AModel, ABrand, ATyp, AL2Cache, AFreq: integer;
  282.             var Codename: string;
  283.             var TranCount: integer) :string;
  284. begin
  285.   case AVendor of
  286.     VENDOR_INTEL: begin
  287.       case AFamily of
  288.     4: case AModel of
  289.          0,1 :begin
  290.            Result:='i80486DX';
  291.            CodeName:='P4';
  292.            TranCount:=1250000;
  293.          end;
  294.          2 :begin
  295.            Result:='i80486SX';
  296.            CodeName:='P23';
  297.            TranCount:=900000;
  298.          end;
  299.          3 :begin
  300.            Result:='i80486DX2';
  301.            CodeName:='P24';
  302.            TranCount:=1250000;
  303.          end;
  304.          4 :begin
  305.            Result:='i80486SL';
  306.            CodeName:='P23';
  307.            TranCount:=900000;
  308.          end;
  309.          5 :begin
  310.            Result:='i80486SX2';
  311.            CodeName:='P23';
  312.            TranCount:=900000;
  313.          end;
  314.          7 :begin
  315.            Result:='i80486DX2WB';
  316.            CodeName:='P24';
  317.            TranCount:=1250000;
  318.          end;
  319.          8 :begin
  320.            Result:='i80486DX4';
  321.            CodeName:='P24C';
  322.            TranCount:=1600000;
  323.          end;
  324.          9 :begin
  325.            Result:='i80486DX4WB';
  326.            CodeName:='P24C';
  327.            TranCount:=1600000;
  328.          end;
  329.        end;
  330.     5: case AModel of
  331.          0 :begin
  332.            Result:='Pentium';
  333.            CodeName:='P5 (0,80╡m)';
  334.            TranCount:=3100000;
  335.          end;
  336.          1,2 :begin
  337.            Result:='Pentium';
  338.            CodeName:='P54C (0,50╡m)';
  339.            TranCount:=3100000;
  340.          end;
  341.          3 :begin
  342.            Result:='Pentium';
  343.            CodeName:='P24T';
  344.            TranCount:=0;
  345.          end;
  346.          4 :begin
  347.            Result:='Pentium MMX';
  348.            CodeName:='P55C (0,28╡m)';
  349.            TranCount:=4500000;
  350.          end;
  351.          5 :begin
  352.            Result:='DX4';
  353.            CodeName:='';
  354.            TranCount:=0;
  355.          end;
  356.          6 :begin
  357.            Result:='Pentium';
  358.            CodeName:='P5';
  359.            TranCount:=0;
  360.          end;
  361.          7 :begin
  362.            Result:='Pentium';
  363.            CodeName:='P54C (0,35╡m)';
  364.            TranCount:=3100000;
  365.          end;
  366.          8 :begin
  367.            Result:='Pentium MMX (mobile)';
  368.            CodeName:='Tillamook (0,25╡m)';
  369.            TranCount:=4500000;
  370.          end;
  371.          else begin
  372.            Result:='Pentium';
  373.            CodeName:='';
  374.            TranCount:=0;
  375.          end;
  376.        end;
  377.     6: case AModel of
  378.          0 :begin
  379.            Result:='Pentium Pro';
  380.            CodeName:='P6 (0.50 ╡m)';
  381.            TranCount:=5500000;
  382.          end;
  383.          1 :begin
  384.            Result:='Pentium Pro';
  385.            CodeName:='P6 (0.35 ╡m)';
  386.            TranCount:=5500000;
  387.          end;
  388.          3 :begin
  389.           Result:='Pentium II';
  390.           if AL2Cache=333 then
  391.             CodeName:='P6T (0.25 ╡m)'
  392.           else
  393.             CodeName:='Klamath (0.35 ╡m)';
  394.           TranCount:=7500000;
  395.           if ATyp=1 then
  396.             Result:=Result+' OverDrive';
  397.         end;
  398.          4 :begin
  399.            Result:='Pentium II';
  400.            Codename:='P55CT (P54 OverDrive)';
  401.            TranCount:=3100000;
  402.          end;
  403.          5 :if (AL2Cache<=512) then begin
  404.           if (AL2Cache=0) then begin
  405.             Result:='Celeron';
  406.             Codename:='Covington (0,25╡m)';
  407.             TranCount:=7500000;
  408.           end else begin
  409.             Result:='Pentium II';
  410.             Codename:='Deschutes (0,25╡m)';
  411.             TranCount:=7500000;
  412.           end;
  413.         end else begin
  414.           Result:='Pentium II Xeon';
  415.           Codename:='Deschutes (0.25 ╡m)';
  416.           TranCount:=7500000;
  417.         end;
  418.          6: if AL2Cache<256 then begin
  419.           Result:='Celeron A';
  420.           Codename:='Mendocino (0.25 ╡m)';
  421.           TranCount:=19000000;
  422.         end else begin
  423.           Result:='Pentium II PE (mobile)';
  424.           Codename:='Dixon (0.25 ╡m)';
  425.           TranCount:=27400000;
  426.         end;
  427.          7: if AL2Cache<=512 then begin
  428.           Result:='Pentium III';
  429.           Codename:='Katmai (0.25 ╡m)';
  430.           TranCount:=9500000;
  431.         end else begin
  432.           Result:='Pentium III Xeon';
  433.           Codename:='Tanner (0.25 ╡m)';
  434.           TranCount:=9500000;
  435.         end;
  436.          8: begin
  437.            Result:='Pentium III E';
  438.            Codename:='Coppermine (0.18 ╡m)';
  439.            TranCount:=28100000;
  440.           end;
  441.          else begin
  442.            Result:='Pentium II';
  443.            Codename:='';
  444.            TranCount:=0;
  445.          end;
  446.        end;
  447.     7,8: case ABrand of
  448.          1: begin
  449.            Result:='Celeron';
  450.            Codename:='';
  451.            TranCount:=0;
  452.          end;
  453.          3: begin
  454.            Result:='Pentium III Xeon';
  455.            Codename:='';
  456.            TranCount:=0;
  457.          end;
  458.          4: begin
  459.            Result:='Pentium IV';
  460.            Codename:='';
  461.            TranCount:=0;
  462.          end;
  463.          else begin
  464.            if (AL2Cache<1024) then
  465.           Result:='Pentium III'
  466.         else
  467.           Result:='Pentium III Xeon';
  468.            Codename:='';
  469.            TranCount:=0;
  470.          end;
  471.     end;
  472.     $A: begin
  473.       Result:='Pentium III Xeon';
  474.       Codename:='';
  475.       TranCount:=0;
  476.     end;
  477.     $F: begin
  478.       Result:='Pentium IV';
  479.       Codename:='';
  480.       TranCount:=0;
  481.     end;
  482.  
  483.       end;
  484.     end;
  485.  
  486.     VENDOR_AMD: begin
  487.       case AFamily of
  488.     4: case AModel of
  489.         0:begin
  490.           Result:='Am486DX';
  491.           Codename:='P4';
  492.           TranCount:=1250000;
  493.         end;
  494.         3,7 :begin
  495.           Result:='Am486DX2';
  496.           Codename:='P24';
  497.           TranCount:=1250000;
  498.         end;
  499.         8,9 :begin
  500.           Result:='Am486DX4';
  501.           Codename:='P24C';
  502.           TranCount:=1250000;
  503.         end;
  504.         14,15 :begin
  505.           Result:='Am5x86';
  506.           Codename:='X5';
  507.           TranCount:=1600000;
  508.         end;
  509.        end;
  510.     5: case AModel of
  511.          0: begin
  512.            Result:='K5';
  513.            Codename:='SSA5 (0.50-0.35 ╡m)';
  514.            TranCount:=4300000;
  515.          end;
  516.          1,2,3: begin
  517.            Result:='K5-5k86 (PR120, PR133)';
  518.            Codename:='5k86 (0.35 ╡m)';
  519.            TranCount:=4300000;
  520.          end;
  521.          6: begin
  522.            Result:='K6';
  523.            Codename:='K6 (0.30 ╡m)';
  524.            TranCount:=8800000;
  525.           end;
  526.          7: begin
  527.            Result:='K6';
  528.            Codename:='Little Foot (0.25 ╡m)';
  529.            TranCount:=8800000;
  530.          end;
  531.          8: begin
  532.            Result:='K6-II';
  533.            Codename:='Chomper (0.25 ╡m)';
  534.            TranCount:=9300000;
  535.          end;
  536.          9: begin
  537.            Result:='K6-III';
  538.            Codename:='Slarptooth (0.25 ╡m)';
  539.            TranCount:=21300000;
  540.          end;
  541.          $D: begin
  542.            Result:='K6-II+/K6-III+';
  543.            Codename:='';
  544.            TranCount:=0;
  545.          end;
  546.        end;
  547.     6: begin
  548.          Result:='K7';
  549.          Codename:='Athlon (0.25-0.18 ╡m)';
  550.          TranCount:=22000000;
  551.        end;
  552.       end;
  553.     end;
  554.  
  555.     VENDOR_CYRIX: begin
  556.       case AFamily of
  557.     4: case AModel of
  558.          0: begin
  559.            if AFreq in [20,66] then begin
  560.          Result:='Cx486SLC/DLC';
  561.          Codename:='M0.5';
  562.          TranCount:=600000;
  563.            end;
  564.            if AFreq in [33,50] then begin
  565.          Result:='Cx486S';
  566.          Codename:='M0.6';
  567.          TranCount:=600000;
  568.            end;
  569.            if AFreq>66 then begin
  570.          Result:='Cx486DX/DX2/DX4';
  571.          Codename:='M0.7';
  572.          TranCount:=1100000;
  573.            end;
  574.          end;
  575.          4: begin
  576.            Result:='Media GX';
  577.            Codename:='Gx86';
  578.            TranCount:=24000000;
  579.          end;
  580.          9: begin
  581.            Result:='5x86';
  582.            Codename:='M0.9 or M1sc (0.65 ╡m)';
  583.            TranCount:=20000000;
  584.          end;
  585.        end;
  586.     5: case AModel of
  587.          2 :begin
  588.            Result:='6x86 and 6x86L';
  589.            Codename:='M1 (0.65 ╡m) and M1L (0.35 ╡m)';
  590.            TranCount:=30000000;
  591.          end;
  592.          4 :begin
  593.            Result:='MediaGXm';
  594.            Codename:='GXm';
  595.            TranCount:=24000000;
  596.          end;
  597.        end;
  598.     6: case AModel of
  599.          0: if AFreq<225 then begin
  600.           Result:='6x86MX (PR166-266)';
  601.           Codename:='M2 (0.35 ╡m)';
  602.           TranCount:=65000000;
  603.         end else begin
  604.           Result:='M-II (PR300-433)';
  605.           Codename:='M2 (0.35-0.25 ╡m)';
  606.           TranCount:=65000000;
  607.         end;
  608.          5: begin
  609.            Result:='VIA Cyrix III';
  610.            Codename:='';
  611.            TranCount:=0;
  612.          end;
  613.        end;
  614.       end;
  615.     end;
  616.  
  617.     VENDOR_IDT: begin
  618.       case AFamily of
  619.     5: case AModel of
  620.          4: begin
  621.            Result:='WinChip';
  622.            Codename:='C6 (0.35 ╡m)';
  623.            TranCount:=54000000;
  624.          end;
  625.          8: begin
  626.            Result:='WinChip 2x';
  627.            Codename:='W2x (0.35-0.25 ╡m)';
  628.            TranCount:=59000000;
  629.          end;
  630.          9: begin
  631.            Result:='WinChip 3';
  632.            Codename:='W3 (0.25 ╡m)';
  633.            TranCount:=90000000;
  634.          end;
  635.        end;
  636.       end;
  637.     end;
  638.  
  639.     VENDOR_NEXGEN: begin
  640.       case AFamily of
  641.     5: case AModel of
  642.          0: begin
  643.            Result:='Nx586';
  644.            Codename:='Nx5x86 (0.50-0.44 ╡m)';
  645.            TranCount:=35000000;
  646.          end;
  647.          6: begin
  648.            Result:='Nx686';
  649.            Codename:='HA (0,50╡m)';
  650.            TranCount:=60000000;
  651.          end;
  652.        end;
  653.       end;
  654.     end;
  655.  
  656.     VENDOR_UMC: begin
  657.       case AFamily of
  658.     4: begin
  659.       Codename:='U5D and U5S';
  660.       TranCount:=12000000;
  661.       case AModel of
  662.         1: Result:='U5D';
  663.         2: Result:='U5S';
  664.         3: Result:='U486DX2';
  665.         4: Result:='U486SX2';
  666.       end;
  667.     end;
  668.       end;
  669.     end;
  670.  
  671.     VENDOR_RISE: begin
  672.       case AFamily of
  673.     4: case AModel of
  674.          0,2: begin
  675.            Result:='mP6';
  676.            Codename:='mP6 (0.25-0.18 ╡m)';
  677.            TranCount:=36000000;
  678.          end;
  679.        end;
  680.       end;
  681.     end;
  682.   end;
  683. end;
  684.  
  685. function GetCPUIDSupport: Boolean;
  686. asm
  687.     PUSHFD
  688.     POP     EAX
  689.     MOV     EDX, EAX
  690.     XOR     EAX, CPUIDID_BIT
  691.     PUSH    EAX
  692.     POPFD
  693.     PUSHFD
  694.     POP     EAX
  695.     XOR     EAX, EDX
  696.     JZ        @exit
  697.     MOV     AL, TRUE
  698.   @exit:
  699. end;
  700.  
  701. function ExecuteCPUID: TCPUIDResult; assembler;
  702. asm
  703.     PUSH    EBX
  704.     PUSH    EDI
  705.     MOV     EDI, EAX
  706.     MOV     EAX, CPUID_LEVEL
  707.     DW        $A20F
  708.     STOSD
  709.     MOV     EAX, EBX
  710.     STOSD
  711.     MOV     EAX, ECX
  712.     STOSD
  713.     MOV     EAX, EDX
  714.     STOSD
  715.     POP     EDI
  716.     POP     EBX
  717. end;
  718.  
  719. function ExecuteIntelCache: TIntelCache;
  720. var
  721.   Cache: TIntelCache;
  722.   i: DWORD;
  723.   TimesToExecute, CurrentLoop: Byte;
  724. begin
  725.   asm
  726.     PUSH    EAX
  727.     PUSH    EBP
  728.     PUSH    EBX
  729.     PUSH    ECX
  730.     PUSH    EDI
  731.     PUSH    EDX
  732.     PUSH    ESI
  733.  
  734.     MOV     CurrentLoop, 0
  735.     PUSH    ECX
  736.   @@RepeatCacheQuery:
  737.     POP     ECX
  738.     MOV     EAX, CPUID_CACHETLB
  739.     DB        0FH
  740.     DB        0A2H
  741.     INC     CurrentLoop
  742.     CMP     CurrentLoop, 1
  743.     JNE     @@DoneCacheQuery
  744.     MOV     TimesToExecute, AL
  745.     CMP     AL, 0
  746.     JE        @@Done
  747.   @@DoneCacheQuery:
  748.     PUSH    ECX
  749.     MOV     CL, CurrentLoop
  750.     SUB     CL, TimesToExecute
  751.     JNZ     @@RepeatCacheQuery
  752.     POP     ECX
  753.     MOV     DWORD PTR [Cache.CacheDescriptors], EAX
  754.     MOV     DWORD PTR [Cache.CacheDescriptors + 4], EBX
  755.     MOV     DWORD PTR [Cache.CacheDescriptors + 8], ECX
  756.     MOV     DWORD PTR [Cache.CacheDescriptors + 12], EDX
  757.     JMP     @@Done
  758.    @@Done:
  759.  
  760.     POP     ESI
  761.     POP     EDX
  762.     POP     EDI
  763.     POP     ECX
  764.     POP     EBX
  765.     POP     EBP
  766.     POP     EAX
  767.   end;
  768.   Cache.L2Cache:=0;
  769.   for i:=1 to 15 do
  770.    case Cache.CacheDescriptors[i] of
  771.      $40: Cache.L2Cache:=0;
  772.      $41: Cache.L2Cache:=128;
  773.      $42,$82: Cache.L2Cache:=256;
  774.      $43,$83: Cache.L2Cache:=512;
  775.      $44,$84: Cache.L2Cache:=1024;
  776.      $45,$85: Cache.L2Cache:=2048;
  777.    end;
  778.   Result:=Cache;
  779. end;
  780.  
  781. function ExecuteAMDCache: TAMDCache;
  782. var
  783.   Cache: TAMDCache;
  784. begin
  785.   asm
  786.     PUSH    EAX
  787.     PUSH    EBP
  788.     PUSH    EBX
  789.     PUSH    ECX
  790.     PUSH    EDI
  791.     PUSH    EDX
  792.     PUSH    ESI
  793.  
  794.     MOV     EAX, CPUID_LEVEL1CACHETLB
  795.     DB        0Fh
  796.     DB        0A2h
  797.     MOV     WORD PTR [Cache.InstructionTLB], BX
  798.     SHR     EBX, 16
  799.     MOV     WORD PTR [Cache.DataTLB], BX
  800.     MOV     DWORD PTR [Cache.L1DataCache], ECX
  801.     MOV     DWORD PTR [Cache.L1ICache], EDX
  802.  
  803.     POP     ESI
  804.     POP     EDX
  805.     POP     EDI
  806.     POP     ECX
  807.     POP     EBX
  808.     POP     EBP
  809.     POP     EAX
  810.   end;
  811.   Result:=Cache;
  812. end;
  813.  
  814. function ExecuteCyrixCache: TCyrixCache;
  815. var
  816.   Cache: TCyrixCache;
  817. begin
  818.   asm
  819.     PUSH    EAX
  820.     PUSH    EBP
  821.     PUSH    EBX
  822.     PUSH    ECX
  823.     PUSH    EDI
  824.     PUSH    EDX
  825.     PUSH    ESI
  826.  
  827.     MOV     EAX, CPUID_LEVEL1CACHETLB
  828.     DB        0Fh
  829.     DB        0A2h
  830.     MOV     DWORD PTR [Cache.TLBInfo], EBX
  831.     MOV     DWORD PTR [Cache.L1CacheInfo], ECX
  832.  
  833.     POP     ESI
  834.     POP     EDX
  835.     POP     EDI
  836.     POP     ECX
  837.     POP     EBX
  838.     POP     EBP
  839.     POP     EAX
  840.   end;
  841.   Result:=Cache;
  842. end;
  843.  
  844. function GetCPUSerialNumber: String;
  845.  
  846.   function SplitToNibble(ANumber: String): String;
  847.   begin
  848.     Result:=Copy(ANumber,0,4)+'-'+Copy(ANumber,5,4);
  849.   end;
  850.  
  851. var
  852.   SerialNumber: TCPUIDResult;
  853. begin
  854.   Result:='';
  855.   CPUID_Level:=CPUID_CPUSIGNATURE;
  856.   SerialNumber:=ExecuteCPUID;
  857.   Result:=SplitToNibble(IntToHex(SerialNumber.EAX,8))+'-';
  858.   CPUID_Level:=CPUID_CPUSIGNATURE;
  859.   SerialNumber:=ExecuteCPUID;
  860.   Result:=Result+SplitToNibble(IntToHex(SerialNumber.EDX,8))+'-';
  861.   Result:=Result+SplitToNibble(IntToHex(SerialNumber.ECX,8));
  862. end;
  863.  
  864. function RoundFrequency(const Frequency: Integer): Integer;
  865. const
  866.   NF: array [0..8] of Integer = (0, 20, 33, 50, 60, 66, 80, 90, 100);
  867. var
  868.   Freq, RF: Integer;
  869.   i: Byte;
  870.   Hi, Lo: Byte;
  871. begin
  872.   RF:=0;
  873.   Freq:=Frequency mod 100;
  874.   for i:=0 to 8 do begin
  875.     if Freq<NF[i] then begin
  876.       Hi:=i;
  877.       Lo:=i-1;
  878.       if (NF[Hi]-Freq)>(Freq-NF[Lo]) then
  879.     RF:=NF[Lo]-Freq
  880.       else
  881.     RF:=NF[Hi]-Freq;
  882.       Break;
  883.     end;
  884.   end;
  885.   Result:=Frequency+RF;
  886. end;
  887.  
  888. function GetCPUSpeed: TFreqInfo;
  889. var
  890.   {$IFNDEF D4PLUS}
  891.   T0, T1: TLargeInteger;
  892.   CountFreq: TLargeInteger;
  893.   {$ELSE}
  894.   T0, T1: TULargeInteger;
  895.   CountFreq: TULargeInteger;
  896.   {$ENDIF}
  897.   CpuSpeed: TFreqInfo;
  898.   Freq, Freq2, Freq3, Total: Integer;
  899.   TotalCycles, Cycles: Cardinal;
  900.   Stamp0, Stamp1: Cardinal;
  901.   TotalTicks, Ticks: Cardinal;
  902.   Tries, IPriority: Integer;
  903.   hThread: THandle;
  904. begin
  905.   Freq:=0;
  906.   Freq2:=0;
  907.   Freq3:=0;
  908.   Tries:=0;
  909.   TotalCycles:=0;
  910.   TotalTicks:=0;
  911.   Total:=0;
  912.  
  913.   hThread:=GetCurrentThread;
  914.   {$IFNDEF D4PLUS}
  915.   if not QueryPerformanceFrequency(CountFreq) then
  916.   {$ELSE}
  917.   if not QueryPerformanceFrequency(Int64(CountFreq)) then
  918.   {$ENDIF}
  919.   begin
  920.     Result:=CpuSpeed;
  921.   end else begin
  922.     while ((Tries<3) or ((Tries<20) and ((Abs(3*Freq-Total)>3) or
  923.       (Abs(3*Freq2-Total)>3) or (Abs(3*Freq3-Total)>3)))) do begin
  924.       Inc(Tries);
  925.       Freq3:=Freq2;
  926.       Freq2:=Freq;
  927.       {$IFNDEF D4PLUS}
  928.       QueryPerformanceCounter(T0);
  929.       {$ELSE}
  930.       QueryPerformanceCounter(Int64(T0));
  931.       {$ENDIF}
  932.       T1.LowPart:=T0.LowPart;
  933.       T1.HighPart:=T0.HighPart;
  934.  
  935.       iPriority:=GetThreadPriority(hThread);
  936.       if iPriority<>THREAD_PRIORITY_ERROR_RETURN then
  937.     SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
  938.       while (T1.LowPart-T0.LowPart)<50 do begin
  939.     {$IFNDEF D4PLUS}
  940.     QueryPerformanceCounter(T1);
  941.     {$ELSE}
  942.     QueryPerformanceCounter(Int64(T1));
  943.     {$ENDIF}
  944.     asm
  945.       PUSH      EAX
  946.       PUSH      EDX
  947.       DB      0Fh          // Read Time
  948.       DB      31h          // Stamp Counter
  949.       MOV      Stamp0, EAX
  950.       POP      EDX
  951.       POP      EAX
  952.     end;
  953.       end;
  954.       T0.LowPart:=T1.LowPart;
  955.       T0.HighPart:=T1.HighPart;
  956.  
  957.       while (T1.LowPart-T0.LowPart)<1000 do begin
  958.     {$IFNDEF D4PLUS}
  959.     QueryPerformanceCounter(T1);
  960.     {$ELSE}
  961.     QueryPerformanceCounter(Int64(T1));
  962.     {$ENDIF}
  963.     asm
  964.       PUSH      EAX
  965.       PUSH      EDX
  966.       DB      0Fh          // Read Time
  967.       DB      31h          // Stamp Counter
  968.       MOV      Stamp1, EAX
  969.       POP      EDX
  970.       POP      EAX
  971.     end;
  972.       end;
  973.  
  974.       if iPriority<>THREAD_PRIORITY_ERROR_RETURN then
  975.     SetThreadPriority(hThread, iPriority);
  976.  
  977.       Cycles:=Stamp1-Stamp0;
  978.       Ticks:=T1.LowPart-T0.LowPart;
  979.       Ticks:=Ticks*100000;
  980.       Ticks:=Round(Ticks/(CountFreq.LowPart/10));
  981.       TotalTicks:=TotalTicks+Ticks;
  982.       TotalCycles:=TotalCycles+Cycles;
  983.  
  984.       Freq:=Round(Cycles/Ticks);
  985.  
  986.       Total:=Freq+Freq2+Freq3;
  987.     end;
  988.     Freq3:=Round((TotalCycles*10)/TotalTicks);
  989.     Freq2:=Round((TotalCycles*100)/TotalTicks);
  990.  
  991.     if Freq2-(Freq3*10)>=6 then
  992.       Inc(Freq3);
  993.  
  994.     CpuSpeed.RawFreq:=Round(TotalCycles/TotalTicks);
  995.     CpuSpeed.NormFreq:=CpuSpeed.RawFreq;
  996.  
  997.     Freq:=CpuSpeed.RawFreq*10;
  998.     if (Freq3-Freq)>=6 then
  999.       Inc(CpuSpeed.NormFreq);
  1000.  
  1001.     CpuSpeed.ExTicks:=TotalTicks;
  1002.     CpuSpeed.InCycles:=TotalCycles;
  1003.  
  1004.     CpuSpeed.NormFreq:=RoundFrequency(CpuSpeed.NormFreq);
  1005.     Result:=CpuSpeed;
  1006.   end;
  1007. end;
  1008.  
  1009. function GetVendor: string;
  1010. var
  1011.   CPUName: array [0..11] of Char;
  1012. begin
  1013.   asm
  1014.     PUSH    EAX
  1015.     PUSH    EBP
  1016.     PUSH    EBX
  1017.     PUSH    ECX
  1018.     PUSH    EDI
  1019.     PUSH    EDX
  1020.     PUSH    ESI
  1021.  
  1022.     MOV    EAX, CPUID_VENDORSIGNATURE
  1023.     DB    0FH
  1024.     DB    0A2H
  1025.  
  1026.     MOV    DWORD PTR [CPUName], EBX
  1027.     MOV    DWORD PTR [CPUName + 4], EDX
  1028.     MOV    DWORD PTR [CPUName + 8], ECX
  1029.  
  1030.     POP    ESI
  1031.     POP    EDX
  1032.     POP    EDI
  1033.     POP    ECX
  1034.     POP    EBX
  1035.     POP    EBP
  1036.     POP    EAX
  1037.  
  1038.   end;
  1039.   Result:=CPUName;
  1040. end;
  1041.  
  1042. function GetVendorID: string;
  1043. var
  1044.   CPUName: array [0..47] of Char;
  1045. begin
  1046.   asm
  1047.     PUSH    EAX
  1048.     PUSH    EBP
  1049.     PUSH    EBX
  1050.     PUSH    ECX
  1051.     PUSH    EDI
  1052.     PUSH    EDX
  1053.     PUSH    ESI
  1054.  
  1055.     MOV    EAX, CPUID_CPUMARKETNAME1
  1056.     DW    $A20F
  1057.  
  1058.     MOV    DWORD PTR [CPUName], EAX
  1059.     MOV    DWORD PTR [CPUName + 4], EBX
  1060.     MOV    DWORD PTR [CPUName + 8], ECX
  1061.     MOV    DWORD PTR [CPUName + 12], EDX
  1062.  
  1063.     MOV    EAX, CPUID_CPUMARKETNAME2
  1064.     DW    $A20F
  1065.  
  1066.     MOV    DWORD PTR [CPUName + 16], EAX
  1067.     MOV    DWORD PTR [CPUName + 20], EBX
  1068.     MOV    DWORD PTR [CPUName + 24], ECX
  1069.     MOV    DWORD PTR [CPUName + 28], EDX
  1070.  
  1071.     MOV    EAX, CPUID_CPUMARKETNAME3
  1072.     DW    $A20F
  1073.  
  1074.     MOV    DWORD PTR [CPUName + 32], EAX
  1075.     MOV    DWORD PTR [CPUName + 36], EBX
  1076.     MOV    DWORD PTR [CPUName + 40], ECX
  1077.     MOV    DWORD PTR [CPUName + 44], EDX
  1078.  
  1079.     POP    ESI
  1080.     POP    EDX
  1081.     POP    EDI
  1082.     POP    ECX
  1083.     POP    EBX
  1084.     POP    EBP
  1085.     POP    EAX
  1086.  
  1087.   end;
  1088.   Result:=CPUName;
  1089. end;
  1090.  
  1091. function GetFDIVBugPresent: Boolean;
  1092. const
  1093.   N1: Real = 4195835.0;
  1094.   N2: Real = 3145727.0;
  1095. begin
  1096.   Result:=((((N1/N2)*N2)-N1)<>0.0);
  1097. end;
  1098.  
  1099. { TCPUFeatures }
  1100.  
  1101. procedure TCPUFeatures.GetInfo;
  1102. begin
  1103.   CPUID_Level:=CPUID_CPUSIGNATUREEX;
  1104.   CPUID:=ExecuteCPUID;
  1105.   FEXMMX:=((CPUID.EDX and (1 shl EFS_EXMMXA))<>0) or ((CPUID.EDX and (1 shl EFS_EXMMXC))<>0);
  1106.   FEX3DNOW:=((CPUID.EDX and (1 shl EFS_EX3DNOW))<>0);
  1107.   F3DNOW:=((CPUID.EDX and (1 shl EFS_3DNOW))<>0);
  1108.  
  1109.   CPUID_Level:=CPUID_CPUFEATURESET;
  1110.   CPUID:=ExecuteCPUID;
  1111.   FSIMD:=((CPUID.EDX and (1 shl SFS_SIMD))<>0);
  1112.   FXSR:=((CPUID.EDX and (1 shl SFS_XSR))<>0);
  1113.   FMMX:=((CPUID.EDX and (1 shl SFS_MMX))<>0);
  1114.   FSERIAL:=((CPUID.EDX and (1 shl SFS_SERIAL))<>0);
  1115.   FPSE36:=((CPUID.EDX and (1 shl SFS_PSE36))<>0);
  1116.   FPAT:=((CPUID.EDX and (1 shl SFS_PAT))<>0);
  1117.   FCMOV:=((CPUID.EDX and (1 shl SFS_CMOV))<>0);
  1118.   FMCA:=((CPUID.EDX and (1 shl SFS_MCA))<>0);
  1119.   FPGE:=((CPUID.EDX and (1 shl SFS_PGE))<>0);
  1120.   FMTRR:=((CPUID.EDX and (1 shl SFS_MTRR))<>0);
  1121.   FSEP:=((CPUID.EDX and (1 shl SFS_SEP))<>0);
  1122.   FAPIC:=((CPUID.EDX and (1 shl SFS_APIC))<>0);
  1123.   FCX8:=((CPUID.EDX and (1 shl SFS_CX8))<>0);
  1124.   FMCE:=((CPUID.EDX and (1 shl SFS_MCE))<>0);
  1125.   FPAE:=((CPUID.EDX and (1 shl SFS_PAE))<>0);
  1126.   FMSR:=((CPUID.EDX and (1 shl SFS_MSR))<>0);
  1127.   FTSC:=((CPUID.EDX and (1 shl SFS_TSC))<>0);
  1128.   FPSE:=((CPUID.EDX and (1 shl SFS_PSE))<>0);
  1129.   FDE:=((CPUID.EDX and (1 shl SFS_DE))<>0);
  1130.   FVME:=((CPUID.EDX and (1 shl SFS_VME))<>0);
  1131.   FFPU:=((CPUID.EDX and (1 shl SFS_FPU))<>0);
  1132. end;
  1133.  
  1134. procedure TCPUFeatures.Report(var sl: TStringList);
  1135. begin
  1136.   with sl do begin
  1137.     Add('[CPU Features]');
  1138.     Add(Format('3D Now! extensions=%d',[integer(_3DNOW)]));
  1139.     Add(Format('Enhanced 3D Now! extensions=%d',[integer(EX_3DNOW)]));
  1140.     Add(Format('Enhanced MMX extensions=%d',[integer(EX_MMX)]));
  1141.     Add(Format('SIMD instructions=%d',[integer(SIMD)]));
  1142.     Add(Format('FXSAVE/FXRSTOR instruction=%d',[integer(XSR)]));
  1143.     Add(Format('MMX extensions=%d',[integer(MMX)]));
  1144.     Add(Format('Serial number=%d',[integer(SERIAL)]));
  1145.     Add(Format('36bit Page Size Extension=%d',[integer(PSE36)]));
  1146.     Add(Format('Page Attribute Table=%d',[integer(PAT)]));
  1147.     Add(Format('CMOVcc (+FCMOVcc/F(U)COMI(P) opcodes=%d',[integer(CMOV)]));
  1148.     Add(Format('Machine Check Architecture=%d',[integer(MCA)]));
  1149.     Add(Format('Page Global Extension=%d',[integer(PGE)]));
  1150.     Add(Format('Memory Type Range Registers=%d',[integer(MTRR)]));
  1151.     Add(Format('SYSENTER/SYSEXIT extension=%d',[integer(SEP)]));
  1152.     Add(Format('Processor contains an enabled APIC=%d',[integer(APIC)]));
  1153.     Add(Format('CMPXCHG8B instruction=%d',[integer(CX8)]));
  1154.     Add(Format('Machine Check Exception=%d',[integer(MCE)]));
  1155.     Add(Format('Physical Address Extension=%d',[integer(PAE)]));
  1156.     Add(Format('Model Specific Registers=%d',[integer(MSR)]));
  1157.     Add(Format('Time Stamp Counter=%d',[integer(TSC)]));
  1158.     Add(Format('Page Size Extension=%d',[integer(PSE)]));
  1159.     Add(Format('Debugging Extension=%d',[integer(DE)]));
  1160.     Add(Format('Virtual Mode Extension=%d',[integer(VME)]));
  1161.     Add(Format('Built-In FPU=%d',[integer(FPU)]));
  1162.   end;
  1163. end;
  1164.  
  1165. { TCPU }
  1166.  
  1167. constructor TCPU.Create;
  1168. begin
  1169.   inherited;
  1170.   FFeatures:=TCPUFeatures.Create;
  1171.   FCache:=TCPUCache.Create;
  1172. end;
  1173.  
  1174. destructor TCPU.Destroy;
  1175. begin
  1176.   FFeatures.Free;
  1177.   FCache.Free;
  1178.   inherited;
  1179. end;
  1180.  
  1181. procedure TCPU.GetInfo;
  1182. var
  1183.   SI :TSystemInfo;
  1184.   CPUID: TCPUIDResult;
  1185.   i,t: integer;
  1186.   cn: string;
  1187. const
  1188.   rkCPU = {HKEY_LOCAL_MACHINE\}'HARDWARE\DESCRIPTION\System\CentralProcessor\0';
  1189.   rvVendorID = 'VendorIdentifier';
  1190.   rvID = 'Identifier';
  1191. begin
  1192.   ZeroMemory(@SI,SizeOf(SI));
  1193.   GetSystemInfo(SI);
  1194.   FCount:=SI.dwNumberOfProcessors;
  1195.  
  1196.   with TRegistry.Create do begin
  1197.     Rootkey:=HKEY_LOCAL_MACHINE;
  1198.     if OpenKey(rkCPU,False) then begin
  1199.       FVendorReg:=ReadString(rvVendorID);
  1200.       FVendorIDReg:=ReadString(rvID);
  1201.       CloseKey;
  1202.     end;
  1203.     Free;
  1204.   end;
  1205.  
  1206.   FFreq:=GetCPUSpeed.NormFreq;
  1207.  
  1208.   CPUID_Level:=CPUID_CPUSIGNATURE;
  1209.   CPUID:=ExecuteCPUID;
  1210.   FFamily:=CPUID.EAX shr 8 and $F;
  1211.   FTyp:=CPUID.EAX shr 12 and 3;
  1212.   FModel:=CPUID.EAX shr 4 and $F;
  1213.   FStepping:=CPUID.EAX and $F;
  1214.   FBrand:=LoByte(LoWord(CPUID.EBX));
  1215.  
  1216.   CPUID_Level:=CPUID_MAXLEVEL;
  1217.   CPUID:=ExecuteCPUID;
  1218.   FLevel:=CPUID.EAX;
  1219.  
  1220.   FVendorCPUID:=GetVendor;
  1221.  
  1222.   FCPUVendor:=VENDOR_UNKNOWN;
  1223.   FVendor:='';
  1224.   for i:=VENDOR_INTEL to VENDOR_RISE do
  1225.     if CPUVendorIDs[i]=Vendor_CPUID then begin
  1226.       FCPUVendor:=i;
  1227.       FVendor:=CPUVendors[i];
  1228.       FVendorEx:=CPUVendorsEx[i];
  1229.       Break;
  1230.     end;
  1231.  
  1232.   Features.GetInfo;
  1233.  
  1234.   if Features.SERIAL then
  1235.     FSerial:=GetCPUSerialNumber;
  1236.  
  1237.   FVendorIDCPUID:=GetVendorID;
  1238.  
  1239.   FDIV:=GetFDIVBugPresent;
  1240.  
  1241.   Cache.GetInfo(CPUVendor);
  1242.  
  1243.   FVendorID:=GetCPUVendorID(CPUVendor,Family,Model,Brand,Typ,Cache.Level2,Frequency,cn,t);
  1244.   FCodeName:=cn;
  1245.   FTrans:=t;
  1246. end;
  1247.  
  1248. procedure TCPU.Report(var sl: TStringList);
  1249. begin
  1250.   with sl do begin
  1251.     Add('[CPU]');
  1252.     Add(Format('Count=%d',[Self.Count]));
  1253.     Add(Format('Frequency=%d',[Frequency]));
  1254.     Add(Format('VendorID=%s',[VendorID]));
  1255.     Add(Format('Vendor=%s',[Vendor]));
  1256.     Add(Format('Family=%d',[Family]));
  1257.     Add(Format('Model=%d',[Model]));
  1258.     Add(Format('Stepping=%d',[Stepping]));
  1259.     Add(Format('CodeName=%s',[CodeName]));
  1260.     Add(Format('Transistors=%d',[Transistors]));
  1261.     Add(Format('SerialNumber=%s',[SerialNumber]));
  1262.     Add(Format('FDIVBug=%d',[Integer(FDIVBug)]));
  1263.  
  1264.     Features.Report(sl);
  1265.  
  1266.     Cache.Report(sl);
  1267.   end;
  1268. end;
  1269.  
  1270. { TCPUCache }
  1271.  
  1272. procedure TCPUCache.GetInfo;
  1273. var
  1274.   i: integer;
  1275. begin
  1276.   FLevel1Data:=0;
  1277.   FLevel1Code:=0;
  1278.   FLevel1:=0;
  1279.   FLevel2:=0;
  1280.   case AVendor of
  1281.     VENDOR_INTEL: begin
  1282.       IntelCache:=ExecuteIntelCache;
  1283.       FLevel2:=IntelCache.L2Cache;
  1284.       FLevel1Data:=0;
  1285.       for i:=0 to 15 do
  1286.     if (IntelCache.CacheDescriptors[i] in [$0A, $0C]) then begin
  1287.       if (IntelCache.CacheDescriptors[i]=$0A) then
  1288.         FLevel1Data:=8
  1289.       else
  1290.         FLevel1Data:=16;
  1291.     end;
  1292.       FLevel1Code:=0;
  1293.       for i:= 0 to 15 do
  1294.     if (IntelCache.CacheDescriptors[i] in [$6, $8]) then begin
  1295.       if (IntelCache.CacheDescriptors[i]=$06) then
  1296.         FLevel1Code:=8
  1297.       else
  1298.         FLevel1Code:=16;
  1299.     end;
  1300.       FLevel1:=0;
  1301.       for i:=0 to 15 do
  1302.     if (IntelCache.CacheDescriptors[i]=$80) then
  1303.       FLevel1:=16;
  1304.     end;
  1305.     VENDOR_AMD: begin
  1306.       AMDCache:=ExecuteAMDCache;
  1307.       FLevel1Data:=AMDCache.L1DataCache[3];
  1308.       FLevel1Code:=AMDCache.L1ICache[3];
  1309.       FLevel1:=L1Data+L1Code;
  1310.     end;
  1311.     VENDOR_CYRIX: begin
  1312.       CyrixCache:=ExecuteCyrixCache;
  1313.       if $80 in [CyrixCache.L1CacheInfo[0],CyrixCache.L1CacheInfo[1],CyrixCache.L1CacheInfo[2],CyrixCache.L1CacheInfo[3]] then
  1314.     FLevel1:=16;
  1315.     end;
  1316.     VENDOR_IDT: ;
  1317.     VENDOR_NEXGEN: ;
  1318.     VENDOR_UMC: ;
  1319.     VENDOR_RISE: ;
  1320.   end;
  1321. end;
  1322.  
  1323. procedure TCPUCache.Report(var sl: TStringList);
  1324. begin
  1325.   with sl do begin
  1326.     Add('[CPU Cache]');
  1327.     Add(Format('Level 1 Data Cache=%d',[L1Data]));
  1328.     Add(Format('Level 1 Instruction Cache=%d',[L1Code]));
  1329.     Add(Format('Level 1 Unified Cache=%d',[Level1]));
  1330.     Add(Format('Level 2 Unified Cache=%d',[Level2]));
  1331.   end;
  1332. end;
  1333.  
  1334. end.
  1335.