pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
e277e0985034bce89cad3984b29fbce8fa39c58b
lazarus-ccr/components/fpspreadsheet/reference/BIFFExplorer/bemain.pas

1278 lines
34 KiB
ObjectPascal
Raw Blame History

unit beMain;
{$mode objfpc}{$H+}
interface
uses
ActnList, Classes, ComCtrls, ExtCtrls, Grids, Menus, StdCtrls, SysUtils,
FileUtil, Forms, Controls, Graphics, Dialogs, Buttons, VirtualTrees,
{$ifdef USE_NEW_OLE}
fpolebasic,
{$else}
fpolestorage,
{$endif}
fpSpreadsheet,
mrumanager, beBIFFGrid, types;
type
{ Virtual tree node data }
TBiffNodeData = class
Offset: Integer;
RecordID: Integer;
RecordName: String;
RecordDescription: String;
Index: Integer;
destructor Destroy; override;
end;
{ TMainForm }
TMainForm = class(TForm)
AcFileOpen: TAction;
AcFileQuit: TAction;
AcFind: TAction;
AcFindNext: TAction;
AcFindPrev: TAction;
AcAbout: TAction;
AcFindClose: TAction;
AcNodeExpand: TAction;
AcNodeCollapse: TAction;
AcDumpToFile: TAction;
ActionList: TActionList;
BIFFTree: TVirtualStringTree;
CbFind: TComboBox;
HexGrid: TStringGrid;
ImageList: TImageList;
MainMenu: TMainMenu;
AnalysisDetails: TMemo;
MenuItem1: TMenuItem;
MenuItem3: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MnuDumpToFile: TMenuItem;
MenuItem9: TMenuItem;
MnuFind: TMenuItem;
MnuRecord: TMenuItem;
MnuFileReopen: TMenuItem;
MenuItem4: TMenuItem;
MnuHelp: TMenuItem;
MenuItem2: TMenuItem;
MnuFileQuit: TMenuItem;
MnuFileOpen: TMenuItem;
MnuFile: TMenuItem;
OpenDialog: TOpenDialog;
PageControl: TPageControl;
DetailPanel: TPanel;
HexPanel: TPanel;
FindPanel: TPanel;
SaveDialog: TSaveDialog;
SpeedButton3: TSpeedButton;
StringGrid1: TStringGrid;
TreePopupMenu: TPopupMenu;
TreePanel: TPanel;
BtnFindNext: TSpeedButton;
BtnFindPrev: TSpeedButton;
RecentFilesPopupMenu: TPopupMenu;
BtnCloseFind: TSpeedButton;
Splitter1: TSplitter;
HexSplitter: TSplitter;
AlphaGrid: TStringGrid;
HexDumpSplitter: TSplitter;
PgAnalysis: TTabSheet;
PgValues: TTabSheet;
DetailsSplitter: TSplitter;
StatusBar: TStatusBar;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ValueGrid: TStringGrid;
ToolBar: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
procedure AcAboutExecute(Sender: TObject);
procedure AcDumpToFileExecute(Sender: TObject);
procedure AcFileOpenExecute(Sender: TObject);
procedure AcFileQuitExecute(Sender: TObject);
procedure AcFindCloseExecute(Sender: TObject);
procedure AcFindExecute(Sender: TObject);
procedure AcFindNextExecute(Sender: TObject);
procedure AcFindPrevExecute(Sender: TObject);
procedure AcNodeCollapseExecute(Sender: TObject);
procedure AcNodeCollapseUpdate(Sender: TObject);
procedure AcNodeExpandExecute(Sender: TObject);
procedure AcNodeExpandUpdate(Sender: TObject);
procedure AlphaGridSelection(Sender: TObject; aCol, aRow: Integer);
procedure BIFFTreeBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
procedure BIFFTreeFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
procedure BIFFTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure BIFFTreeGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure BIFFTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
procedure BIFFTreePaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
procedure CbFindChange(Sender: TObject);
procedure CbFindKeyPress(Sender: TObject; var Key: char);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GridClick(Sender: TObject);
procedure HexGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
procedure HexGridSelection(Sender: TObject; aCol, aRow: Integer);
procedure ListViewSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure PageControlChange(Sender: TObject);
procedure ValueGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
private
MemStream: TMemoryStream;
OLEStorage: TOLEStorage;
FFileName: String;
FFormat: TsSpreadsheetFormat;
FBuffer: TBIFFBuffer;
FCurrOffset: Integer;
FXFIndex: Integer;
FFontIndex: Integer;
FFormatIndex: Integer;
FRowIndex: Integer;
FExternSheetIndex: Integer;
FLockHexDumpGrids: Integer;
FAnalysisGrid: TBIFFGrid;
FMRUMenuManager : TMRUMenuManager;
procedure AddToHistory(const AText: String);
procedure AnalysisGridDetails(Sender: TObject; ADetails: TStrings);
procedure AnalysisGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
procedure DumpToFile(const AFileName: String);
procedure ExecFind(ANext, AKeep: Boolean);
function GetNodeData(ANode: PVirtualNode): TBiffNodeData;
function GetRecType: Word;
procedure LoadFile(const AFileName: String); overload;
procedure LoadFile(const AFileName: String; AFormat: TsSpreadsheetFormat); overload;
procedure MRUMenuManagerRecentFile(Sender:TObject; const AFileName:string);
procedure PopulateAnalysisGrid;
procedure PopulateHexDump;
procedure PopulateValueGrid;
procedure ReadCmdLine;
procedure ReadFromIni;
procedure ReadFromStream(AStream: TStream);
procedure UpdateCaption;
procedure UpdateCmds;
procedure WriteToIni;
public
procedure BeforeRun;
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
uses
IniFiles, lazutf8,
fpsUtils,
beUtils, beBIFFUtils, beAbout;
const
VALUE_ROW_INDEX = 1;
VALUE_ROW_BYTE = 2;
VALUE_ROW_WORD = 3;
VALUE_ROW_DWORD = 4;
VALUE_ROW_QWORD = 5;
VALUE_ROW_DOUBLE = 6;
VALUE_ROW_ANSISTRING = 7;
VALUE_ROW_WIDESTRING = 8;
MAX_HISTORY = 16;
{ Virtual tree nodes }
type
TObjectNodeData = record
Data: TObject;
end;
PObjectNodeData = ^TObjectNodeData;
{ TBiffNodeData }
destructor TBiffNodeData.Destroy;
begin
Finalize(RecordName);
Finalize(RecordDescription);
inherited;
end;
{ TMainForm }
procedure TMainForm.AcAboutExecute(Sender: TObject);
var
F: TAboutForm;
begin
F := TAboutForm.Create(nil);
try
F.ShowModal;
finally
F.Free;
end;
end;
procedure TMainForm.AcDumpToFileExecute(Sender: TObject);
begin
if FFileName = '' then
exit;
with SaveDialog do begin
FileName := ChangeFileExt(ExtractFileName(FFileName), '') + '_dumped.txt';
if Execute then
DumpToFile(FileName);
end;
end;
procedure TMainForm.AcFileOpenExecute(Sender: TObject);
begin
with OpenDialog do begin
if Execute then LoadFile(FileName);
end;
end;
procedure TMainForm.AcFileQuitExecute(Sender: TObject);
begin
Close;
end;
procedure TMainForm.AcFindCloseExecute(Sender: TObject);
begin
AcFind.Checked := false;
FindPanel.Hide;
end;
procedure TMainForm.AcFindExecute(Sender: TObject);
begin
if AcFind.Checked then begin
FindPanel.Show;
CbFind.SetFocus;
end else begin
FindPanel.Hide;
end;
end;
procedure TMainForm.AcFindNextExecute(Sender: TObject);
begin
ExecFind(true, false);
end;
procedure TMainForm.AcFindPrevExecute(Sender: TObject);
begin
ExecFind(false, false);
end;
procedure TMainForm.AcNodeCollapseExecute(Sender: TObject);
var
node: PVirtualNode;
begin
node := BiffTree.FocusedNode;
if node <> nil then begin
if BiffTree.GetNodeLevel(node) > 0 then
node := node^.Parent;
BiffTree.Expanded[node] := false;
end;
end;
procedure TMainForm.AcNodeCollapseUpdate(Sender: TObject);
var
node: PVirtualNode;
begin
node := BiffTree.FocusedNode;
if node <> nil then begin
if BiffTree.GetNodeLevel(node) > 0 then
node := node^.Parent;
end;
AcNodeCollapse.Enabled := (node <> nil) and BiffTree.Expanded[node];
end;
procedure TMainForm.AcNodeExpandExecute(Sender: TObject);
var
node: PVirtualNode;
begin
node := BiffTree.FocusedNode;
if node <> nil then begin
if BiffTree.GetNodeLevel(node) > 0 then
node := node^.Parent;
BiffTree.Expanded[node] := true;
end;
end;
procedure TMainForm.AcNodeExpandUpdate(Sender: TObject);
var
node: PVirtualNode;
begin
node := BiffTree.FocusedNode;
if node <> nil then begin
if BiffTree.GetNodeLevel(node) > 0 then
node := node^.Parent;
end;
AcNodeExpand.Enabled := (node <> nil) and not BiffTree.Expanded[node];
end;
procedure TMainForm.AddToHistory(const AText: String);
begin
if (AText <> '') and (CbFind.Items.IndexOf(AText) = -1) then begin
CbFind.Items.Insert(0, AText);
while CbFind.Items.Count > MAX_HISTORY do
CbFind.Items.Delete(CbFind.Items.Count-1);
end;
end;
procedure TMainForm.AlphaGridSelection(Sender: TObject; aCol, aRow: Integer);
begin
if FLockHexDumpGrids > 0 then
exit;
FCurrOffset := (ARow - AlphaGrid.FixedRows)*16 + (ACol - AlphaGrid.FixedCols);
if FCurrOffset < 0 then FCurrOffset := 0;
inc(FLockHexDumpGrids);
HexGrid.Col := aCol - AlphaGrid.FixedCols + HexGrid.FixedCols;
HexGrid.Row := aRow - AlphaGrid.FixedRows + HexGrid.FixedRows;
dec(FLockHexDumpGrids);
if FCurrOffset > -1 then
Statusbar.Panels[3].Text := Format('HexViewer offset: %d', [FCurrOffset])
else
Statusbar.Panels[3].Text := '';
end;
procedure TMainForm.AnalysisGridDetails(Sender: TObject; ADetails: TStrings);
begin
AnalysisDetails.Lines.Assign(ADetails);
end;
procedure TMainForm.AnalysisGridPrepareCanvas(sender: TObject; aCol,
aRow: Integer; aState: TGridDrawState);
begin
if ARow = 0 then FAnalysisGrid.Canvas.Font.Style := [fsBold];
end;
procedure TMainForm.BeforeRun;
begin
ReadFromIni;
ReadCmdLine;
end;
procedure TMainForm.BIFFTreeBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
s: String;
begin
if (Sender.GetNodeLevel(Node) = 0) and (Column = 0) then begin
// Left-align parent nodes (column 0 is right-aligned)
BiffTreeGetText(Sender, Node, 0, ttNormal, s);
TargetCanvas.Font.Style := [fsBold];
ContentRect.Right := CellRect.Left + TargetCanvas.TextWidth(s) + 30;
end;
end;
procedure TMainForm.BIFFTreeFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
var
ptr: PObjectNodeData;
data: TBiffNodeData;
n: Word;
begin
ptr := Sender.GetNodeData(Node);
data := TBiffNodeData(ptr^.Data);
// Move to start of record + 2 bytes to skip record type ID.
MemStream.Position := PtrInt(data.Offset) + 2;
// Read size of record
n := WordLEToN(MemStream.ReadWord);
// Read record data
SetLength(FBuffer, n);
if n > 0 then
MemStream.ReadBuffer(FBuffer[0], n);
// Update user interface
if (BiffTree.FocusedNode <> nil) and (BiffTree.GetNodeLevel(BiffTree.FocusedNode) > 0)
then begin
Statusbar.Panels[0].Text := Format('Record ID: $%.4x', [data.RecordID]);
Statusbar.Panels[1].Text := data.RecordName;
Statusbar.Panels[2].Text := Format('Record size: %d bytes', [n]);
Statusbar.Panels[3].Text := '';
end else begin
Statusbar.Panels[0].Text := '';
Statusbar.Panels[1].Text := data.RecordName;
Statusbar.Panels[2].Text := '';
Statusbar.Panels[3].Text := '';
end;
PopulateHexDump;
PageControlChange(nil);
end;
procedure TMainForm.BIFFTreeFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
ptr: PObjectNodeData;
begin
ptr := BiffTree.GetNodeData(Node);
if ptr <> nil then
FreeAndNil(ptr^.Data);
end;
procedure TMainForm.BIFFTreeGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TObjectNodeData);
end;
procedure TMainForm.BIFFTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
var
ptr: PObjectNodeData;
data: TBiffNodeData;
begin
CellText := '';
ptr := Sender.GetNodeData(Node);
if ptr <> nil then begin
data := TBiffNodeData(ptr^.Data);
case Sender.GetNodeLevel(Node) of
0: if Column = 0 then
CellText := data.RecordName;
1: case Column of
0: CellText := IntToStr(data.Offset);
1: CellText := Format('$%.4x', [data.RecordID]);
2: CellText := data.RecordName;
3: if data.Index > -1 then CellText := IntToStr(data.Index);
4: CellText := data.RecordDescription;
end;
end;
end;
end;
procedure TMainForm.BIFFTreePaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
begin
// Paint parent node in bold font.
if (Sender.GetNodeLevel(Node) = 0) and (Column = 0) then
TargetCanvas.Font.Style := [fsBold];
end;
procedure TMainForm.CbFindChange(Sender: TObject);
begin
ExecFind(true, true);
end;
procedure TMainForm.CbFindKeyPress(Sender: TObject; var Key: char);
begin
if Key = #13 then
ExecFind(true, false);
end;
procedure TMainForm.DumpToFile(const AFileName: String);
var
list: TStringList;
parentnode, node: PVirtualNode;
parentdata, data: TBiffNodeData;
ptr: PObjectNodeData;
begin
list := TStringList.Create;
try
parentnode := BiffTree.GetFirst;
while parentnode <> nil do begin
ptr := BiffTree.GetNodeData(parentnode);
parentdata := TBiffNodeData(ptr^.Data);
list.Add(parentdata.RecordName);
node := BIffTree.GetFirstChild(parentnode);
while node <> nil do begin
ptr := BiffTree.GetNodeData(node);
data := TBiffNodeData(ptr^.Data);
List.Add(Format(' %.04x %s (%s)', [data.RecordID, data.RecordName, data.RecordDescription]));
node := BiffTree.GetNextSibling(node);
end;
List.Add('');
parentnode := BiffTree.GetNextSibling(parentnode);
end;
list.SaveToFile(AFileName);
finally
list.Free;
end;
end;
procedure TMainForm.ExecFind(ANext, AKeep: Boolean);
var
s: String;
node, node0: PVirtualNode;
function GetRecordname(ANode: PVirtualNode; UseLowercase: Boolean = true): String;
var
data: TBIffNodeData;
begin
data := GetNodeData(ANode);
if Assigned(data) then begin
if UseLowercase then
Result := lowercase(data.RecordName)
else
Result := data.RecordName;
end else
Result := '';
end;
function GetNextNode(ANode: PVirtualNode): PVirtualNode;
var
nextparent: PVirtualNode;
begin
Result := BiffTree.GetNextSibling(ANode);
if (Result = nil) and (ANode <> nil) then begin
nextparent := BiffTree.GetNextSibling(ANode^.Parent);
if nextparent = nil then
nextparent := BiffTree.GetFirst;
Result := BiffTree.GetFirstChild(nextparent);
end;
end;
function GetPrevNode(ANode: PVirtualNode): PVirtualNode;
var
prevparent: PVirtualNode;
begin
Result := BiffTree.GetPreviousSibling(ANode);
if (Result = nil) and (ANode <> nil) then begin
prevparent := BiffTree.GetPreviousSibling(ANode^.Parent);
if prevparent = nil then
prevparent := BiffTree.GetLast;
Result := BiffTree.GetLastChild(prevparent);
end;
end;
begin
if CbFind.Text = '' then
exit;
s := Lowercase(CbFind.Text);
node0 := BiffTree.FocusedNode;
if node0 = nil then
node0 := BiffTree.GetFirst;
if BiffTree.GetNodeLevel(node0) = 0 then
node0 := BiffTree.GetFirstChild(node0);
if ANext then begin
if AKeep
then node := node0
else node := GetNextNode(node0);
repeat
if pos(s, GetRecordname(node)) > 0 then begin
BiffTree.FocusedNode := node;
BiffTree.Selected[node] := true;
BiffTree.ScrollIntoView(node, true);
AddToHistory(GetRecordname(node, false));
exit;
end;
node := GetNextNode(node);
until (node = node0) or (node = nil);
end else begin
if AKeep
then node := node0
else node := GetPrevNode(node0);
repeat
if pos(s, GetRecordName(node)) > 0 then begin
BiffTree.FocusedNode := node;
BiffTree.Selected[node] := true;
BiffTree.ScrollIntoView(node, true);
AddToHistory(GetRecordName(node, false));
exit;
end;
node := GetPrevNode(node);
until (node = node0) or (node = nil);
end;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
if CanClose then
try
WriteToIni;
except
MessageDlg('Could not write setting to configuration file.', mtError, [mbOK], 0);
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
FMRUMenuManager := TMRUMenuManager.Create(self);
with FMRUMenuManager do begin
Name := 'MRUMenuManager';
IniFileName := GetAppConfigFile(false);
IniSection := 'RecentFiles';
MaxRecent := 16;
MenuCaptionMask := '&%x - %s'; // & --> create hotkey
MenuItem := MnuFileReopen;
PopupMenu := RecentFilesPopupMenu;
OnRecentFile := @MRUMenuManagerRecentFile;
end;
HexGrid.ColWidths[HexGrid.ColCount-1] := 5;
HexGrid.DefaultRowHeight := HexGrid.Canvas.TextHeight('Tg') + 4;
AlphaGrid.DefaultRowHeight := HexGrid.DefaultRowHeight;
ValueGrid.DefaultRowHeight := HexGrid.DefaultRowHeight;
BiffTree.DefaultNodeHeight := HexGrid.DefaultRowHeight;
BiffTree.Header.DefaultHeight := HexGrid.DefaultRowHeight + 4;
FAnalysisGrid := TBIFFGrid.Create(self);
with FAnalysisGrid do begin
Parent := PgAnalysis;
Align := alClient;
DefaultRowHeight := HexGrid.DefaultRowHeight;
Options := Options + [goDrawFocusSelected];
TitleStyle := tsNative;
OnDetails := @AnalysisGridDetails;
OnPrepareCanvas := @AnalysisGridPrepareCanvas;
end;
with ValueGrid do begin
ColCount := 3;
RowCount := VALUE_ROW_WIDESTRING+1;
Cells[0, 0] := 'Data type';
Cells[1, 0] := 'Value';
Cells[2, 0] := 'Offset range';
Cells[0, VALUE_ROW_INDEX] := 'Offset';
Cells[0, VALUE_ROW_BYTE] := 'Byte';
Cells[0, VALUE_ROW_WORD] := 'Word';
Cells[0, VALUE_ROW_DWORD] := 'DWord';
Cells[0, VALUE_ROW_QWORD] := 'QWord';
Cells[0, VALUE_ROW_DOUBLE] := 'Double';
Cells[0, VALUE_ROW_ANSISTRING] := 'AnsiString';
Cells[0, VALUE_ROW_WIDESTRING] := 'WideString';
end;
UpdateCmds;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if MemStream <> nil then
FreeAndNil(MemStream);
if OLEStorage <> nil then
FreeAndNil(OLEStorage);
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
Width := Width + 1; // remove black rectangle next to ValueGrid
Width := Width - 1;
end;
function TMainForm.GetNodeData(ANode: PVirtualNode): TBiffNodeData;
var
ptr: PObjectNodeData;
begin
result := nil;
if ANode <> nil then begin
ptr := BiffTree.GetNodeData(ANode);
if ptr <> nil then Result := TBiffNodeData(ptr^.Data);
end;
end;
function TMainForm.GetRecType: Word;
var
data: TBiffNodeData;
begin
Result := Word(-1);
if BiffTree.FocusedNode <> nil then begin
data := GetNodeData(BiffTree.FocusedNode);
if data <> nil then begin
MemStream.Position := data.Offset;
Result := WordLEToN(MemStream.ReadWord);
end;
end;
end;
procedure TMainForm.GridClick(Sender: TObject);
begin
if PageControl.ActivePage = PgValues then
PopulateValueGrid;
end;
procedure TMainForm.HexGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
var
ts: TTextStyle;
begin
ts := HexGrid.Canvas.TextStyle;
if ACol = 0 then
ts.Alignment := taRightJustify
else
ts.Alignment := taCenter;
ts.Opaque := false;
ts.Layout := tlCenter;
HexGrid.Canvas.TextStyle := ts;
ts.Alignment := taCenter;
AlphaGrid.Canvas.TextStyle := ts;
end;
procedure TMainForm.HexGridSelection(Sender: TObject; aCol, aRow: Integer);
begin
if (FLockHexDumpGrids > 0) then
exit;
FCurrOffset := (ARow - HexGrid.FixedRows)*16 + (ACol - HexGrid.FixedCols);
if FCurrOffset < 0 then
FCurrOffset := 0;
inc(FLockHexDumpGrids);
AlphaGrid.Row := aRow - HexGrid.FixedRows + AlphaGrid.FixedRows;
AlphaGrid.Col := aCol - HexGrid.FixedCols + AlphaGrid.FixedCols;
dec(FLockHexDumpGrids);
if FCurrOffset > -1 then
Statusbar.Panels[3].Text := Format('HexViewer offset: %d', [FCurrOffset])
else
Statusbar.Panels[3].Text := '';
end;
procedure TMainForm.LoadFile(const AFileName: String);
var
valid: Boolean;
excptn: Exception = nil;
begin
if not FileExistsUTF8(AFileName) then begin
MessageDlg(Format('File "%s" not found.', [AFileName]), mtError, [mbOK], 0);
exit;
end;
if Lowercase(ExtractFileExt(AFileName)) <> '.xls' then begin
MessageDlg('BIFFExplorer can only process binary Excel files (extension ".xls")',
mtError, [mbOK], 0);
exit;
end;
FFormat := sfExcel8;
while True do begin
try
LoadFile(AFileName, FFormat);
valid := True;
except
on E: Exception do begin
if FFormat = sfExcel8 then excptn := E;
valid := False
end;
end;
if valid or (FFormat = sfExcel2) then Break;
FFormat := Pred(FFormat);
end;
// A failed attempt to read a file should bring an exception, so re-raise
// the exception if necessary. We re-raise the exception brought by Excel 8,
// since this is the most common format
if (not valid) and (excptn <> nil) then
raise excptn;
end;
procedure TMainForm.LoadFile(const AFileName: String; AFormat: TsSpreadsheetFormat);
var
OLEDocument: TOLEDocument;
streamname: UTF8String;
begin
if MemStream <> nil then
FreeAndNil(MemStream);
if OLEStorage <> nil then
FreeAndNil(OLEStorage);
MemStream := TMemoryStream.Create;
if AFormat = sfExcel2 then begin
MemStream.LoadFromFile(UTF8ToSys(AFileName));
end else begin
OLEStorage := TOLEStorage.Create;
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := MemStream;
if AFormat = sfExcel8 then streamname := 'Workbook' else streamname := 'Book';
OLEStorage.ReadOLEFile(UTF8ToSys(AFileName), OLEDocument, streamname);
// Check if the operation succeded
if MemStream.Size = 0 then
raise Exception.Create('BIFF Explorer: Reading the OLE document failed');
end;
// Rewind the stream and read from it
MemStream.Position := 0;
FFileName := ExpandFileName(UTF8ToSys(AFileName));
ReadFromStream(MemStream);
FFormat := AFormat;
UpdateCaption;
FMRUMenuManager.AddToRecent(AFileName);
end;
procedure TMainForm.ListViewSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
var
n: Word;
begin
if Selected then begin
// Move to start of record + 2 bytes to skip record type ID.
MemStream.Position := PtrInt(Item.Data) + 2;
// Read size of record
n := WordLEToN(MemStream.ReadWord);
// Read record data
SetLength(FBuffer, n);
MemStream.ReadBuffer(FBuffer[0], n);
// Update user interface
Statusbar.Panels[0].Text := Format('Record ID: %s', [Item.SubItems[0]]);
Statusbar.Panels[1].Text := Item.SubItems[1];
Statusbar.Panels[2].Text := Format('Record size: %s bytes', [Item.SubItems[3]]);
PopulateHexDump;
PageControlChange(nil);
end;
end;
procedure TMainForm.MRUMenuManagerRecentFile(Sender: TObject;
const AFileName: string);
begin
LoadFile(AFileName);
end;
procedure TMainForm.PopulateAnalysisGrid;
begin
FAnalysisGrid.SetRecordType(GetRecType, FBuffer, FFormat);
end;
procedure TMainForm.PopulateHexDump;
var
n: Word;
i,r,c, w: Integer;
begin
n := Length(FBuffer);
// Prepare hex viewer rows...
r := HexGrid.FixedRows + n div 16;
if n mod 16 <> 0 then inc(r);
HexGrid.RowCount := r;
AlphaGrid.RowCount := r;
for i:=HexGrid.FixedRows to r-1 do begin
HexGrid.Rows[i].Clear;
HexGrid.Cells[0, i] := IntToStr((i - HexGrid.FixedRows)*16);
AlphaGrid.Rows[i].Clear;
end;
// ... width of first column, ...
w := HexGrid.Canvas.TextWidth(IntToStr(n)) + 4;
if w > HexGrid.DefaultColWidth then
HexGrid.ColWidths[0] := w;
// ... and cells
for i:=0 to Length(FBuffer)-1 do begin
c := i mod 16;
r := i div 16;
with HexGrid do
Cells[c+FixedCols, r+FixedRows] := Format('%.2x', [FBuffer[i]]);
with AlphaGrid do
if FBuffer[i] < 32 then
Cells[c+FixedCols, r+FixedRows] := '.'
else
Cells[c+FixedCols, r+FixedRows] := AnsiToUTF8(AnsiChar(FBuffer[i]));
end;
// Clear value grid
if PageControl.ActivePage = PgValues then
with ValueGrid do begin
Clean(1, 1, RowCount-1, ColCount-1, [gzNormal]);
end;
// Update status bar
HexGridSelection(nil, HexGrid.Col, HexGrid.Row);
end;
procedure TMainForm.PopulateValueGrid;
var
buf: array[0..1023] of Byte;
w: word absolute buf;
dw: DWord absolute buf;
qw: QWord absolute buf;
dbl: double absolute buf;
idx: Integer;
i, j: Integer;
s: String;
sw: WideString;
ls: Integer;
begin
idx := FCurrOffset;
i := ValueGrid.RowCount;
j := ValueGrid.ColCount;
ValueGrid.Cells[1, VALUE_ROW_INDEX] := IntToStr(idx);
if idx <= Length(FBuffer)-SizeOf(byte) then begin
ValueGrid.Cells[1, VALUE_ROW_BYTE] := IntToStr(FBuffer[idx]);
ValueGrid.Cells[2, VALUE_ROW_BYTE] := Format('%d ... %d', [idx, idx]);
end
else begin
ValueGrid.Cells[1, VALUE_ROW_BYTE] := '';
ValueGrid.Cells[2, VALUE_ROW_BYTE] := '';
end;
if idx <= Length(FBuffer)-SizeOf(word) then begin
buf[0] := FBuffer[idx];
buf[1] := FBuffer[idx+1];
ValueGrid.Cells[1, VALUE_ROW_WORD] := IntToStr(WordLEToN(w));
ValueGrid.Cells[2, VALUE_ROW_WORD] := Format('%d ... %d', [idx, idx+SizeOf(Word)-1]);
end else begin
ValueGrid.Cells[1, VALUE_Row_WORD] := '';
ValueGrid.Cells[2, VALUE_ROW_WORD] := '';
end;
if idx <= Length(FBuffer) - SizeOf(DWord) then begin
for i:=0 to SizeOf(DWord)-1 do buf[i] := FBuffer[idx+i];
ValueGrid.Cells[1, VALUE_ROW_DWORD] := IntToStr(DWordLEToN(dw));
ValueGrid.Cells[2, VALUE_ROW_DWORD] := Format('%d ... %d', [idx, idx+SizeOf(DWord)-1]);
end else begin
ValueGrid.Cells[1, VALUE_ROW_DWORD] := '';
ValueGrid.Cells[2, VALUE_ROW_DWORD] := '';
end;
if idx <= Length(FBuffer) - SizeOf(QWord) then begin
for i:=0 to SizeOf(QWord)-1 do buf[i] := FBuffer[idx+i];
ValueGrid.Cells[1, VALUE_ROW_QWORD] := Format('%d', [qw]);
ValueGrid.Cells[2, VALUE_ROW_QWORD] := Format('%d ... %d', [idx, idx+SizeOf(QWord)-1]);
end else begin
ValueGrid.Cells[1, VALUE_ROW_QWORD] := '';
ValueGrid.Cells[2, VALUE_ROW_QWORD] := '';
end;
if idx <= Length(FBuffer) - SizeOf(double) then begin
for i:=0 to SizeOf(double)-1 do buf[i] := FBuffer[idx+i];
ValueGrid.Cells[1, VALUE_ROW_DOUBLE] := Format('%f', [dbl]);
ValueGrid.Cells[2, VALUE_ROW_DOUBLE] := Format('%d ... %d', [idx, idx+SizeOf(Double)-1]);
end else begin
ValueGrid.Cells[1, VALUE_ROW_DOUBLE] := '';
ValueGrid.Cells[2, VALUE_ROW_DOUBLE] := '';
end;
if idx < Length(FBuffer) then begin
ls := FBuffer[idx];
SetLength(s, ls);
i := idx + 1;
j := 0;
while (i < Length(FBuffer)) and (j < Length(s)) do begin
inc(j);
s[j] := char(FBuffer[i]);
inc(i);
end;
SetLength(s, j);
ValueGrid.Cells[1, VALUE_ROW_ANSISTRING] := s;
ValueGrid.Cells[2, VALUE_ROW_ANSISTRING] := Format('%d ... %d', [idx, ls * SizeOf(char) + 1]);
end else begin
ValueGrid.Cells[1, VALUE_ROW_ANSISTRING] := '';
ValueGrid.Cells[2, VALUE_ROW_ANSISTRING] := '';
end;
if idx < Length(FBuffer) then begin
ls := FBuffer[idx];
SetLength(sw, ls);
j := 0;
i := idx + 2;
while (i < Length(FBuffer)-1) and (j < Length(sw)) do begin
buf[0] := FBuffer[i];
buf[1] := FBuffer[i+1];
inc(i, SizeOf(WideChar));
inc(j);
sw[j] := WideChar(w);
end;
SetLength(sw, j);
ValueGrid.Cells[1, VALUE_ROW_WIDESTRING] := UTF8Decode(sw);
ValueGrid.Cells[2, VALUE_ROW_WIDESTRING] := Format('%d ... %d', [idx, idx + ls*SizeOf(wideChar)+1]);
end else begin
ValueGrid.Cells[1, VALUE_ROW_WIDESTRING] := '';
ValueGrid.Cells[2, VALUE_ROW_WIDESTRING] := '';
end;
end;
procedure TMainForm.ReadCmdLine;
begin
if ParamCount > 0 then
LoadFile(ParamStr(1));
end;
procedure TMainForm.ReadFromIni;
var
ini: TCustomIniFile;
i: Integer;
begin
ini := CreateIni;
try
ReadFormFromIni(ini, 'MainForm', self);
TreePanel.Width := ini.ReadInteger('MainForm', 'RecordList_Width', TreePanel.Width);
for i:=0 to BiffTree.Header.Columns.Count-1 do
BiffTree.Header.Columns[i].Width := ini.ReadInteger('MainForm',
Format('RecordList_ColWidth_%d', [i+1]), BiffTree.Header.Columns[i].Width);
ValueGrid.Height := ini.ReadInteger('MainForm', 'ValueGrid_Height', ValueGrid.Height);
for i:=0 to ValueGrid.ColCount-1 do
ValueGrid.ColWidths[i] := ini.ReadInteger('MainForm',
Format('ValueGrid_ColWidth_%d', [i+1]), ValueGrid.ColWidths[i]);
AlphaGrid.Height := ini.ReadInteger('MainForm', 'AlphaGrid_Height', AlphaGrid.Height);
for i:=0 to AlphaGrid.ColCount-1 do
AlphaGrid.ColWidths[i] := ini.ReadInteger('MainForm',
Format('AlphaGrid_ColWidth_%d', [i+1]), AlphaGrid.ColWidths[i]);
for i:=0 to FAnalysisGrid.ColCount-1 do
FAnalysisGrid.ColWidths[i] := ini.ReadInteger('MainForm',
Format('AnalysisGrid_ColWidth_%d', [i+1]), FAnalysisGrid.ColWidths[i]);
AnalysisDetails.Height := ini.ReadInteger('MainForm', 'AnalysisDetails_Height', AnalysisDetails.Height);
PageControl.ActivePageIndex := ini.ReadInteger('MainForm', 'PageIndex', PageControl.ActivePageIndex);
finally
ini.Free;
end;
end;
procedure TMainForm.ReadFromStream(AStream: TStream);
var
recType: Word;
recSize: Word;
p: Cardinal;
p0: Cardinal;
s: String;
i: Integer;
node: PVirtualNode;
parentnode: PVirtualNode;
ptr: PObjectNodeData;
parentdata, data: TBiffNodeData;
w: word;
crs: TCursor;
begin
crs := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
BiffTree.Clear;
parentnode := nil;
FXFIndex := -1;
FFontIndex := -1;
FFormatIndex := -1;
FRowIndex := -1;
FExternSheetIndex := 0; // 1-based!
AStream.Position := 0;
while AStream.Position < AStream.Size do begin
p := AStream.Position;
recType := WordLEToN(AStream.ReadWord);
recSize := WordLEToN(AStream.ReadWord);
if (recType = 0) and (recSize = 0) then
break;
s := RecTypeName(recType);
i := pos(':', s);
// in case of BOF record: create new parent node for this substream
if (recType = $0009) or (recType = $0209) or (recType = $0409) or (recType = $0809)
then begin
// Read info on substream beginning here
p0 := AStream.Position;
AStream.Position := AStream.Position + 2;
w := WordLEToN(AStream.ReadWord);
AStream.Position := p0;
parentdata := TBiffNodeData.Create;
parentdata.Offset := p;
parentdata.Recordname := BOFName(w);
// add parent node for this substream
parentnode := BIFFTree.AddChild(nil);
ptr := BIFFTree.GetNodeData(parentnode);
ptr^.Data := parentdata;
FRowIndex := -1;
end;
// add node to parent node
data := TBiffNodeData.Create;
data.Offset := p;
data.RecordID := recType;
if i > 0 then begin
data.RecordName := copy(s, 1, i-1);
data.RecordDescription := copy(s, i+2, Length(s));
end else begin
data.RecordName := s;
data.RecordDescription := '';
end;
case recType of
$0008, $0208: // Row
begin
inc(FRowIndex);
data.Index := FRowIndex;
end;
$0031, $0231: // Font record
begin
inc(FFontIndex);
data.Index := FFontIndex;
end;
$0043, $00E0: // XF record
begin
inc(FXFIndex);
data.Index := FXFIndex;
end;
$0017: // EXTERNSHEET record
if FFormat < sfExcel8 then begin
inc(FExternSheetIndex);
data.Index := FExternSheetIndex;
end;
$001E, $041E: // Format record
begin
inc(FFormatIndex);
data.Index := FFormatIndex;
end;
else
data.Index := -1;
end;
node := BIFFTree.AddChild(parentnode);
ptr := BIFFTree.GetNodeData(node);
ptr^.Data := data;
// advance stream pointer
AStream.Position := AStream.Position + recSize;
end;
// expand all parent nodes
node := BiffTree.GetFirst;
while node <> nil do begin
BiffTree.Expanded[node] := true;
node := BiffTree.GetNextSibling(node);
end;
// Select first node
BiffTree.FocusedNode := BiffTree.GetFirst;
BiffTree.Selected[BiffTree.FocusedNode] := true;
UpdateCmds;
finally
Screen.Cursor := crs;
end;
end;
procedure TMainForm.PageControlChange(Sender: TObject);
begin
if PageControl.ActivePage = PgAnalysis then
PopulateAnalysisGrid
else
if PageControl.ActivePage = PgValues then
PopulateValueGrid;
end;
procedure TMainForm.UpdateCaption;
begin
if FFileName = '' then
Caption := 'BIFF Explorer - (no file loaded)'
else
Caption := Format('BIFF Explorer - "%s [%s]', [
FFileName,
GetFileFormatName(FFormat)
]);
end;
procedure TMainForm.UpdateCmds;
begin
AcDumpToFile.Enabled := FFileName <> '';
AcFind.Enabled := FFileName <> '';
end;
procedure TMainForm.ValueGridPrepareCanvas(sender: TObject; aCol,
aRow: Integer; aState: TGridDrawState);
begin
if ARow = 0 then ValueGrid.Canvas.Font.Style := [fsBold];
end;
procedure TMainForm.WriteToIni;
var
ini: TCustomIniFile;
i: Integer;
begin
ini := CreateIni;
try
WriteFormToIni(ini, 'MainForm', self);
ini.WriteInteger('MainForm', 'RecordList_Width', TreePanel.Width);
for i:=0 to BiffTree.Header.Columns.Count-1 do
ini.WriteInteger('MainForm', Format('RecordList_ColWidth_%d', [i+1]), BiffTree.Header.Columns[i].Width);
ini.WriteInteger('MainForm', 'ValueGrid_Height', ValueGrid.Height);
for i:=0 to ValueGrid.ColCount-1 do
ini.WriteInteger('MainForm', Format('ValueGrid_ColWidth_%d', [i+1]), ValueGrid.ColWidths[i]);
ini.WriteInteger('MainForm', 'AlphaGrid_Width', AlphaGrid.Width);
for i:=0 to AlphaGrid.ColCount-1 do
ini.WriteInteger('MainForm', Format('AlphaGrid_ColWidth_%d', [i+1]), AlphaGrid.ColWidths[i]);
for i:=0 to FAnalysisGrid.ColCount-1 do
ini.WriteInteger('MainForm', Format('AnalysisGrid_ColWidth_%d', [i+1]), FAnalysisGrid.ColWidths[i]);
ini.WriteInteger('MainForm', 'AnalysisDetails_Height', AnalysisDetails.Height);
ini.WriteInteger('MainForm', 'PageIndex', PageControl.ActivePageIndex);
finally
ini.Free;
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink