main.pas

一个很不错的系统信息控件

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, ExtCtrls, Menus, MSI_SMBIOS, ComCtrls, AppEvnts, MSI_DMA, StdCtrls,
  MSI_Common;

type
  TLastSearchMethod = (smSequence, smText);

  TappRBE = class(TForm)
    MainMenu: TMainMenu;
    GridPanel: TPanel;
    sghex: TStringGrid;
    sgchar: TStringGrid;
    BottomPanel: TPanel;
    Panel29: TPanel;
    lvTables: TListView;
    stPanel: TPanel;
    Panel5: TPanel;
    Panel4: TPanel;
    sgVals: TStringGrid;
    File1: TMenuItem;
    mmSave: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    GotoAddress1: TMenuItem;
    mmOpen: TMenuItem;
    ReloadLocalMemory1: TMenuItem;
    N3: TMenuItem;
    Search1: TMenuItem;
    N2: TMenuItem;
    mmFindText: TMenuItem;
    Findnext1: TMenuItem;
    About1: TMenuItem;
    fd: TFindDialog;
    sb: TStatusBar;
    N4: TMenuItem;
    Details1: TMenuItem;
    N5: TMenuItem;
    mmFindSeq: TMenuItem;
    N6: TMenuItem;
    mmXML: TMenuItem;
    od: TOpenDialog;
    ed: TSaveDialog;
    SMBIOS: TMiTeC_SMBIOS;
    sd: TSaveDialog;
    procedure sghexSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure sgcharSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure lvTablesDblClick(Sender: TObject);
    procedure sgValsDblClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure GotoAddress1Click(Sender: TObject);
    procedure ReloadLocalMemory1Click(Sender: TObject);
    procedure sgEnter(Sender: TObject);
    procedure sgExit(Sender: TObject);
    procedure lvTablesEnter(Sender: TObject);
    procedure lvTablesExit(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure mmFindTextClick(Sender: TObject);
    procedure fdFind(Sender: TObject);
    procedure Findnext1Click(Sender: TObject);
    procedure fdShow(Sender: TObject);
    procedure sghexTopLeftChanged(Sender: TObject);
    procedure sgcharTopLeftChanged(Sender: TObject);
    procedure sghexKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure sgcharKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Details1Click(Sender: TObject);
    procedure mmFindSeqClick(Sender: TObject);
    procedure mmXMLClick(Sender: TObject);
    procedure cmSaveDump(Sender: TObject);
    procedure mmOpenClick(Sender: TObject);
  private
    CurrentAddress, StartAddress, Size: DWORD;
    LastSearchmethod: TLastSearchmethod;
    procedure FindSeq;
    procedure ReadData(AWidth: Byte = 16);
    procedure Compute(cp: DWORD);
    procedure GotoAddress(a: DWORD);
  public

  end;

var
  appRBE: TappRBE;
const
  extDMP = '.dmp';
  extBIOS = '.bios';
  extSMBIOS = '.smbios';

implementation

uses ShellAPI, FileCtrl, MiTeC_Dialogs, Details, MiTeC_Routines;

var
  Sequence: string;

{$R *.DFM}

procedure TappRBE.Compute;
const
  vs = 5;
var
  ix :array[0..7] of int64;
  i :integer;
  i64: Int64;
  f64: Double absolute i64;
begin
  sgVals.Cells[1,vs-1]:=IntToHex(cp,8);

  for i:=0 to high(ix) do
    if cp+i<=StartAddress+Size then
      ix[i]:=SMBIOS.SMBIOS_DMA.ByteValue[cp+i]
    else
      ix[i]:=0;

  sgVals.Cells[1,vs+0]:=Format('%d (%x)',[shortint(ix[0]),shortint(ix[0])]);
  sgVals.Cells[1,vs+2]:=Format('%d (%x)',[smallint(ix[0]+ix[1]*256),smallint(ix[0]+ix[1]*256)]);
  sgVals.Cells[1,vs+4]:=Format('%d (%x)',[longint(ix[0]+ix[1]*256)+(ix[2]+ix[3]*256)*65536,longint(ix[0]+ix[1]*256)+(ix[2]+ix[3]*256)*65536]);
  i64:=int64(ix[0]+ix[1]*256)+(ix[2]+ix[3]*256)*65536+((ix[4]+ix[5]*256)+(ix[6]+ix[7]*256)*65536)*4294967296;
  sgVals.Cells[1,vs+6]:=IntToStr(i64);

  sgVals.Cells[1,vs+1]:=Format('%d (%x)',[byte(ix[0]),byte(ix[0])]);
  sgVals.Cells[1,vs+3]:=Format('%d (%x)',[word(ix[0]+ix[1]*256),word(ix[0]+ix[1]*256)]);
  sgVals.Cells[1,vs+5]:=Format('%d (%x)',[longword(ix[0]+ix[1]*256)+(ix[2]+ix[3]*256)*65536,longword(ix[0]+ix[1]*256)+(ix[2]+ix[3]*256)*65536]);
  sgVals.Cells[1,vs+7]:=FloatToStr(f64);
end;

procedure TappRBE.sghexSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  if (Sender=nil) or twincontrol(sender).Focused then begin
    if not(goRangeSelect in sgHex.Options) then begin
      sgchar.row:=arow;
      sgchar.col:=acol-1;
    end;
    CurrentAddress:=(sghex.ColCount-1)*(ARow-1)+(ACol-1)+StartAddress;
    Compute(CurrentAddress);
  end;
end;

procedure TappRBE.sgcharSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  if (sender=nil) or twincontrol(sender).Focused then begin
    if not(goRangeSelect in sgHex.Options) then begin
      sghex.row:=arow;
      sghex.col:=acol+1;
    end;
    CurrentAddress:=(sghex.ColCount-1)*(ARow-1)+(ACol)+StartAddress;
    Compute(CurrentAddress);
  end;
end;

procedure TappRBE.ReadData;
var
  i,j: Integer;
  b: Byte;
begin
  sghex.Hide;
  sgchar.Hide;
  Update;
  try
  sghex.row:=1;
  sghex.rowcount:=2;
  sghex.colwidths[0]:=65;
  sghex.colcount:=AWidth+1;
  sgchar.colcount:=sghex.colcount-1;
  sgchar.rowcount:=sghex.RowCount;
  for i:=1 to AWidth do begin
    sghex.cells[i,0]:=inttohex(i-1,2);
    sgchar.cells[i-1,0]:=inttohex(i-1,1);
  end;
  j:=1;
  for i:=StartAddress to StartAddress+Size do begin
    if j>AWidth then begin
      sghex.cells[0,sghex.row]:=IntToHex(i-AWidth,8);
      sghex.rowcount:=sghex.rowcount+1;
      sgchar.rowcount:=sghex.rowcount;
      sghex.row:=sghex.row+1;
      sghex.cells[0,sghex.row]:=IntToHex(i,8);
      j:=1;
    end;
    b:=SMBIOS.SMBIOS_DMA.ByteValue[i];
    sghex.cells[j,sghex.row]:=Format('%2.2x',[b]);
    if b in [0..31, 127..255] then
      sgchar.cells[j-1,sghex.row]:='.'
    else
      sgchar.cells[j-1,sghex.row]:=Chr(b);
    inc(j);
  end;

  sgVals.Cells[1,0]:=Format('%s (%s)',[SMBIOS.Version,SMBIOS.Revision]);
  sgVals.Cells[1,1]:=Format('%8.8x',[SMBIOS.SMBIOSAddress]);
  sgVals.Cells[1,2]:=Format('%8.8x',[SMBIOS.StructStart]);
  sgVals.Cells[1,3]:=Format('%d',[SMBIOS.StructLength]);

  stPanel.Caption:=Format('  Structure Tables (%d from %d found)',[Length(SMBIOS.StructTables),SMBIOS.StructCount]);
  lvTables.Items.Clear;
  for i:=0 to High(SMBIOS.StructTables) do
    with lvTables.Items.Add do begin
      Caption:=Format('Type %d: %s',[SMBIOS.StructTables[i].Indicator,SMBIOS.StructTables[i].Name]);
      SubItems.Add(Format('%d',[SMBIOS.StructTables[i].Length]));
      SubItems.Add(Format('%4.4x',[SMBIOS.StructTables[i].Handle]));
      SubItems.Add(Format('%8.8x',[SMBIOS.StructTables[i].Address]));
      ImageIndex:=-1;
    end;
  finally
    sghex.Show;
    sgchar.Show;
    Caption:=Format('%s - [%s %s %s]',[Application.Title,Trim(SMBIOS.SystemModel),Trim(SMBIOS.BIOSVendor),Trim(SMBIOS.BIOSVersion)]);
    sb.Panels[0].Text:=Format('BIOS size: %d K',[SMBIOS.BIOSSize]);
    sb.Panels[1].Text:=Format('BIOS date: %s',[SMBIOS.BIOSDate]);
  end;
  sghex.Col:=1;
  sghex.Row:=1;
end;

procedure TappRBE.FormCreate(Sender: TObject);
begin
  LastSearchmethod:=smText;
  CurrentAddress:=RomBiosDumpBase;
  sgVals.ColWidths[0]:=90;
  sgVals.ColWidths[1]:=135;
  sgVals.Cells[0,0]:='SMBIOS Version';
  sgVals.Cells[0,1]:='SMBIOS Address';
  sgVals.Cells[0,2]:='Structure Address';
  sgVals.Cells[0,3]:='Structure Length';
  sgVals.Cells[0,4]:='Cursor Address';
  sgVals.Cells[0,5]:='Signed 8-bit';
  sgVals.Cells[0,6]:='Unsigned 8-bit';
  sgVals.Cells[0,7]:='Signed 16-bit';
  sgVals.Cells[0,8]:='Unsigned 16-bit';
  sgVals.Cells[0,9]:='Signed 32-bit';
  sgVals.Cells[0,10]:='Unsigned 32-bit';
  sgVals.Cells[0,11]:='Signed 64-bit';
  sgVals.Cells[0,12]:='Float 64-bit';
  try
    SMBIOS.RefreshData;
    StartAddress:=SMBIOS.SMBIOS_DMA.StartAddress;
    Size:=SMBIOS.SMBIOS_DMA.MemorySize;
  finally
    ReadData;
  end;
end;

procedure TappRBE.lvTablesDblClick(Sender: TObject);
begin
  if Assigned(lvTables.Selected) then begin
    GotoAddress(StrToInt('$'+lvTables.Selected.SubItems[2]));
    //ReadData;
  end;
end;

procedure TappRBE.GotoAddress(a: DWORD);
var
  b: Boolean;
begin
  try
    a:=a-StartAddress;
    sgHex.Row:=a div (sghex.ColCount-1)+1;
    sghex.Col:=a mod (sghex.ColCount-1)+1;
    sghexSelectCell(nil,sghex.Col,sgHex.Row,b);
    sghex.SetFocus;
  except
    MessageDlg(Format('Invalid address [%x]',[a+StartAddress]),mtError,[mbOK],0);
  end;
end;

procedure TappRBE.sgValsDblClick(Sender: TObject);
begin
  if sgVals.Row=1 then
    GotoAddress(SMBIOS.SMBIOSAddress)
  else
    if sgVals.Row=2 then
      GotoAddress(SMBIOS.StructStart)
    else
      if sgVals.Row=10 then
        GotoAddress(SMBIOS.SMBIOS_DMA.DWORDValue[CurrentAddress])
end;

procedure TappRBE.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TappRBE.GotoAddress1Click(Sender: TObject);
var
  s: string;
begin
  if InputQuery('Go to Adress...','Hex address',s) then
    GotoAddress(StrToInt('$'+s));
end;

procedure TappRBE.ReloadLocalMemory1Click(Sender: TObject);
begin
  try
    SMBIOS.ReadLocalMemory:=True;
    SMBIOS.RefreshData;
    StartAddress:=SMBIOS.SMBIOS_DMA.StartAddress;
    Size:=SMBIOS.SMBIOS_DMA.MemorySize;
  finally
    ReadData;
  end;
end;

procedure TappRBE.sgEnter(Sender: TObject);
begin
  TStringGrid(Sender).Color:=clInfoBk;
end;

procedure TappRBE.sgExit(Sender: TObject);
begin
  TStringGrid(Sender).Color:=clWhite;
end;

procedure TappRBE.lvTablesEnter(Sender: TObject);
begin
  TListView(Sender).Color:=clInfoBk;
end;

procedure TappRBE.lvTablesExit(Sender: TObject);
begin
  TListView(Sender).Color:=clWhite;
end;