{********************************************************************************************************}
{                                                                                                        }
{ Carbonsoft cxCpu Processor Detection Toolkit Release 4                                                 }
{                                                                                                        }
{ Explorer Demo                                                                                          }
{                                                                                                        }
{ 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 utility and any example source code is entirely at your own risk.                          }
{                                                                                                        }
{ For more information please contact licensing@carbonsoft.com                                           }
{                                                                                                        }
{********************************************************************************************************}
unit ExplorerWindow;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, ImgList, cxCpu40;

type
  IListviewUpdate = interface
    ['{8A13CA39-D726-46DA-9265-B39C97119515}']
  end;
  TListviewUpdate = class(TInterfacedObject, IListviewUpdate)
  private
    fCursor: TCursor;
    fListView: TListView;
  public
    constructor Create(const AListView: TListView; Clear: Boolean);
    destructor Destroy; override;
  end;

  TExplorerDialog = class(TForm)
    Pages: TPageControl;
    TabSheet1: TTabSheet;
    Button1: TButton;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    lvUsage: TListView;
    tvNavigation: TTreeView;
    lvInformation: TListView;
    Bevel1: TBevel;
    tmUsage: TTimer;
    TabSheet3: TTabSheet;
    Label3: TLabel;
    lVersion: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Image1: TImage;
    Bevel2: TBevel;
    Panel1: TPanel;
    ckEnableUsage: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure tvNavigationChange(Sender: TObject; Node: TTreeNode);
    procedure ckEnableUsageClick(Sender: TObject);
    procedure tmUsageTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    // Processor Explorer
    procedure tvGenerate;
    procedure tvDecodeItem(Node: TTreeNode);

    function lvUpdate: IListviewUpdate;
    procedure lvClear;
    procedure lvAddItem(ACaption: String; Value: String; Image: Integer);
    procedure lvPopulate_NoItems;
    procedure lvPopulate_About;
    procedure lvPopulate_Count;
    procedure lvPopulate_Cpu(Info: IProcessorInformation);
    procedure lvPopulate_Cache(Info: ICpuCache);
    procedure lvPopulate_Cpuid(Info: ICpuidInformation);
    procedure lvPopulate_Errata(Info: IProcessorErrata);
    procedure lvPopulate_Features(Info: ICpuFeatureSet);
    procedure lvPopulate_Signature(Info: IProcessorSignature);
    procedure lvPopulate_Vendor(Info: IProcessorVendor);

    // Processor Usage
    procedure puGenerate;

    function puUpdate: IListviewUpdate;
    procedure puAddItem(ACaption: String);

    // About information
    procedure abGenerate;
  public
    { Public declarations }
  end;

var
  ExplorerDialog: TExplorerDialog;

const
  cExplorerNode_Root      = 0;
  cExplorerNode_Processor = 10;
  cExplorerNode_Cpuid     = 20;
  cExplorerNode_Signature = 30;
  cExplorerNode_Features  = 40;
  cExplorerNode_Cache     = 50;
  cExplorerNode_Vendor    = 60;
  cExplorerNode_Errata    = 70;

  cExplorerNode_Count     = 90;
  cExplorerNode_NoItems   = 100;

  cValue_ICpuNumber       = 0;
  cValue_ICpuBoolean      = 1;
  cValue_String           = 2;
  cValue_Interface        = 3;

implementation

{$IFDEF VER150}
  {$R WindowsXp.res}
{$ENDIF VER150}

{$R *.dfm}

{ TListviewUpdate }

constructor TListviewUpdate.Create(const AListView: TListView; Clear: Boolean);
begin
  inherited Create;

  fCursor := Screen.Cursor;
  fListview := AListView;

  Screen.Cursor := crHourglass;
  fListView.Items.BeginUpdate;

  if Clear then
    fListView.Items.Clear;
end;

destructor TListviewUpdate.Destroy;
begin
  fListView.Items.EndUpdate;
  Screen.Cursor := fCursor;
  inherited;
end;

{ TExplorerDialog }

procedure TExplorerDialog.tvGenerate;
var
  i: Integer;
  Cpu: Integer;
  Cursor: TCursor;
  RootNode: TTreeNode;
  ProcessorsNode: TTreeNode;
  CpuNode: TTreeNode;
  InfoNode: TTreeNode;
  SubNode: TTreeNode;

  function AddInfoNode(Parent: TTreeNode; Caption: String; Value: Integer; ImageIndex: Integer): TTreeNode;
  var
    InfoNode: TTreeNode;
  begin
    InfoNode := tvNavigation.Items.AddChild(Parent, Caption);
    if Value >= 0 then
      InfoNode.StateIndex := Value;
    InfoNode.ImageIndex := ImageIndex;
    InfoNode.SelectedIndex := ImageIndex;

    Result := InfoNode;
  end;

begin
  Cursor := Screen.Cursor;

  Screen.Cursor := crHourglass;
  tvNavigation.Items.BeginUpdate;
  try
    tvNavigation.Items.Clear;
    RootNode := tvNavigation.Items.Add(nil, 'CarbonSoft cxCpu 4');
    RootNode.ImageIndex := cExplorerNode_Root;

    AddInfoNode(RootNode, 'Processor Count', cExplorerNode_Count, -1);
    ProcessorsNode := AddInfoNode(RootNode, 'Processors [' + cxCpu.ProcessorCount.Available.AsString + ']', cExplorerNode_NoItems, -1);

    for i := 0 to cxCpu.ProcessorCount.Available.AsNumber - 1 do
    begin
      Cpu := i * 100;

      CpuNode := AddInfoNode(ProcessorsNode, '#' + IntToStr(i) + ' ' + cxCpu[i].Name.AsString, Cpu + cExplorerNode_Processor, 0);

      InfoNode := AddInfoNode(CpuNode, 'Cpuid', cExplorerNode_NoItems, -1);
      AddInfoNode(InfoNode, 'Standard', Cpu + cExplorerNode_Cpuid + Ord(celStandard), -1);
      AddInfoNode(InfoNode, 'Extended', Cpu + cExplorerNode_Cpuid + Ord(celExtended), -1);
      AddInfoNode(InfoNode, 'Transmeta', Cpu + cExplorerNode_Cpuid + Ord(celTransmeta), -1);

      AddInfoNode(CpuNode, 'Signature', Cpu + cExplorerNode_Signature, -1);

      InfoNode := AddInfoNode(CpuNode, 'Feature Sets', cExplorerNode_NoItems, -1);
      AddInfoNode(InfoNode, 'Standard', Cpu + cExplorerNode_Features + Ord(fsStandard), -1);
      AddInfoNode(InfoNode, 'Standard (Ex)', Cpu + cExplorerNode_Features + Ord(fsStandardEx), -1);
      AddInfoNode(InfoNode, 'Extended', Cpu + cExplorerNode_Features + Ord(fsExtended), -1);
      AddInfoNode(InfoNode, 'Power', Cpu + cExplorerNode_Features + Ord(fsPowerManagement), -1);

      InfoNode := AddInfoNode(CpuNode, 'Cache', cExplorerNode_NoItems, -1);

      SubNode := AddInfoNode(InfoNode, 'Level 1', cExplorerNode_NoItems, -1);
      AddInfoNode(SubNode, 'Code', Cpu + cExplorerNode_Cache + Ord(clLevel1Code), -1);
      AddInfoNode(SubNode, 'Data', Cpu + cExplorerNode_Cache + Ord(clLevel1Data), -1);
      AddInfoNode(SubNode, 'Unified', Cpu + cExplorerNode_Cache + Ord(clLevel1Unified), -1);

      AddInfoNode(InfoNode, 'Level 2', Cpu + cExplorerNode_Cache + Ord(clLevel2), -1);
      AddInfoNode(InfoNode, 'Level 3', Cpu + cExplorerNode_Cache + Ord(clLevel3) ,-1);
      AddInfoNode(InfoNode, 'Trace', Cpu + cExplorerNode_Cache + Ord(clTrace), -1);

      AddInfoNode(CpuNode, 'Errata', Cpu + cExplorerNode_Errata, -1);

      AddInfoNode(CpuNode, 'Vendor', Cpu + cExplorerNode_Vendor, -1);
    end;
  finally
    tvNavigation.Items.EndUpdate;
    Screen.Cursor := Cursor;
  end;
end;

procedure TExplorerDialog.tvDecodeItem(Node: TTreeNode);
var
  Cpu: Byte;
  Info: Integer;
  InfoEx: Integer;
begin
  Cpu := Node.StateIndex div 100;
  if Node.StateIndex <> cExplorerNode_NoItems then
  begin
    Info := ((Node.StateIndex - (Cpu * 100)) div 10) * 10;
    InfoEx := Node.StateIndex - ((Cpu * 100) + Info);
  end
  else
  begin
    Info := cExplorerNode_NoItems;
    InfoEx := 0;
  end;
    
  case Info of
    cExplorerNode_Root:
    begin
      lvPopulate_About;
    end;
    cExplorerNode_Processor:
    begin
      lvPopulate_Cpu(cxCpu[Cpu]);
    end;
    cExplorerNode_Cpuid:
    begin
      case TCpuidExecutionLevel(InfoEx) of
        celStandard: lvPopulate_Cpuid(cxCpu[Cpu].Cpuid.Standard);
        celExtended: lvPopulate_Cpuid(cxCpu[Cpu].Cpuid.Extended);
        celTransmeta: lvPopulate_Cpuid(cxCpu[Cpu].Cpuid.Transmeta);
      end;
    end;
    cExplorerNode_Signature:
    begin
      lvPopulate_Signature(cxCpu[Cpu].Signature);
    end;
    cExplorerNode_Features:
    begin
      case TFeatureSet(InfoEx) of
        fsStandard: lvPopulate_Features(cxCpu[Cpu].Features.Standard);
        fsStandardEx: lvPopulate_Features(cxCpu[Cpu].Features.StandardEx);
        fsExtended: lvPopulate_Features(cxCpu[Cpu].Features.Extended);
        fsPowerManagement: lvPopulate_Features(cxCpu[Cpu].Features.Power);
      end;
    end;
    cExplorerNode_Cache:
    begin
      case TCacheLevel(InfoEx) of
        clLevel1Code: lvPopulate_Cache(cxCpu[Cpu].Cache.Level1.Code);
        clLevel1Data: lvPopulate_Cache(cxCpu[Cpu].Cache.Level1.Data);
        clLevel1Unified: lvPopulate_Cache(cxCpu[Cpu].Cache.Level1.Unified);
        clLevel2: lvPopulate_Cache(cxCpu[Cpu].Cache.Level2);
        clLevel3: lvPopulate_Cache(cxCpu[Cpu].Cache.Level3);
        clTrace: lvPopulate_Cache(cxCpu[Cpu].Cache.Trace);
      end;
    end;
    cExplorerNode_Errata:
    begin
      lvPopulate_Errata(cxCpu[Cpu].Errata);
    end;
    cExplorerNode_Vendor:
    begin
      lvPopulate_Vendor(cxCpu[Cpu].Vendor);
    end;
    cExplorerNode_Count:
    begin
      lvPopulate_Count;
    end;
    cExplorerNode_NoItems:
    begin
      lvPopulate_NoItems;
    end;
  else
    lvClear;
  end;
end;

function TExplorerDialog.lvUpdate: IListviewUpdate;
begin
  Result := TListviewUpdate.Create(lvInformation, True);
end;

procedure TExplorerDialog.lvClear;
var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
end;

procedure TExplorerDialog.lvAddItem(ACaption, Value: String; Image: Integer);
begin
  with lvInformation.Items.Add do
  begin
    Caption := ACaption;
    SubItems.Add(Value);
    ImageIndex := Image;
  end;
end;

procedure TExplorerDialog.lvPopulate_NoItems;
var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('No Items', 'Double-click to expand', -1);
end;

procedure TExplorerDialog.lvPopulate_About;
var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('Name', 'CarbonSoft cxCpu 4', -1);
  lvAddItem('Version', cxCpu.Version.FormatVersion, cValue_ICpuNumber);
end;

procedure TExplorerDialog.lvPopulate_Count;
var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('Available processors', cxCpu.ProcessorCount.Available.AsString, cValue_ICpuNumber);
  lvAddItem('Virtual processors', cxCpu.ProcessorCount.Logical.AsString, cValue_ICpuNumber);
end;

procedure TExplorerDialog.lvPopulate_Cpu(Info: IProcessorInformation);
var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('Name', Info.Name.AsString, cValue_String);
  lvAddItem('Speed', Info.Speed.Normalised.FormatMhz, cValue_ICpuNumber);
  if Info.Serial.Available.AsBoolean then
    lvAddItem('Serial', Info.Serial.Formatted, cValue_String);
end;

procedure TExplorerDialog.lvPopulate_Cache(Info: ICpuCache);
var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('Available', Info.Available.FormatYesNo, cValue_ICpuBoolean);
  lvAddItem('Associativity', Info.Associativity.Name, cValue_Interface);
  lvAddItem('Line Size', Info.LineSize.FormatBytes, cValue_ICpuNumber);
  lvAddItem('Size', Info.Size.FormatBytes, cValue_ICpuNumber);
end;

procedure TExplorerDialog.lvPopulate_Cpuid(Info: ICpuidInformation);
var
  Update: IListViewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('Available', Info.Available.FormatYesNo, cValue_ICpuBoolean);
  lvAddItem('Maximum command', Info.MaximumCommand.FormatHex, cValue_ICpuNumber);
end;

procedure TExplorerDialog.lvPopulate_Errata(Info: IProcessorErrata);
var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('FDiv Error', Info.FDivError.FormatYesNo, cValue_ICpuBoolean);
  lvAddItem('Duron cache', Info.DuronCache.FormatYesNo, cValue_ICpuBoolean);
end;

procedure TExplorerDialog.lvPopulate_Features(Info: ICpuFeatureSet);
var
  i: Integer;
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('Feature Set Available', Info.Available.FormatYesNo, cValue_ICpuBoolean);
  lvAddItem('Number of features', Info.Count.AsString, cValue_ICpuNumber);
  if Info.Available.AsBoolean then
    for i := 0 to 31 do
      if Info.ByIndex(i).Mnemonic <> 'RES' then
        lvAddItem(Info.ByIndex(i).Mnemonic, Info.ByIndex(i).Available.FormatYesNo, cValue_ICpuBoolean);
end;

procedure TExplorerDialog.lvPopulate_Signature(Info: IProcessorSignature);
var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('Generic', Info.Generic, cValue_String);
  lvAddItem('Type', Info.CpuType.Value.AsString, cValue_ICpuNumber);
  lvAddItem('Family', Info.Family.Value.AsString, cValue_ICpuNumber);
  lvAddItem('Model', Info.Model.Value.AsString, cValue_ICpuNumber);
  lvAddItem('Stepping', Info.Model.Value.AsString, cValue_ICpuNumber);
  lvAddItem('Brand', Info.Brand.Value.AsString, cValue_ICpuNumber);
end;

procedure TExplorerDialog.lvPopulate_Vendor(Info: IProcessorVendor);

  function FeatureSetToString(FeatureSet: TFeatureAvailability): String;
  begin
    case FeatureSet of
      faCommon: Result := 'Common';
      faIntel: Result := 'Intel';
      faAmd: Result := 'Amd';
      faCyrix: Result := 'Cyrix';
    else
      Result := 'Unknown';
    end
  end;

  function CacheDetectToString(CacheDetect: TVendorCacheDetect): String;
  begin
    case CacheDetect of
      vcdStandard: Result := 'Standard CPUID';
      vcdExtended: Result := 'Extended CPUID';
      vcdCombined: Result := 'Combined CPUID';
    else
      Result := 'Unknown';
    end;
  end;

var
  Update: IListviewUpdate;
begin
  Update := lvUpdate;
  lvAddItem('Name', Info.Name, cValue_String);
  lvAddItem('Signature', Info.Signature, cValue_String);
  lvAddItem('Feature set', FeatureSetToString(Info.FeatureStyle), cValue_Interface);
  lvAddItem('Cache detect', CacheDetectToString(Info.CacheDetect), cValue_Interface);
end;

procedure TExplorerDialog.FormCreate(Sender: TObject);
begin
  tvGenerate;
  puGenerate;
  abGenerate;
  lVersion.Caption := 'Release ' + cxCpu.Version.FormatVersion;
  Pages.ActivePageIndex := 0;
  tvNavigation.Selected := tvNavigation.Items[0];
end;

procedure TExplorerDialog.tvNavigationChange(Sender: TObject;
  Node: TTreeNode);
begin
  tvDecodeItem(Node);
end;

procedure TExplorerDialog.puGenerate;
var
  Update: IListviewUpdate;
  i: Integer;
begin
  Update := puUpdate;
  for i := 0 to cxCpu.ProcessorCount.Available.AsNumber - 1 do
    puAddItem(cxCpu[i].Name.AsString);
end;

function TExplorerDialog.puUpdate: IListviewUpdate;
begin
  Result := TListviewUpdate.Create(lvUsage, False);
end;

procedure TExplorerDialog.puAddItem(ACaption: String);
begin
  with lvUsage.Items.Add do
  begin
    Caption := IntToStr(Index);
    SubItems.Add(ACaption);
    SubItems.Add('0%');
  end;
end;

procedure TExplorerDialog.ckEnableUsageClick(Sender: TObject);
begin
  tmUsage.Enabled := ckEnableUsage.Checked;
end;

procedure TExplorerDialog.tmUsageTimer(Sender: TObject);
var
  Update: IListviewUpdate;
  i: Integer;
const
  UsageColumn = 1;
begin
  Update := puUpdate;
  for i := 0 to cxCpu.ProcessorCount.Available.AsNumber - 1 do
    lvUsage.Items[i].SubItems[UsageColumn] := cxCpu[i].Usage.Value.AsString + '%';
end;

procedure TExplorerDialog.abGenerate;
begin
end;

procedure TExplorerDialog.Button1Click(Sender: TObject);
begin
  Close;
end;

end.
