pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Add option to BIFFExplorer to dump main info on biff records (record id, description) to a text file

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3231 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-24 13:58:14 +00:00
parent bc0575cd77
commit e79bc4bb09
2 changed files with 102 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
components/fpspreadsheet/reference/BIFFExplorer/bemain.lfm
View File

@ -4,7 +4,7 @@ object MainForm: TMainForm
Top = 177 Top = 177
Width = 1089 Width = 1089
Caption = 'BIFF Explorer' Caption = 'BIFF Explorer'
ClientHeight = 556 ClientHeight = 551
ClientWidth = 1089 ClientWidth = 1089
Menu = MainMenu Menu = MainMenu
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
@ -12,10 +12,10 @@ object MainForm: TMainForm
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnShow = FormShow OnShow = FormShow
ShowHint = True ShowHint = True
LCLVersion = '1.3' LCLVersion = '1.2.4.0'
object Splitter1: TSplitter object Splitter1: TSplitter
Left = 419 Left = 419
Height = 507 Height = 497
Top = 26 Top = 26
Width = 5 Width = 5
end end
@ -54,17 +54,17 @@ object MainForm: TMainForm
end end
object DetailPanel: TPanel object DetailPanel: TPanel
Left = 424 Left = 424
Height = 507 Height = 497
Top = 26 Top = 26
Width = 665 Width = 665
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 507 ClientHeight = 497
ClientWidth = 665 ClientWidth = 665
TabOrder = 2 TabOrder = 2
object PageControl: TPageControl object PageControl: TPageControl
Left = 0 Left = 0
Height = 507 Height = 497
Top = 0 Top = 0
Width = 665 Width = 665
ActivePage = PgValues ActivePage = PgValues
@ -104,12 +104,12 @@ object MainForm: TMainForm
end end
object PgValues: TTabSheet object PgValues: TTabSheet
Caption = 'Values' Caption = 'Values'
ClientHeight = 479 ClientHeight = 464
ClientWidth = 657 ClientWidth = 657
object ValueGrid: TStringGrid object ValueGrid: TStringGrid
Left = 0 Left = 0
Height = 158 Height = 158
Top = 321 Top = 306
Width = 657 Width = 657
Align = alBottom Align = alBottom
ColCount = 3 ColCount = 3
@ -140,17 +140,17 @@ object MainForm: TMainForm
end end
object HexPanel: TPanel object HexPanel: TPanel
Left = 0 Left = 0
Height = 316 Height = 301
Top = 0 Top = 0
Width = 657 Width = 657
Align = alClient Align = alClient
Caption = 'HexPanel' Caption = 'HexPanel'
ClientHeight = 316 ClientHeight = 301
ClientWidth = 657 ClientWidth = 657
TabOrder = 1 TabOrder = 1
object HexGrid: TStringGrid object HexGrid: TStringGrid
Left = 1 Left = 1
Height = 314 Height = 299
Top = 1 Top = 1
Width = 390 Width = 390
Align = alClient Align = alClient
@ -238,7 +238,7 @@ object MainForm: TMainForm
end end
object AlphaGrid: TStringGrid object AlphaGrid: TStringGrid
Left = 396 Left = 396
Height = 314 Height = 299
Top = 1 Top = 1
Width = 260 Width = 260
Align = alRight Align = alRight
@ -323,7 +323,7 @@ object MainForm: TMainForm
end end
object HexDumpSplitter: TSplitter object HexDumpSplitter: TSplitter
Left = 391 Left = 391
Height = 314 Height = 299
Top = 1 Top = 1
Width = 5 Width = 5
Align = alRight Align = alRight
@ -334,7 +334,7 @@ object MainForm: TMainForm
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 316 Top = 301
Width = 657 Width = 657
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
@ -344,19 +344,19 @@ object MainForm: TMainForm
end end
object TreePanel: TPanel object TreePanel: TPanel
Left = 0 Left = 0
Height = 507 Height = 497
Top = 26 Top = 26
Width = 419 Width = 419
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 507 ClientHeight = 497
ClientWidth = 419 ClientWidth = 419
Constraints.MinWidth = 275 Constraints.MinWidth = 275
TabOrder = 3 TabOrder = 3
object FindPanel: TPanel object FindPanel: TPanel
Left = 0 Left = 0
Height = 36 Height = 36
Top = 471 Top = 461
Width = 419 Width = 419
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -498,10 +498,10 @@ object MainForm: TMainForm
end end
object CbFind: TComboBox object CbFind: TComboBox
Left = 28 Left = 28
Height = 23 Height = 28
Top = 5 Top = 5
Width = 183 Width = 183
ItemHeight = 15 ItemHeight = 20
OnChange = CbFindChange OnChange = CbFindChange
OnKeyPress = CbFindKeyPress OnKeyPress = CbFindKeyPress
TabOrder = 0 TabOrder = 0
@ -509,7 +509,7 @@ object MainForm: TMainForm
end end
object BIFFTree: TVirtualStringTree object BIFFTree: TVirtualStringTree
Left = 0 Left = 0
Height = 471 Height = 461
Top = 0 Top = 0
Width = 419 Width = 419
Align = alClient Align = alClient
@ -571,8 +571,8 @@ object MainForm: TMainForm
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 23 Height = 28
Top = 533 Top = 523
Width = 1089 Width = 1089
Panels = < Panels = <
item item
@ -932,6 +932,12 @@ object MainForm: TMainForm
object MnuFileReopen: TMenuItem object MnuFileReopen: TMenuItem
Caption = 'Recently opened files' Caption = 'Recently opened files'
end end
object MenuItem9: TMenuItem
Caption = '-'
end
object MnuDumpToFile: TMenuItem
Action = AcDumpToFile
end
object MenuItem4: TMenuItem object MenuItem4: TMenuItem
Caption = '-' Caption = '-'
end end
@ -1118,6 +1124,10 @@ object MainForm: TMainForm
OnExecute = AcNodeCollapseExecute OnExecute = AcNodeCollapseExecute
OnUpdate = AcNodeCollapseUpdate OnUpdate = AcNodeCollapseUpdate
end end
object AcDumpToFile: TAction
Caption = 'Dump to text file'
OnExecute = AcDumpToFileExecute
end
end end
object OpenDialog: TOpenDialog object OpenDialog: TOpenDialog
DefaultExt = '.xls' DefaultExt = '.xls'
@ -1258,4 +1268,10 @@ object MainForm: TMainForm
} }
end end
end end
object SaveDialog: TSaveDialog
DefaultExt = '.txt'
Filter = 'Text files (*.txt)|*.txt'
left = 289
top = 296
end
end end

64
components/fpspreadsheet/reference/BIFFExplorer/bemain.pas
View File

@ -38,6 +38,7 @@ type
AcFindClose: TAction; AcFindClose: TAction;
AcNodeExpand: TAction; AcNodeExpand: TAction;
AcNodeCollapse: TAction; AcNodeCollapse: TAction;
AcDumpToFile: TAction;
ActionList: TActionList; ActionList: TActionList;
BIFFTree: TVirtualStringTree; BIFFTree: TVirtualStringTree;
CbFind: TComboBox; CbFind: TComboBox;
@ -50,6 +51,8 @@ type
MenuItem5: TMenuItem; MenuItem5: TMenuItem;
MenuItem6: TMenuItem; MenuItem6: TMenuItem;
MenuItem7: TMenuItem; MenuItem7: TMenuItem;
MnuDumpToFile: TMenuItem;
MenuItem9: TMenuItem;
MnuFind: TMenuItem; MnuFind: TMenuItem;
MnuRecord: TMenuItem; MnuRecord: TMenuItem;
MnuFileReopen: TMenuItem; MnuFileReopen: TMenuItem;
@ -64,6 +67,8 @@ type
DetailPanel: TPanel; DetailPanel: TPanel;
HexPanel: TPanel; HexPanel: TPanel;
FindPanel: TPanel; FindPanel: TPanel;
SaveDialog: TSaveDialog;
SpeedButton3: TSpeedButton;
TreePopupMenu: TPopupMenu; TreePopupMenu: TPopupMenu;
TreePanel: TPanel; TreePanel: TPanel;
BtnFindNext: TSpeedButton; BtnFindNext: TSpeedButton;
@ -85,6 +90,7 @@ type
ToolButton1: TToolButton; ToolButton1: TToolButton;
ToolButton2: TToolButton; ToolButton2: TToolButton;
procedure AcAboutExecute(Sender: TObject); procedure AcAboutExecute(Sender: TObject);
procedure AcDumpToFileExecute(Sender: TObject);
procedure AcFileOpenExecute(Sender: TObject); procedure AcFileOpenExecute(Sender: TObject);
procedure AcFileQuitExecute(Sender: TObject); procedure AcFileQuitExecute(Sender: TObject);
procedure AcFindCloseExecute(Sender: TObject); procedure AcFindCloseExecute(Sender: TObject);
@ -143,6 +149,7 @@ type
procedure AnalysisGridDetails(Sender: TObject; ADetails: TStrings); procedure AnalysisGridDetails(Sender: TObject; ADetails: TStrings);
procedure AnalysisGridPrepareCanvas(sender: TObject; aCol, aRow: Integer; procedure AnalysisGridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState); aState: TGridDrawState);
procedure DumpToFile(const AFileName: String);
procedure ExecFind(ANext, AKeep: Boolean); procedure ExecFind(ANext, AKeep: Boolean);
function GetNodeData(ANode: PVirtualNode): TBiffNodeData; function GetNodeData(ANode: PVirtualNode): TBiffNodeData;
function GetRecType: Word; function GetRecType: Word;
@ -156,6 +163,7 @@ type
procedure ReadFromIni; procedure ReadFromIni;
procedure ReadFromStream(AStream: TStream); procedure ReadFromStream(AStream: TStream);
procedure UpdateCaption; procedure UpdateCaption;
procedure UpdateCmds;
procedure WriteToIni; procedure WriteToIni;
public public
@ -220,6 +228,19 @@ begin
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); procedure TMainForm.AcFileOpenExecute(Sender: TObject);
begin begin
with OpenDialog do begin with OpenDialog do begin
@ -482,6 +503,38 @@ begin
end; 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); procedure TMainForm.ExecFind(ANext, AKeep: Boolean);
var var
s: String; s: String;
@ -628,6 +681,8 @@ begin
Cells[0, VALUE_ROW_ANSISTRING] := 'AnsiString'; Cells[0, VALUE_ROW_ANSISTRING] := 'AnsiString';
Cells[0, VALUE_ROW_WIDESTRING] := 'WideString'; Cells[0, VALUE_ROW_WIDESTRING] := 'WideString';
end; end;
UpdateCmds;
end; end;
@ -1134,6 +1189,8 @@ begin
BiffTree.FocusedNode := BiffTree.GetFirst; BiffTree.FocusedNode := BiffTree.GetFirst;
BiffTree.Selected[BiffTree.FocusedNode] := true; BiffTree.Selected[BiffTree.FocusedNode] := true;
UpdateCmds;
finally finally
Screen.Cursor := crs; Screen.Cursor := crs;
end; end;
@ -1162,6 +1219,13 @@ begin
end; end;
procedure TMainForm.UpdateCmds;
begin
AcDumpToFile.Enabled := FFileName <> '';
AcFind.Enabled := FFileName <> '';
end;
procedure TMainForm.ValueGridPrepareCanvas(sender: TObject; aCol, procedure TMainForm.ValueGridPrepareCanvas(sender: TObject; aCol,
aRow: Integer; aState: TGridDrawState); aRow: Integer; aState: TGridDrawState);
begin begin