{********************************************************************************************************}
{                                                                                                        }
{ Carbonsoft cxCpu Processor Detection Toolkit Release 4                                                 }
{                                                                                                        }
{ cxCpu40 Non Visual Component Example                                                                   }
{                                                                                                        }
{ Copyright © 1995-2003 Kev French, Carbonsoft. All rights reserved.                                     }
{ http://www.carbonsoft.com/cxcpu/                                                                       }
{                                                                                                        }
{ IMPORTANT INFORMATION                                                                                  }
{ You (individual or organisation) are free to use this utility and any example source code              }
{ provided by Carbonsoft for any purpose.                                                                }
{                                                                                                        }
{ Use of this component and any example source code is entirely at your own risk.                        }
{                                                                                                        }
{ For more information please contact licensing@carbonsoft.com                                           }
{                                                                                                        }
{********************************************************************************************************}
unit cxCpu40Nv;

interface

{$IFDEF BCB}
  {$ObjExportAll On}
{$ENDIF}

uses
  Classes, cxCpu40;

type
  TcxAvailable = class(TPersistent)
  private
    fAvailable: Byte;
    fLogical: Byte;

    procedure SetByte(Value: Byte);
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Available: Byte read fAvailable write SetByte;
    property Logical: Byte read fLogical write SetByte;
  end;

  TcxCacheInfo = class(TPersistent)
  private
    fAvailable: Boolean;
    fAssociativity: String;
    fLineSize: Longword;
    fSize: Longword;

    procedure SetBoolean(Value: Boolean);
    procedure SetString(Value: String);
    procedure SetLongword(Value: Longword);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte; Level: TCacheLevel);
  published
    property Available: Boolean read fAvailable write SetBoolean;
    property Associativity: String read fAssociativity write SetString;
    property LineSize: longword read fLineSize write SetLongword;
    property Size: Longword read fSize write SetLongword;
  end;

  TcxSegmentedCache = class(TPersistent)
  private
    fCode: TcxCacheInfo;
    fData: TcxCacheInfo;
    fUnified: TcxCacheInfo;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property Code: TcxCacheInfo read fCode write fCode;
    property Data: TcxCacheInfo read fData write fData;
    property Unified: TcxCacheInfo read fUnified write fUnified;
  end;

  TcxCache = class(TPersistent)
  private
    fLevel1: TcxSegmentedCache;
    fLevel2: TcxCacheInfo;
    fLevel3: TcxCacheInfo;
    fTrace: TcxCacheInfo;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property Level1: TcxSegmentedCache read fLevel1 write fLevel1;
    property Level2: TcxCacheInfo read fLevel2 write fLevel2;
    property Level3: TcxCacheInfo read fLevel3 write fLevel3;
    property Trace: TcxCacheInfo read fTrace write fTrace;
  end;

  TcxCpuidInfo = class(TPersistent)
  private
    fAvailable: Boolean;
    fMaximumCommand: String;
    procedure SetBoolean(Value: Boolean);
    procedure SetString(Value: String);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte; Level: TCpuidExecutionLevel);
  published
    property Available: Boolean read fAvailable write SetBoolean;
    property MaximumCommand: String read fMaximumCommand write SetString;
  end;

  TcxCpuid = class(TPersistent)
  private
    fStandard: TcxCpuidInfo;
    fExtended: TcxCpuidInfo;
    fTransmeta: TcxCpuidInfo;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property Standard: TcxCpuidInfo read fStandard write fStandard;
    property Extended: TcxCpuidInfo read fExtended write fExtended;
    property Transmeta: TcxCpuidInfo read fTransmeta write fTransmeta;
  end;

  TcxErrata = class(TPersistent)
  private
    fFDivBug: Boolean;
    fDuronCache: Boolean;

    procedure SetBoolean(Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property FDivBug: Boolean read fFDivBug write SetBoolean;
    property DuronCache: Boolean read fDuronCache write SetBoolean;
  end;

  TcxFeature = (fFpu, fTs, fVme, fFid, fDe, fVid, fPse, fTpp, fTsc, fTmp, fMsr, fStc, fPae, fMce, fTm2,
                fCx8, fEst, fApic, fCid, fSep, fMtrr, fPge, fMca, fCmov, fPat, fPse36, fPsn, fClfsh,
                fMp, fNxAmd, fNxCyrix, fDtes, fAcpi, fMmxAmd, fMmx, fFxsr, fMmxCyrix, fSse, fSse2, fSs,
                fHtt, fTm, fLmAmd, fLmCyrix, fIa64, f3dnowp, fSbf, f3dnow);

  TcxFeatures = class(TPersistent)
  private
    fActiveCpu: Byte;
    fActiveFeature: TcxFeature;
    fAvailable: Boolean;
    fBitIndex: Byte;
    fDescription: String;
    fMnemonic: String;

    procedure SetActiveFeature(Value: TcxFeature);
    procedure SetBoolean(Value: Boolean);
    procedure SetByte(Value: Byte);
    procedure SetString(Value: String);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property ActiveFeature: TcxFeature read fActiveFeature write SetActiveFeature;
    property Available: Boolean read fAvailable write SetBoolean;
    property BitIndex: Byte read fBitIndex write SetByte;
    property Description: String read fDescription write fDescription;
    property Mnemonic: String read fMnemonic write SetString;
  end;

  TcxName = class(TPersistent)
  private
    fName: String;
    fFromLookup: Boolean;

    procedure SetString(Value: String);
    procedure SetBoolean(Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property CpuName: String read fName write SetString;
    property FromLookup: Boolean read fFromLookup write SetBoolean;
  end;

  TcxSerial = class(TPersistent)
  private
    fAvailable: Boolean;
    fFormatted: String;
    fRaw: String;

    procedure SetBoolean(Value: Boolean);
    procedure SetString(Value: String);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property Available: Boolean read fAvailable write SetBoolean;
    property Formatted: String read fFormatted write SetString;
    property Raw: String read fRaw write SetString;
  end;

  TcxSignature = class(TPersistent)
  private
    fCpuType: Longword;
    fCpuFamily: Longword;
    fCpuModel: Longword;
    fCpuStepping: Longword;
    fCpuBrand: Longword;

    fExtendedFamily: Boolean;
    fExtendedModel: Boolean;

    procedure SetLongword(Value: Longword);
    procedure SetBoolean(Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property CpuType: Longword read fCpuType write SetLongword;
    property Family: Longword read fCpuFamily write SetLongword;
    property Model: Longword read fCpuModel write SetLongword;
    property Stepping: Longword read fCpuStepping write SetLongword;
    property Brand: Longword read fCpuBrand write SetLongword;
    property XtendedFamily: Boolean read fExtendedFamily write SetBoolean;
    property XtendedModel: Boolean read fExtendedModel write SetBoolean;
  end;

  TcxSpeed = class(TPersistent)
  private
    fRaw: Longword;
    fNormal: Longword;
    fMapping: String;

    procedure SetLongword(Value: Longword);
    procedure SetString(Value: String);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property Raw: Longword read fRaw write SetLongword;
    property Normal: Longword read fNormal write SetLongword;
    property Mapping: String read fMapping write SetString;
  end;

  TcxVendor = class(TPersistent)
  private
    fSignature: String;
    fName: String;

    procedure SetString(Value: String);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Refresh(Cpu: Byte);
  published
    property Signature: String read fSignature write SetString;
    property VendorName: String read fName write SetString;
  end;

  TcxCpu40 = class(TComponent)
  private
    fActiveCpu: Byte;

    fAvailable: TcxAvailable;
    fCache: TcxCache;
    fCpuid: TcxCpuid;
    fErrata: TcxErrata;
    fFeatures: TcxFeatures;
    fName: TcxName;
    fSerial: TcxSerial;
    fSignature: TcxSignature;
    fSpeed: TcxSpeed;

    fVersion: String;

    procedure SetActiveCpu(Value: Byte);

    procedure SetString(Value: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Refresh;
  published
    property ActiveCpu: Byte read fActiveCpu write SetActiveCpu;
    property Available: TcxAvailable read fAvailable write fAvailable;
    property Cache: TcxCache read fCache write fCache;
    property Cpuid: TcxCpuid read fCpuid write fCpuid;
    property Errata: TcxErrata read fErrata write fErrata;
    property Features: TcxFeatures read fFeatures write fFeatures;
    property CpuName: TcxName read fName write fName;
    property Serial: TcxSerial read fSerial write fSerial;
    property Signature: TcxSignature read fSignature write fSignature;
    property Speed: TcxSpeed read fSpeed write fSpeed;
    property Version: String read fVersion write SetString;

  end;

implementation

{ TcxAvailable }

constructor TcxAvailable.Create;
begin
  inherited Create;
  fAvailable := cxCpu.ProcessorCount.Available.AsNumber;
  fLogical := cxCpu.ProcessorCount.Logical.AsNumber;
end;

destructor TcxAvailable.Destroy;
begin
  inherited;
end;

procedure TcxAvailable.SetByte(Value: Byte);
begin
  // Dummy writer
end;

{ TcxCacheInfo }

constructor TcxCacheInfo.Create;
begin
  inherited Create;
end;

destructor TcxCacheInfo.Destroy;
begin
  inherited;
end;

procedure TcxCacheInfo.Refresh(Cpu: Byte; Level: TCacheLevel);
var
  CacheInfo: ICpuCache;
begin
  case Level of
    clLevel1Code: CacheInfo := cxCpu[Cpu].Cache.Level1.Code;
    clLevel1Data: CacheInfo := cxCpu[Cpu].Cache.Level1.Data;
    clLevel1Unified: CacheInfo := cxCpu[Cpu].Cache.Level1.Unified;
    clLevel2: CacheInfo := cxCpu[Cpu].Cache.Level2;
    clLevel3: CacheInfo := cxCpu[Cpu].Cache.Level3;
    clTrace: CacheInfo := cxCpu[Cpu].Cache.Trace;
  end;
  fAvailable := CacheInfo.Available.AsBoolean;
  fAssociativity := CacheInfo.Associativity.Name;
  fLineSize := CacheInfo.LineSize.AsNumber;
  fSize := CacheInfo.Size.AsNumber;
end;

procedure TcxCacheInfo.SetBoolean(Value: Boolean);
begin
  // Dummy writer
end;

procedure TcxCacheInfo.SetLongword(Value: Longword);
begin
  // Dummy writer
end;

procedure TcxCacheInfo.SetString(Value: String);
begin
  // Dummy writer
end;

{ TcxSegmentedCache }

constructor TcxSegmentedCache.Create;
begin
  inherited Create;

  fCode := TcxCacheInfo.Create;
  fData := TcxCacheInfo.Create;
  fUnified := TcxCacheInfo.Create;
end;

destructor TcxSegmentedCache.Destroy;
begin
  fUnified.Free;
  fData.Free;
  fCode.Free;
  inherited;
end;

procedure TcxSegmentedCache.Refresh(Cpu: Byte);
begin
  fCode.Refresh(Cpu, clLevel1Code);
  fData.Refresh(Cpu, clLevel1Data);
  fUnified.Refresh(Cpu, clLevel1Unified);
end;

{ TcxCache }

constructor TcxCache.Create;
begin
  inherited Create;

  fLevel1 := TcxSegmentedCache.Create;
  fLevel2 := TcxCacheInfo.Create;
  fLevel3 := TcxCacheInfo.Create;
  fTrace := TcxCacheInfo.Create;
end;

destructor TcxCache.Destroy;
begin
  fTrace.Free;
  fLevel3.Free;
  fLevel2.Free;
  fLevel1.Free;
  inherited;
end;

procedure TcxCache.Refresh(Cpu: Byte);
begin
  fLevel1.Refresh(Cpu);
  fLevel2.Refresh(Cpu, clLevel2);
  fLevel3.Refresh(Cpu, clLevel3);
  fTrace.Refresh(Cpu, clTrace);
end;

{ TcxCpuidInfo }

constructor TcxCpuidInfo.Create;
begin
  inherited Create;
end;

destructor TcxCpuidInfo.Destroy;
begin
  inherited;
end;

procedure TcxCpuidInfo.Refresh(Cpu: Byte; Level: TCpuidExecutionLevel);
var
  CpuidInfo: ICpuidInformation;
begin
  case Level of
    celStandard: CpuidInfo := cxCpu[Cpu].Cpuid.Standard;
    celExtended: CpuidInfo := cxCpu[Cpu].Cpuid.Extended;
    celTransmeta: CpuidInfo := cxCpu[Cpu].Cpuid.Transmeta;
  end;
  fAvailable := CpuidInfo.Available.AsBoolean;
  fMaximumCommand := CpuidInfo.MaximumCommand.FormatHex;
end;

procedure TcxCpuidInfo.SetBoolean(Value: Boolean);
begin
  // dummy writer
end;

procedure TcxCpuidInfo.SetString(Value: String);
begin
  // dummy writer
end;

{ TcxCpuid }

constructor TcxCpuid.Create;
begin
  inherited Create;

  fStandard := TcxCpuidInfo.Create;
  fExtended := TcxCpuidInfo.Create;
  fTransmeta := TcxCpuidInfo.Create;
end;

destructor TcxCpuid.Destroy;
begin
  fTransmeta.Free;
  fExtended.Free;
  fStandard.Free;
  inherited;
end;

procedure TcxCpuid.Refresh(Cpu: Byte);
begin
  fStandard.Refresh(Cpu, celStandard);
  fExtended.Refresh(Cpu, celExtended);
  fTransmeta.Refresh(Cpu, celTransmeta);
end;

{ TcxErrata }

constructor TcxErrata.Create;
begin
  inherited Create;
end;

destructor TcxErrata.Destroy;
begin
  inherited;
end;

procedure TcxErrata.Refresh(Cpu: Byte);
begin
  fFDivBug := cxCpu[Cpu].Errata.FDivError.AsBoolean;
  fDuronCache := cxCpu[Cpu].Errata.DuronCache.AsBoolean;
end;

procedure TcxErrata.SetBoolean(Value: Boolean);
begin
  // Dummy writer
end;

{ TcxName }

constructor TcxName.Create;
begin
  inherited Create;
end;

destructor TcxName.Destroy;
begin
  inherited;
end;

procedure TcxName.Refresh(Cpu: Byte);
begin
  fName := cxCpu[Cpu].Name.AsString;
  fFromLookup := cxCpu[Cpu].Name.FromLookup.AsBoolean;
end;

procedure TcxName.SetBoolean(Value: Boolean);
begin
  // Dummy writer
end;

procedure TcxName.SetString(Value: String);
begin
  // Dummy writer
end;

{ TcxSerial }

constructor TcxSerial.Create;
begin
  inherited Create;
end;

destructor TcxSerial.Destroy;
begin
  inherited;
end;

procedure TcxSerial.Refresh(Cpu: Byte);
begin
  fAvailable := cxCpu[Cpu].Serial.Available.AsBoolean;
  if Available then
  begin
    fFormatted := cxCpu[Cpu].Serial.Formatted;
    fRaw := cxCpu[Cpu].Serial.Value;
  end
  else
  begin
    fFormatted := '';
    fRaw := '';
  end;
end;

procedure TcxSerial.SetBoolean(Value: Boolean);
begin
  // Dummy writer
end;

procedure TcxSerial.SetString(Value: String);
begin
  // Dummy writer
end;

{ TcxSignature }

constructor TcxSignature.Create;
begin
  inherited Create;
end;

destructor TcxSignature.Destroy;
begin
  inherited;
end;

procedure TcxSignature.Refresh(Cpu: Byte);
begin
  fCpuType := cxCpu[Cpu].Signature.CpuType.Value.AsNumber;
  fCpuFamily := cxCpu[Cpu].Signature.Family.Value.AsNumber;
  fCpuModel := cxCpu[Cpu].Signature.Model.Value.AsNumber;
  fCpuStepping := cxCpu[Cpu].Signature.Stepping.Value.AsNumber;
  fCpuBrand := cxCpu[Cpu].Signature.Brand.Value.AsNumber;
  fExtendedFamily := cxCpu[Cpu].Signature.Family.Extended.AsBoolean;
  fExtendedModel := cxCpu[Cpu].Signature.Model.Extended.AsBoolean;
end;

procedure TcxSignature.SetBoolean(Value: Boolean);
begin
  // Dummy writer
end;

procedure TcxSignature.SetLongword(Value: Longword);
begin
  // Dummy writer
end;

{ TcxSpeed }

constructor TcxSpeed.Create;
begin
  inherited Create;
end;

destructor TcxSpeed.Destroy;
begin
  inherited;
end;

procedure TcxSpeed.Refresh(Cpu: Byte);
begin
  fRaw := cxCpu[Cpu].Speed.RawSpeed.AsNumber;
  fNormal := cxCpu[Cpu].Speed.Normalised.AsNumber;
  fMapping := cxCpu[Cpu].Speed.Mapping;
end;

procedure TcxSpeed.SetLongword(Value: Longword);
begin
  // Dummy writer
end;

procedure TcxSpeed.SetString(Value: String);
begin
  // Dummy writer
end;

{ TcxVendor }

constructor TcxVendor.Create;
begin
  inherited Create;
end;

destructor TcxVendor.Destroy;
begin
  inherited;
end;

procedure TcxVendor.Refresh(Cpu: Byte);
begin
  fSignature := cxCpu[Cpu].Vendor.Signature;
  fName := cxCpu[Cpu].Vendor.Name;
end;

procedure TcxVendor.SetString(Value: String);
begin
  // Dummy writer
end;

{ TcxFeatures }

constructor TcxFeatures.Create;
begin
  inherited Create;
  ActiveFeature := fFpu;
end;

destructor TcxFeatures.Destroy;
begin
  inherited;
end;

procedure TcxFeatures.Refresh(Cpu: Byte);
begin
  fActiveCpu := Cpu;
  SetActiveFeature(fActiveFeature);
end;

procedure TcxFeatures.SetActiveFeature(Value: TcxFeature);
var
  Feature: ICpuFeature;
begin
  fActiveFeature := Value;
  Feature := cxCpu[fActiveCpu].Features.ByName(cFeatureDetails[Ord(Value)].Mnemonic);
  fAvailable := Feature.Available.AsBoolean;
  fBitIndex := Feature.BitIndex;
  fDescription := Feature.Name;
  fMnemonic := Feature.Mnemonic;
end;

procedure TcxFeatures.SetBoolean(Value: Boolean);
begin
  // Dummy writer
end;

procedure TcxFeatures.SetByte(Value: Byte);
begin
  // Dummy writer
end;

procedure TcxFeatures.SetString(Value: String);
begin
  // Dummy writer
end;

{ TcxCpu40 }

constructor TcxCpu40.Create(AOwner: TComponent);
begin
  inherited;
  fAvailable := TcxAvailable.Create;
  fCache := TcxCache.Create;
  fCpuid := TcxCpuid.Create;
  fErrata := TcxErrata.Create;
  fFeatures := TcxFeatures.Create;
  fName := TcxName.Create;
  fSerial := TcxSerial.Create;
  fSignature := TcxSignature.Create;
  fSpeed := TcxSpeed.Create;
  fVersion := cxCpu.Version.FormatVersion;

  ActiveCpu := 0;
end;

destructor TcxCpu40.Destroy;
begin
  fSpeed.Free;
  fSignature.Free;
  fSerial.Free;
  fName.Free;
  fFeatures.Free;
  fErrata.Free;
  fCpuid.Free;
  fCache.Free;
  fAvailable.Free;
  inherited;
end;

procedure TcxCpu40.Refresh;
begin
  fSpeed.Refresh(ActiveCpu);
  fSignature.Refresh(ActiveCpu);
  fSerial.Refresh(ActiveCpu);
  fName.Refresh(ActiveCpu);
  fFeatures.Refresh(ActiveCpu);
  fErrata.Refresh(ActiveCpu);
  fCpuid.Refresh(ActiveCpu);
  fCache.Refresh(ActiveCpu);
end;

procedure TcxCpu40.SetActiveCpu(Value: Byte);
begin
  if Value < Available.Available then
  begin
    fActiveCpu := Value;
    Refresh;
  end;
end;

procedure TcxCpu40.SetString(Value: String);
begin
  // Dummy writer
end;

end.
