whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1547)

Database (90)
Files (137)
Forms (107)
Graphic (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

45 Visitors Online


 
...retrieve CPU information?
Autor: -=LTi=-
[ Print tip ]  

Tip Rating (23):  
     


//Sometimes u need to know some information about the CPU
//like: brand id, factory speed, wich instruction set supported etc.
//If so, than u can use this code.
//2002 by -=LTi=-

unit main;

interface

uses
  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  
Tfrm_main = class(TForm)
    img_info: TImage;
    procedure FormShow(Sender: TObject);
  private
    
{ Private declarations }
  
public
    
{ Public declarations }
    
procedure info(s1, s2: string);
  end;

var
  
frm_main: Tfrm_main;
  gn_speed_y: Integer;
  gn_text_y: Integer;
const
  
gn_speed_x: Integer = 8;
  gn_text_x: Integer  = 15;
  gl_start: Boolean   = True;

implementation

{$R *.DFM}

procedure Tfrm_main.FormShow(Sender: TObject);
var 
  
_eax, _ebx, _ecx, _edx: Longword;
  i: Integer;
  b: Byte;
  b1: Word;
  s, s1, s2, s3, s_all: string;
begin
  
//Set the startup colour of the image
  
img_info.Canvas.Brush.Color := clblue;
  img_info.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));


  gn_text_y := 5; //position of the 1st text

  
asm                //asm call to the CPUID inst.
    
mov eax,0         //sub. func call
    
db $0F,$A2         //db $0F,$A2 = CPUID instruction
    
mov _ebx,ebx
    mov _ecx,ecx
    mov _edx,edx
  end;

  for i := 0 to do   //extract vendor id
  
begin
    
b := lo(_ebx);
    s := s + chr(b);
    b := lo(_ecx);
    s1:= s1 + chr(b);
    b := lo(_edx);
    s2:= s2 + chr(b);
    _ebx := _ebx shr 8;
    _ecx := _ecx shr 8;
    _edx := _edx shr 8;
  end;
  info('CPU', '');
  info('   - ' + 'Vendor ID: ', s + s2 + s1);

  asm
    
mov eax,1
    db $0F,$A2
    mov _eax,eax
    mov _ebx,ebx
    mov _ecx,ecx
    mov _edx,edx
  end;
  //06B1
  //|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|
  
b := lo(_eax) and 15;
  info('   - ' + 'Stepping ID: ', IntToStr(b));
  b := lo(_eax) shr 4;
  info('   - ' + 'Model Number: ', IntToHex(b, 1));
  b := hi(_eax) and 15;
  info('   - ' + 'Family Code: ', IntToStr(b));
  b := hi(_eax) shr 4;
  info('   - ' + 'Processor Type: ', IntToStr(b));
  //31.   28. 27.   24. 23.   20. 19.   16.
  //  0 0 0 0   0 0 0 0   0 0 0 0   0 0 0 0
  
b := lo((_eax shr 16)) and 15;
  info('   - ' + 'Extended Model: ', IntToStr(b));

  b := lo((_eax shr 20));
  info('   - ' + 'Extended Family: ', IntToStr(b));

  b := lo(_ebx);
  info('   - ' + 'Brand ID: ', IntToStr(b));
  b := hi(_ebx);
  info('   - ' + 'Chunks: ', IntToStr(b));
  b := lo(_ebx shr 16);
  info('   - ' + 'Count: ', IntToStr(b));
  b := hi(_ebx shr 16);
  info('   - ' + 'APIC ID: ', IntToStr(b));

  //Bit 18 =? 1     //is serial number enabled?
  
if (_edx and $40000) = $40000 then
    
info('   - ' + 'Serial Number ', 'Enabled')
  else 
    
info('   - ' + 'Serial Number ', 'Disabled');

  s := IntToHex(_eax, 8);
  asm                  //determine the serial number
    
mov eax,3
    db $0F,$A2
    mov _ecx,ecx
    mov _edx,edx
  end;
  s1 := IntToHex(_edx, 8);
  s2 := IntToHex(_ecx, 8);
  Insert('-', s, 5);
  Insert('-', s1, 5);
  Insert('-', s2, 5);
  info('   - ' + 'Serial Number: ', s + '-' + s1 + '-' + s2);

  asm
    
mov eax,1
    db $0F,$A2
    mov _edx,edx
  end;
  info('', '');
  //Bit 23 =? 1
  
