INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

How To

How do I make a component to get CPU information? by djjd47130
Posted: 2 Aug 11 (Edited 13 Feb 13)

This component, first of all, has not been tested 100%. In other words, the source code which I originally found is using ASM code, and I cannot only take credit for it, but I also can't even comprehend it.

Otherwise, the original code I found was only displaying the CPU information in the form of an image (go figure). So I wrapped the functionality into a component and make the info available through the component's properties. The info can be visible in Delphi's object inspector. The property setting procedures do not actually set the properties - it's a trick to show the info but not allow any changes. (I believe later versions of delphi allow publishing read-only properties, unlike my D7)

CODE

unit JDCPUInfo;

interface

uses
  Classes, Windows, SysUtils, StrUtils;

type
  TJDCPUInfo = class(TComponent)
  private
    fMMXSupp: Bool;
    fExtendedCPUID: Bool;
    fSSE2Supp: Bool;
    fFXSupp: Bool;
    fSSESupp: Bool;
    fSerialNumber: Bool;
    fLargestFunction: Integer;
    fExtendedFamily: Integer;
    fProcessorType: Integer;
    fCount: Integer;
    fChunk: Integer;
    fAPICID: Integer;
    fModelNumber: Integer;
    fExtendedModel: Integer;
    fFamilyCode: Integer;
    fBrandID: Integer;
    fSteppingID: Integer;
    fSerialNumberStr: String;
    fBrandString: String;
    fVendorID: String;
    procedure SetAPICID(const Value: Integer);
    procedure SetBrandID(const Value: Integer);
    procedure SetBrandString(const Value: String);
    procedure SetChunk(const Value: Integer);
    procedure SetCount(const Value: Integer);
    procedure SetExtendedCPUID(const Value: Bool);
    procedure SetExtendedFamily(const Value: Integer);
    procedure SetExtendedModel(const Value: Integer);
    procedure SetFamilyCode(const Value: Integer);
    procedure SetFXSupp(const Value: Bool);
    procedure SetLargestFunction(const Value: Integer);
    procedure SetMMXSupp(const Value: Bool);
    procedure SetModelNumber(const Value: Integer);
    procedure SetProcessorType(const Value: Integer);
    procedure SetSerialNumber(const Value: Bool);
    procedure SetSerialNumberStr(const Value: String);
    procedure SetSSE2Supp(const Value: Bool);
    procedure SetSSESupp(const Value: Bool);
    procedure SetSteppingID(const Value: Integer);
    procedure SetVendorID(const Value: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property VendorID: String read fVendorID write SetVendorID;
    property SteppingID: Integer read fSteppingID write SetSteppingID;
    property ModelNumber: Integer read fModelNumber write SetModelNumber;
    property FamilyCode: Integer read fFamilyCode write SetFamilyCode;
    property ProcessorType: Integer read fProcessorType write SetProcessorType;
    property ExtendedModel: Integer read fExtendedModel write SetExtendedModel;
    property ExtendedFamily: Integer read fExtendedFamily write SetExtendedFamily;
    property BrandID: Integer read fBrandID write SetBrandID;
    property Chunk: Integer read fChunk write SetChunk;
    property Count: Integer read fCount write SetCount;
    property APICID: Integer read fAPICID write SetAPICID;
    property SerialNumber: Bool read fSerialNumber write SetSerialNumber;
    property SerialNumberStr: String read fSerialNumberStr write SetSerialNumberStr;
    property MMXSupport: Bool read fMMXSupp write SetMMXSupp;
    property FXSupport: Bool read fFXSupp write SetFXSupp;
    property SSESupport: Bool read fSSESupp write SetSSESupp;
    property SSE2Support: Bool read fSSE2Supp write SetSSE2Supp;
    property ExtendedCPUID: Bool read fExtendedCPUID write SetExtendedCPUID;
    property LargestFunction: Integer read fLargestFunction write SetLargestFunction;
    property BrandString: String read fBrandString write SetBrandString;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('JD Custom', [TJDCPUInfo]);
end;

{ TJDCPUInfo }

constructor TJDCPUInfo.Create(AOwner: TComponent);   
var
  _eax, _ebx, _ecx, _edx: Longword;
  i: Integer;
  b: Byte;
  b1: Word;
  s, s1, s2, s3, s_all: string;
begin
  inherited;
  asm
    mov eax,0
    db $0F,$A2
    mov _ebx,ebx
    mov _ecx,ecx
    mov _edx,edx
  end;
  for i := 0 to 3 do 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;
  Self.fVendorID:= s + s2 + s1;
  asm
    mov eax,1
    db $0F,$A2
    mov _eax,eax
    mov _ebx,ebx
    mov _ecx,ecx
    mov _edx,edx
  end;
  Self.fSteppingID:= lo(_eax) and 15;
  Self.fModelNumber:= lo(_eax) shr 4;
  Self.fFamilyCode:= hi(_eax) and 15;
  Self.fProcessorType:= hi(_eax) shr 4;
  Self.fExtendedModel:= lo((_eax shr 16)) and 15;
  Self.fExtendedFamily:= lo((_eax shr 20));
  Self.fBrandID:= lo(_ebx);
  Self.fChunk:= hi(_ebx);
  Self.fCount:= lo(_ebx shr 16);
  Self.fAPICID:= hi(_ebx shr 16);
  Self.fSerialNumber:= ((_edx and $40000) = $40000);
  s := IntToHex(_eax, 8);
  asm
    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);
  Self.fSerialNumberStr:= s + '-' + s1 + '-' + s2;
  asm
    mov eax,1
    db $0F,$A2
    mov _edx,edx
  end;
  Self.fMMXSupp:= ((_edx and $800000) = $800000);
  Self.fFXSupp:= ((_edx and $01000000) = $01000000);
  Self.fSSESupp:= ((_edx and $02000000) = $02000000);
  Self.fSSE2Supp:= ((_edx and $04000000) = $04000000);
  asm
    mov eax,$80000000
    db $0F,$A2
    mov _eax,eax
  end;
  Self.fExtendedCPUID:= (_eax > $80000000);
  if fExtendedCPUID then begin
    Self.fLargestFunction:= _eax - $80000000;
    asm
      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 3 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 3 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 3 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;
    if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
    Self.fBrandString:= s_all + s3 + s + s1 + s2;
  end;
end;

destructor TJDCPUInfo.Destroy;
begin

  inherited;
end;

//IMPORTANT: Do not actually set these properties

procedure TJDCPUInfo.SetAPICID(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetBrandID(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetBrandString(const Value: String);
begin

end;

procedure TJDCPUInfo.SetChunk(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetCount(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetExtendedCPUID(const Value: Bool);
begin

end;

procedure TJDCPUInfo.SetExtendedFamily(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetExtendedModel(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetFamilyCode(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetFXSupp(const Value: Bool);
begin

end;

procedure TJDCPUInfo.SetLargestFunction(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetMMXSupp(const Value: Bool);
begin

end;

procedure TJDCPUInfo.SetModelNumber(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetProcessorType(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetSerialNumber(const Value: Bool);
begin

end;

procedure TJDCPUInfo.SetSerialNumberStr(const Value: String);
begin

end;

procedure TJDCPUInfo.SetSSE2Supp(const Value: Bool);
begin

end;

procedure TJDCPUInfo.SetSSESupp(const Value: Bool);
begin

end;

procedure TJDCPUInfo.SetSteppingID(const Value: Integer);
begin

end;

procedure TJDCPUInfo.SetVendorID(const Value: String);
begin

end;

end. 

Back to Embarcadero: Delphi FAQ Index
Back to Embarcadero: Delphi Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close