if (_edx and $800000) = $800000 then
    
info('MMX ', 'Supported')
  else 
    
info('MMX ', 'Not Supported');

  //Bit 24 =? 1
  
if (_edx and $01000000) = $01000000 then
    
info('FXSAVE & FXRSTOR Instructions ', 'Supported')
  else 
    
info('FXSAVE & FXRSTOR Instructions Not ', 'Supported');

  //Bit 25 =? 1
  
if (_edx and $02000000) = $02000000 then
    
info('SSE ', 'Supported')
  else 
    
info('SSE ', 'Not Supported');

  //Bit 26 =? 1
  
if (_edx and $04000000) = $04000000 then
    
info('SSE2 ', 'Supported')
  else 
    
info('SSE2 ', 'Not Supported');

  info('', '');

  asm     //execute the extended CPUID inst.
    
mov eax,$80000000   //sub. func call
    
db $0F,$A2
    mov _eax,eax
  end;

  if _eax > $80000000 then  //any other sub. funct avail. ?
  
begin
    
info('Extended CPUID: ', 'Supported');
    info('   - Largest Function Supported: ', IntToStr(_eax - $80000000));
    asm     //get brand ID
      
mov eax,$80000002
      db $0F
      db $A2
      mov _eax,eax
      mov _ebx,ebx
      mov _ecx,ecx
      mov _edx,edx
    end;
    s  := '';
    s1 := '';
    s2 := '';
    s3 := '';
    for i := 0 to do
    begin
      
b := lo(_eax);
      s3:= s3 + chr(b);
      b := lo(_ebx);
      s := s + chr(b);
      b := lo(_ecx);
      s1 := s1 + chr(b);
      b := lo(_edx);
      s2 := s2 + chr(b);
      _eax := _eax shr 8;
      _ebx := _ebx shr 8;
      _ecx := _ecx shr 8;
      _edx := _edx shr 8;
    end;

    s_all := s3 + s + s1 + s2;

    asm
      
mov eax,$80000003
      db $0F
      db $A2
      mov _eax,eax
      mov _ebx,ebx
      mov _ecx,ecx
    mov _edx,edx
    end;
    s  := '';
    s1 := '';
    s2 := '';
    s3 := '';
    for i := 0 to do
    begin
      
b := lo(_eax);
      s3 := s3 + chr(b);
      b := lo(_ebx);
      s := s + chr(b);
      b := lo(_ecx);
      s1 := s1 + chr(b);
      b := lo(_edx);
      s2 := s2 + chr(b);
      _eax := _eax shr 8;
      _ebx := _ebx shr 8;
      _ecx := _ecx shr 8;
      _edx := _edx shr 8;
    end;
    s_all := s_all + s3 + s + s1 + s2;

    asm
      
mov eax,$80000004
      db $0F
      db $A2
      mov _eax,eax
      mov _ebx,ebx
      mov _ecx,ecx
      mov _edx,edx
    end;
    s  := '';
    s1 := '';
    s2 := '';
    s3 := '';
    for i := 0 to do
    begin
      
b  := lo(_eax);
      s3 := s3 + chr(b);
      b := lo(_ebx);
      s := s + chr(b);
      b := lo(_ecx);
      s1 := s1 + chr(b);
      b  := lo(_edx);
      s2 := s2 + chr(b);
      _eax := _eax shr 8;
      _ebx := _ebx shr 8;
      _ecx := _ecx shr 8;
      _edx := _edx shr 8;
    end;
    info('Brand String: ', '');
    if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
    info('', '   - ' + s_all + s3 + s + s1 + s2);
  end
  else 
    
info('   - Extended CPUID ', 'Not Supported.');
end;

procedure Tfrm_main.info(s1, s2: string);
begin
  if 
s1 <> '' then
  begin
    
img_info.Canvas.Brush.Color := clblue;
    img_info.Canvas.Font.Color  := clyellow;
    img_info.Canvas.TextOut(gn_text_x, gn_text_y, s1);
  end;
  if s2 <> '' then
  begin
    
img_info.Canvas.Brush.Color := clblue;
    img_info.Canvas.Font.Color  := clWhite;
    img_info.Canvas.TextOut(gn_text_x + img_info.Canvas.TextWidth(s1), gn_text_y, s2);
  end;
  Inc(gn_text_y, 13);
end;

end.

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners