summaryrefslogtreecommitdiff
path: root/docview/src/docdump
diff options
context:
space:
mode:
Diffstat (limited to 'docview/src/docdump')
-rw-r--r--docview/src/docdump/docdump.lpi114
-rw-r--r--docview/src/docdump/docdump.lpr98
-rw-r--r--docview/src/docdump/filestreamhelper.pas35
-rw-r--r--docview/src/docdump/iterator_impl.pas480
-rw-r--r--docview/src/docdump/iterator_intf.pas169
-rw-r--r--docview/src/docdump/readcontrols.pas44
-rw-r--r--docview/src/docdump/readextfiles.pas53
-rw-r--r--docview/src/docdump/readfonts.pas47
-rw-r--r--docview/src/docdump/readheader.pas135
-rw-r--r--docview/src/docdump/readnlsdata.pas31
-rw-r--r--docview/src/docdump/readstrings.pas56
-rw-r--r--docview/src/docdump/readtoc.pas171
-rw-r--r--docview/src/docdump/u_Tools.pas52
13 files changed, 1485 insertions, 0 deletions
diff --git a/docview/src/docdump/docdump.lpi b/docview/src/docdump/docdump.lpi
new file mode 100644
index 00000000..440c482c
--- /dev/null
+++ b/docview/src/docdump/docdump.lpi
@@ -0,0 +1,114 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="7"/>
+ <General>
+ <SessionStorage Value="InIDEConfig"/>
+ <MainUnit Value="0"/>
+ <TargetFileExt Value=""/>
+ <UseAppBundle Value="False"/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <Units Count="15">
+ <Unit0>
+ <Filename Value="docdump.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="docdump"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="../IPFEscapeCodes.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="IPFEscapeCodes"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="../IPFFileFormatUnit.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="IPFFileFormatUnit"/>
+ </Unit2>
+ <Unit3>
+ <Filename Value="readheader.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="readheader"/>
+ </Unit3>
+ <Unit4>
+ <Filename Value="filestreamhelper.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="filestreamhelper"/>
+ </Unit4>
+ <Unit5>
+ <Filename Value="readextfiles.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="readextfiles"/>
+ </Unit5>
+ <Unit6>
+ <Filename Value="../../docs/inf04.txt"/>
+ <IsPartOfProject Value="True"/>
+ </Unit6>
+ <Unit7>
+ <Filename Value="readstrings.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="readstrings"/>
+ </Unit7>
+ <Unit8>
+ <Filename Value="iterator_impl.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="iterator_impl"/>
+ </Unit8>
+ <Unit9>
+ <Filename Value="iterator_intf.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="iterator_intf"/>
+ </Unit9>
+ <Unit10>
+ <Filename Value="readnlsdata.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="readnlsdata"/>
+ </Unit10>
+ <Unit11>
+ <Filename Value="readfonts.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="readfonts"/>
+ </Unit11>
+ <Unit12>
+ <Filename Value="readcontrols.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="readcontrols"/>
+ </Unit12>
+ <Unit13>
+ <Filename Value="readtoc.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="readtoc"/>
+ </Unit13>
+ <Unit14>
+ <Filename Value="u_Tools.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="u_Tools"/>
+ </Unit14>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="8"/>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)/"/>
+ <OtherUnitFiles Value="../"/>
+ <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
+ </SearchPaths>
+ <Other>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/docview/src/docdump/docdump.lpr b/docview/src/docdump/docdump.lpr
new file mode 100644
index 00000000..84077608
--- /dev/null
+++ b/docview/src/docdump/docdump.lpr
@@ -0,0 +1,98 @@
+{
+ Dumps the structure of an OS/2 IPF help file
+}
+program docdump;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils, IPFFileFormatUnit, IPFEscapeCodes, CustApp, readheader,
+ filestreamhelper, readextfiles, readstrings, iterator_intf, iterator_impl,
+ readnlsdata, readfonts, readcontrols, readtoc, u_Tools;
+
+type
+
+ { TDocDump }
+
+ TDocDump = class(TCustomApplication)
+ private
+ FIn: TFileStream;
+ FOut: TFileTextStream;
+ protected
+ procedure DoRun; override;
+ public
+ constructor Create(TheOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure WriteHelp; virtual;
+ end;
+
+{ TDocDump }
+
+procedure TDocDump.DoRun;
+var
+ ErrorMsg: String;
+begin
+ // quick check parameters
+ ErrorMsg:=CheckOptions('h','help');
+ if ErrorMsg<>'' then begin
+ ShowException(Exception.Create(ErrorMsg));
+ Terminate;
+ Exit;
+ end;
+
+ // parse parameters
+ if HasOption('h','help') then begin
+ WriteHelp;
+ Terminate;
+ Exit;
+ end;
+
+ FIn := TFileStream.Create(ParamStr(1), fmOpenRead);
+ FOut := TFileTextStream.Create(ExtractFileName(ParamStr(1))+'.txt', fmCreate);
+ try
+ FOut.WriteLn(Format('File name: %s (%d bytes)', [ExtractFileName(ParamStr(1)), FIn.Size]));
+ ProcessHeader(FIn, FOut);
+ ProcessExtFiles(FIn, FOut);
+ ProcessStringsTable(FIn, FOut);
+ ProcessNLSData(FIn, FOut);
+ ProcessFonts(FIn, FOut);
+ ProcessControls(FIn, FOut);
+ ProcessTOC(FIn, FOut);
+ finally
+ FIn.Free;
+ FOut.Free;
+ end;
+ // stop program loop
+ Terminate;
+end;
+
+constructor TDocDump.Create(TheOwner: TComponent);
+begin
+ inherited Create(TheOwner);
+ StopOnException:=True;
+end;
+
+destructor TDocDump.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TDocDump.WriteHelp;
+begin
+ { add your help code here }
+ writeln('Usage: ',ExeName,' -h');
+end;
+
+var
+ Application: TDocDump;
+
+
+begin
+ Application:=TDocDump.Create(nil);
+ Application.Run;
+ Application.Free;
+end.
+
diff --git a/docview/src/docdump/filestreamhelper.pas b/docview/src/docdump/filestreamhelper.pas
new file mode 100644
index 00000000..ff831a91
--- /dev/null
+++ b/docview/src/docdump/filestreamhelper.pas
@@ -0,0 +1,35 @@
+unit filestreamhelper;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+type
+ TFileTextStream = class(TFileStream)
+ public
+ procedure WriteLn(const fmt: String; const args: array of const);
+ procedure WriteLn(const s: String);
+ end;
+
+implementation
+
+{ TFileTextStream }
+
+procedure TFileTextStream.WriteLn(const fmt: String; const args: array of const);
+var
+ temp: String;
+begin
+ temp := Format(fmt, args) + LineEnding;
+ Write(temp[1], Length(temp));
+end;
+
+procedure TFileTextStream.WriteLn(const s: String);
+begin
+ self.WriteLn('%s', [s]);
+end;
+
+end.
+
diff --git a/docview/src/docdump/iterator_impl.pas b/docview/src/docdump/iterator_impl.pas
new file mode 100644
index 00000000..4ad88052
--- /dev/null
+++ b/docview/src/docdump/iterator_impl.pas
@@ -0,0 +1,480 @@
+unit iterator_impl;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes
+ ,SysUtils
+ ,Regex { to be used with filtered string iterator }
+ ,iterator_intf
+ ,contnrs
+ ;
+
+type
+
+ TTBStringsIterator = class(TInterfacedObject, ITBStringIterator, ITBStringAndObjectIterator)
+ private
+ FStrings: TStrings;
+ FCursor: Integer;
+ { Interface methods should always be private because
+ we will only ever access them via an Interface,
+ never via an Object instance }
+
+ { Interface: ITBStringIterator and ITBStringAndObjectIterator }
+ function HasNext: Boolean;
+ function Next: string;
+ function HasPrevious: Boolean;
+ function Previous: string;
+ { Interface: ITBStringAndObjectIterator }
+ function HasNextObject: Boolean;
+ function NextObject: TObject;
+ function HasPreviousObject: Boolean;
+ function PreviousObject: TObject;
+ public
+ constructor CreateCustom(const ASource: TStrings); virtual;
+ end;
+
+
+ TTBListIterator = class(TInterfacedObject, ITBIterator)
+ private
+ FList: TList;
+ FCursor: Integer;
+ { Interface: ITBIterator }
+ function HasNext: Boolean;
+ function Next: TObject;
+ function HasPrevious: Boolean;
+ function Previous: TObject;
+ public
+ constructor CreateCustom(const ASource: TList); virtual;
+ end;
+
+
+ TTBCollectionIterator = class(TInterfacedObject, ITBIterator)
+ private
+ FCollection: TCollection;
+ FCursor: Integer;
+ { Interface: ITBIterator }
+ function HasNext: Boolean;
+ function Next: TObject;
+ function HasPrevious: Boolean;
+ function Previous: TObject;
+ public
+ constructor CreateCustom(const ASource: TCollection); virtual;
+ end;
+
+
+ TTBInterfaceListIterator = class(TInterfacedObject, ITBInterfaceIterator)
+ private
+ FList: TInterfaceList;
+ FCursor: integer;
+ { Interface: ITBinterfaceIterator }
+ function HasNext: Boolean;
+ function Next: IInterface;
+ function HasPrevious: Boolean;
+ function Previous: IInterface;
+ public
+ constructor CreateCustom(const ASource: TInterfaceList); virtual;
+ end;
+
+
+ TTBFilteredStringsIterator = class(TTBStringsIterator, ITBFilteredStringIterator)
+ private
+ FNextIndex: Integer;
+ FRegex: TRegexEngine;
+ { Interface: ITBFilteredStringIterator }
+ function GetFilter: string;
+ procedure SetFilter(const AValue: string);
+ { Interface: ITBStringIterator and ITBStringAndObjectIterator }
+ function HasNext: Boolean;
+ function Next: string;
+ function HasPrevious: Boolean;
+ function Previous: string;
+ public
+ constructor CreateCustom(const ASource: TStrings); override;
+ destructor Destroy; override;
+ end;
+
+
+ TTBObjectListIterator = class(TInterfacedObject, ITBIterator)
+ private
+ FList: TObjectList;
+ FCursor: Integer;
+ { Interface: ITBIterator }
+ function HasNext: Boolean;
+ function Next: TObject;
+ function HasPrevious: Boolean;
+ function Previous: TObject;
+ public
+ constructor CreateCustom(const ASource: TObjectList); virtual;
+ end;
+
+
+
+implementation
+
+
+{ TTBStringsIterator }
+
+function TTBStringsIterator.HasNext: Boolean;
+begin
+ Result := False;
+ if Assigned(FStrings) then
+ if FCursor < FStrings.Count - 1 then
+ Result := True;
+end;
+
+function TTBStringsIterator.Next: string;
+begin
+ Result := '';
+ if HasNext then
+ begin
+ Inc(FCursor, 1);
+ Result := FStrings.Strings[FCursor];
+ end;
+end;
+
+function TTBStringsIterator.HasPrevious: Boolean;
+begin
+ Result := False;
+ if Assigned(FStrings) then
+ if FCursor > 0 then
+ Result := True;
+end;
+
+function TTBStringsIterator.Previous: string;
+begin
+ Result := '';
+ if HasPrevious then
+ begin
+ Dec(FCursor, 1);
+ Result := FStrings.Strings[FCursor];
+ end;
+end;
+
+function TTBStringsIterator.HasNextObject: Boolean;
+begin
+ Result := False;
+ if Assigned(FStrings) then
+ if FCursor < FStrings.Count - 1 then
+ Result := FStrings.Objects[FCursor] <> nil;
+end;
+
+function TTBStringsIterator.NextObject: TObject;
+begin
+ Result := nil;
+ if HasNextObject then
+ // Note that Next(...) increments the FCursor
+ Result := FStrings.Objects[FCursor];
+end;
+
+function TTBStringsIterator.HasPreviousObject: Boolean;
+begin
+ Result := False;
+ if Assigned(FStrings) then
+ if FCursor > 0 then
+ Result := FStrings.Objects[FCursor] <> nil;
+end;
+
+function TTBStringsIterator.PreviousObject: TObject;
+begin
+ Result := nil;
+ if HasPreviousObject then
+ // Note that Previous(...) decrements the FCursor
+ Result := FStrings.Objects[FCursor];
+end;
+
+constructor TTBStringsIterator.CreateCustom(const ASource: TStrings);
+begin
+ inherited Create;
+ FStrings := ASource;
+ FCursor := -1;
+end;
+
+
+{ TTBListIterator }
+
+function TTBListIterator.HasNext: Boolean;
+begin
+ Result := False;
+ if Assigned(FList) then
+ if FCursor < FList.Count - 1 then
+ Result := True;
+end;
+
+function TTBListIterator.Next: TObject;
+begin
+ Result := nil;
+ if HasNext then
+ begin
+ Inc(FCursor, 1);
+ result := TObject(FList.Items[FCursor]);
+ end;
+end;
+
+function TTBListIterator.HasPrevious: Boolean;
+begin
+ Result := False;
+ if Assigned(FList) then
+ begin
+ if FCursor > 0 then
+ Result := True;
+ end;
+end;
+
+function TTBListIterator.Previous: TObject;
+begin
+ Result := nil;
+ if HasPrevious then
+ begin
+ Dec(FCursor, 1);
+ Result := TObject(FList.Items[FCursor]);
+ end;
+end;
+
+constructor TTBListIterator.CreateCustom(const ASource: TList);
+begin
+ inherited Create;
+ FList := ASource;
+ FCursor := -1;
+end;
+
+
+{ TTBCollectionIterator }
+
+function TTBCollectionIterator.HasNext: Boolean;
+begin
+ Result := False;
+ if Assigned(FCollection) then
+ if FCursor < FCollection.Count - 1 then
+ Result := True;
+end;
+
+function TTBCollectionIterator.Next: TObject;
+begin
+ Result := nil;
+ if HasNext then
+ begin
+ Inc(FCursor, 1);
+ result := FCollection.Items[FCursor];
+ end;
+end;
+
+function TTBCollectionIterator.HasPrevious: Boolean;
+begin
+ Result := False;
+ if Assigned(FCollection) then
+ if FCursor > 0 then
+ Result := True;
+end;
+
+function TTBCollectionIterator.Previous: TObject;
+begin
+ Result := nil;
+ if HasPrevious then
+ begin
+ Dec(FCursor, 1);
+ Result := FCollection.Items[FCursor];
+ end;
+end;
+
+constructor TTBCollectionIterator.CreateCustom(const ASource: TCollection);
+begin
+ inherited Create;
+ FCollection := ASource;
+ FCursor := -1;
+end;
+
+
+{ TTBFilteredStringsIterator }
+
+function TTBFilteredStringsIterator.GetFilter: string;
+begin
+ Result := FRegex.RegexString;
+end;
+
+procedure TTBFilteredStringsIterator.SetFilter(const AValue: string);
+const
+ cFilterErr = 'Error in Filter string at position %d with ErrorCode %d. Filter string <%s>';
+var
+ LErrorCode: TRegexError;
+ LErrorPos: integer;
+begin
+ if AValue <> FRegex.RegexString then
+ begin
+ FRegex.RegexString := AValue;
+ if not FRegex.Parse(LErrorPos, LErrorCode) then
+ raise Exception.CreateFmt(cFilterErr, [LErrorPos, Ord(LErrorCode), AValue]);
+ end;
+ FNextIndex := -1;
+end;
+
+function TTBFilteredStringsIterator.HasNext: Boolean;
+var
+ LIndex: integer;
+ LMatchPos: integer;
+ LOffset: integer;
+begin
+ Result := False;
+ if GetFilter = '' then
+ begin
+ Result := inherited HasNext;
+ if Result then
+ FNextIndex := FCursor + 1;
+ end
+ else
+ begin
+ if FCursor < FStrings.Count - 1 then
+ begin
+ { If we haven't already calculated the next matching item }
+ if FNextIndex = -1 then
+ begin
+ LIndex := FCursor + 1;
+ { Peek ahead to find the next matching string }
+ while (LIndex < FStrings.Count) and (FNextIndex = -1) do
+ begin
+ { reset MatchString parameters }
+ LOffset := 0;
+ LMatchPos := 0;
+ if FRegex.MatchString(FStrings.Strings[LIndex], LMatchPos, LOffset) then
+ FNextIndex := LIndex;
+ Inc(LIndex);
+ end;
+ end;
+ if FNextIndex <> -1 then
+ Result := True;
+ end;
+ end; { if..else }
+end;
+
+function TTBFilteredStringsIterator.Next: string;
+begin
+ Result := '';
+ if HasNext then
+ begin
+ FCursor := FNextIndex;
+ FNextIndex := -1;
+ Result := FStrings.Strings[FCursor];
+ end;
+end;
+
+function TTBFilteredStringsIterator.HasPrevious: Boolean;
+begin
+ Result := False; // Filtered String is uni-directional
+end;
+
+function TTBFilteredStringsIterator.Previous: string;
+begin
+ Result := '';
+ raise EUniDirectionalIterator.Create('Filtered String Iterator is uni-directional (forward) only.');
+end;
+
+constructor TTBFilteredStringsIterator.CreateCustom(const ASource: TStrings);
+begin
+ inherited CreateCustom(ASource);
+ FRegex := TRegexEngine.Create('');
+ FRegex.IgnoreCase := True;
+ FNextIndex := -1;
+end;
+
+destructor TTBFilteredStringsIterator.Destroy;
+begin
+ FRegex.Free;
+ inherited Destroy;
+end;
+
+
+{ TTBInterfaceListIterator }
+
+function TTBInterfaceListIterator.HasNext: Boolean;
+begin
+ Result := False;
+ if Assigned(FList) then
+ if FCursor < FList.Count - 1 then
+ Result := True;
+end;
+
+function TTBInterfaceListIterator.Next: IInterface;
+begin
+ Result := nil;
+ if HasNext then
+ begin
+ Inc(FCursor, 1);
+ Result := FList.Items[FCursor];
+ end;
+end;
+
+function TTBInterfaceListIterator.HasPrevious: Boolean;
+begin
+ Result := False;
+ if Assigned(FList) then
+ if FCursor > 0 then
+ Result := True;
+end;
+
+function TTBInterfaceListIterator.Previous: IInterface;
+begin
+ Result := nil;
+ if HasPrevious then
+ begin
+ Dec(FCursor, 1);
+ Result := FList.Items[FCursor];
+ end;
+end;
+
+constructor TTBInterfaceListIterator.CreateCustom(const ASource: TInterfaceList);
+begin
+ inherited Create;
+ FList := ASource;
+ FCursor := -1;
+end;
+
+{ TTBObjectListIterator }
+
+function TTBObjectListIterator.HasNext: Boolean;
+begin
+ Result := False;
+ if Assigned(FList) then
+ if FCursor < FList.Count - 1 then
+ Result := True;
+end;
+
+function TTBObjectListIterator.Next: TObject;
+begin
+ result := nil;
+ if HasNext then
+ begin
+ Inc(FCursor);
+ result := FList.Items[FCursor];
+ end;
+end;
+
+function TTBObjectListIterator.HasPrevious: Boolean;
+begin
+ Result := False;
+ if Assigned(FList) then
+ if FCursor > 0 then
+ Result := True;
+end;
+
+function TTBObjectListIterator.Previous: TObject;
+begin
+ result := nil;
+ if HasPrevious then
+ begin
+ Dec(FCursor);
+ result := FList.Items[FCursor];
+ end;
+end;
+
+constructor TTBObjectListIterator.CreateCustom(const ASource: TObjectList);
+begin
+ inherited Create;
+ FList := ASource;
+ FCursor := -1;
+end;
+
+
+end.
+
diff --git a/docview/src/docdump/iterator_intf.pas b/docview/src/docdump/iterator_intf.pas
new file mode 100644
index 00000000..e82b59a1
--- /dev/null
+++ b/docview/src/docdump/iterator_intf.pas
@@ -0,0 +1,169 @@
+unit iterator_intf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes
+ ,SysUtils
+ ;
+
+type
+ { A custom exception class }
+ ENoIteratorImpl = class(Exception);
+ EUniDirectionalIterator = class(Exception);
+
+
+ { Standard iterators }
+
+ ITBIterator = interface(IInterface)
+ ['{9C2BC10D-54C8-4B59-88B5-A564921CF0E3}']
+ function HasNext: Boolean;
+ function Next: TObject;
+ function HasPrevious: Boolean;
+ function Previous: TObject;
+ end;
+
+
+ ITBStringIterator = interface(IInterface)
+ ['{B2A449B4-5D0A-4F14-AC11-CA055EDA3ED7}']
+ function HasNext: Boolean;
+ function Next: string;
+ function HasPrevious: Boolean;
+ function Previous: string;
+ end;
+
+
+ ITBStringAndObjectIterator = interface(ITBStringIterator)
+ ['{287373DC-A90D-400E-BAEE-C85474C317A8}']
+ function HasNextObject: Boolean;
+ function NextObject: TObject;
+ function HasPreviousObject: Boolean;
+ function PreviousObject: TObject;
+ end;
+
+
+ ITBInterfaceIterator = interface
+ ['{9B599C5B-4BBB-43F6-AF8E-09FEE9AE0E20}']
+ function HasNext: Boolean;
+ function Next: IInterface;
+ function HasPrevious: Boolean;
+ function Previous: IInterface;
+ end;
+
+ { TODO:
+ More interfaces could be added for collections like:
+ TTreeView, TStringGrid etc... }
+
+
+ { Filtered iterators }
+
+ ITBFilteredStringIterator = interface(ITBStringIterator)
+ ['{CF1B9E2D-DD05-4D15-95C6-686EAFA4ED82}']
+ function GetFilter: string;
+ procedure SetFilter(const AValue: string);
+ property Filter: string read GetFilter write SetFilter;
+ end;
+
+
+ { TODO:
+ More filtered versions of the standard iterators could
+ be added here... }
+
+
+
+ { Iterator Factory }
+
+ TTBIteratorFactory = class(TObject)
+ function Iterator(const ASource: TObject): ITBIterator;
+ function StringIterator(const ASource: TObject): ITBStringIterator;
+ function StringAndObjectIterator(const ASource: TObject): ITBStringAndObjectIterator;
+ function InterfaceIterator(const ASource: TObject): ITBInterfaceIterator;
+ function FilteredStringIterator(const ASource: TObject; const AFilter: string): ITBFilteredStringIterator;
+ end;
+
+
+{ Global iterator factory singleton }
+function gIteratorFactory: TTBIteratorFactory;
+
+
+implementation
+
+uses
+ iterator_impl;
+
+var
+ uIteratorFactory: TTBIteratorFactory;
+
+const
+ cNoIteratorImpl = 'No Iterator implementation found for <%s>';
+
+
+{ The lazy mans singleton implementation, but it does the job just fine. }
+function gIteratorFactory: TTBIteratorFactory;
+begin
+ if not Assigned(uIteratorFactory) then
+ uIteratorFactory := TTBIteratorFactory.Create;
+ Result := uIteratorFactory;
+end;
+
+
+{ TTBIteratorFactory }
+
+function TTBIteratorFactory.Iterator(const ASource: TObject): ITBIterator;
+begin
+ if ASource is TList then
+ Result := TTBListIterator.CreateCustom(TList(ASource))
+ else if ASource is TCollection then
+ Result := TTBCollectionIterator.CreateCustom(TCollection(ASource))
+ //else if ASource is TTreeNodes then
+ //Result := TTBTreeNodesIterator.CreateCustom(TTreeNodes(ASource))
+ else
+ raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
+end;
+
+function TTBIteratorFactory.StringIterator(const ASource: TObject): ITBStringIterator;
+begin
+ if ASource is TStrings then
+ Result := TTBStringsIterator.CreateCustom(TStrings(ASource))
+ else
+ raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
+end;
+
+function TTBIteratorFactory.StringAndObjectIterator(const ASource: TObject): ITBStringAndObjectIterator;
+begin
+ if ASource is TStrings then
+ Result := TTBStringsIterator.CreateCustom(TStrings(ASource))
+ else
+ raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
+end;
+
+function TTBIteratorFactory.InterfaceIterator(const ASource: TObject): ITBInterfaceIterator;
+begin
+ if ASource is TInterfaceList then
+ Result := TTBInterfaceListIterator.CreateCustom(TInterfaceList(ASource))
+ else
+ raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
+end;
+
+function TTBIteratorFactory.FilteredStringIterator(const ASource: TObject; const AFilter: string): ITBFilteredStringIterator;
+begin
+ if ASource is TStrings then
+ begin
+ Result := TTBFilteredStringsIterator.CreateCustom(TStrings(ASource));
+ Result.Filter := AFilter;
+ end
+ else
+ raise ENoIteratorImpl.CreateFmt(cNoIteratorImpl, [ASource.ClassName]);
+end;
+
+
+initialization
+ uIteratorFactory := nil;
+
+finalization
+ uIteratorFactory.Free;
+
+end.
+
diff --git a/docview/src/docdump/readcontrols.pas b/docview/src/docdump/readcontrols.pas
new file mode 100644
index 00000000..395a36db
--- /dev/null
+++ b/docview/src/docdump/readcontrols.pas
@@ -0,0 +1,44 @@
+{
+ Dump the controls data
+}
+unit readcontrols;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, filestreamhelper;
+
+procedure ProcessControls(AIn: TFileStream; AOut: TFileTextStream);
+
+
+implementation
+
+uses
+ readheader, IPFFileFormatUnit;
+
+procedure ProcessControls(AIn: TFileStream; AOut: TFileTextStream);
+var
+ ctrls: TPanelControls;
+ i: integer;
+begin
+ AOut.WriteLn('');
+ AOut.WriteLn('Panel Controls (Buttons)');
+ if eHdr.CtrlOffset > 0 then
+ begin
+ AIn.Seek(eHdr.CtrlOffset, soBeginning);
+ AIn.Read(ctrls, SizeOf(TControlDef));
+ AOut.WriteLn(Format(' PanelControls.ControlCount: %4.4x (%0:d)', [ctrls.ControlCount]));
+ AOut.WriteLn(Format(' PanelControls.GroupCount: %4.4x (%0:d)', [ctrls.GroupCount]));
+ AOut.WriteLn(Format(' PanelControls.GroupIndex: %4.4x (%0:d)', [ctrls.GroupIndex]));
+ AOut.WriteLn(Format(' PanelControls.Reserved: %4.4x (%0:d)', [ctrls.Reserved]));
+ AOut.WriteLn(' *****');
+ AOut.WriteLn(' <todo - process CountrolCount and GroupCount data>');
+ end
+ else
+ AOut.WriteLn(' No panel control found');
+end;
+
+end.
+
diff --git a/docview/src/docdump/readextfiles.pas b/docview/src/docdump/readextfiles.pas
new file mode 100644
index 00000000..6ea979d9
--- /dev/null
+++ b/docview/src/docdump/readextfiles.pas
@@ -0,0 +1,53 @@
+{
+ Dumps the names of external database (help) files referenced by this file
+}
+unit readextfiles;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, IPFFileFormatUnit, filestreamhelper;
+
+procedure ProcessExtFiles(AIn: TFileStream; AOut: TFileTextStream);
+
+
+implementation
+
+uses
+ readheader;
+
+procedure ProcessExtFiles(AIn: TFileStream; AOut: TFileTextStream);
+var
+ count: integer;
+ name: string;
+ pData: pointer;
+ p: pointer;
+ pLength: pByte;
+begin
+ AOut.WriteLn('');
+ AOut.WriteLn('External File References');
+
+ if eHdr.NumDataBase > 0 then
+ begin
+ pData := nil;
+ AIn.Seek(eHdr.DataBaseOffset, soBeginning);
+ GetMem(pData, eHdr.DataBaseSize); // allocate temp space for data
+ AIn.Read(pData^, eHdr.DataBaseSize); // read all data in one shot
+ p := pData; // p is our incrementing position in the data
+ for count := 0 to eHdr.NumDataBase-1 do
+ begin
+ pLength := p; // length byte, including itself
+ SetString(name, p+1, pLength^-1); // use length value minus the length byte to get the string length
+ AOut.WriteLn(Format(' File #%d: %s', [count, name]));
+ inc(p, pLength^); // skip to next entry using full length (including length byte)
+ end;
+ FreeMem(pData, eHdr.DataBaseSize); // free allocated space
+ end
+ else
+ AOut.WriteLn(' No external file references found');
+end;
+
+end.
+
diff --git a/docview/src/docdump/readfonts.pas b/docview/src/docdump/readfonts.pas
new file mode 100644
index 00000000..6b684cac
--- /dev/null
+++ b/docview/src/docdump/readfonts.pas
@@ -0,0 +1,47 @@
+{
+ Dumps the font data
+}
+unit readfonts;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, filestreamhelper;
+
+procedure ProcessFonts(AIn: TFileStream; AOut: TFileTextStream);
+
+
+implementation
+
+uses
+ readheader, IPFFileFormatUnit;
+
+procedure ProcessFonts(AIn: TFileStream; AOut: TFileTextStream);
+var
+ fnt: THelpFontSpec;
+ pData: pointer;
+ i: integer;
+begin
+ AOut.WriteLn('');
+ AOut.WriteLn('Font Data');
+ if eHdr.NumFontEntry > 0 then
+ begin
+ AIn.Seek(eHdr.FontTableOffset, soBeginning);
+ for i := 0 to eHdr.NumFontEntry-1 do
+ begin
+ AIn.Read(fnt, SizeOf(THelpFontSpec));
+ AOut.WriteLn(Format(' Font Entry #%d', [i+1]));
+ AOut.WriteLn(Format(' FontSpec.FaceName: %s', [fnt.FaceName]));
+ AOut.WriteLn(Format(' FontSpec.Height: %4.4x (%0:d)', [fnt.Height]));
+ AOut.WriteLn(Format(' FontSpec.Width: %4.4x (%0:d)', [fnt.Width]));
+ AOut.WriteLn(Format(' FontSpec.CodePage: %4.4x (%0:d)', [fnt.Codepage]));
+ end;
+ end
+ else
+ AOut.WriteLn(' No font data is present');
+end;
+
+end.
+
diff --git a/docview/src/docdump/readheader.pas b/docview/src/docdump/readheader.pas
new file mode 100644
index 00000000..201fcb86
--- /dev/null
+++ b/docview/src/docdump/readheader.pas
@@ -0,0 +1,135 @@
+{
+ Dump the INF header & extended header structures to a text file
+}
+unit readheader;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, filestreamhelper, IPFFileFormatUnit;
+
+procedure ProcessHeader(AIn: TFileStream; AOut: TFileTextStream);
+
+var
+ hdr: THelpFileHeader;
+ eHdr: TExtendedHelpFileHeader;
+
+
+implementation
+
+
+type
+ TWord = record
+ b1: AnsiChar;
+ b2: AnsiChar;
+ end;
+
+ TOverlayID = packed record
+ b1: Byte;
+ b2: Byte;
+ b3: Byte;
+ end;
+
+ TOverlaySearchStart = bitpacked record
+ SearchOffset: Unsigned_31;
+ IsRec16bitSize: boolean;
+ end;
+
+
+procedure ProcessHeader(AIn: TFileStream; AOut: TFileTextStream);
+var
+ bytes: integer;
+ s: string;
+ w: TWord;
+ i: uint32;
+ t0: TOverlayID;
+ t1: TOverlaySearchStart;
+begin
+ try
+ AIn.Seek(0, soBeginning);
+ bytes := AIn.Read(hdr, SizeOf(THelpFileHeader));
+ if bytes <> SizeOf(THelpFileHeader) then
+ raise Exception.Create('Failed to read complete file header');
+
+ if hdr.ID <> INF_HEADER_ID then
+ raise Exception.Create('This is not an OS/2 help file');
+
+ AOut.WriteLn('Header Section');
+ t0 := TOverlayID(hdr.ID);
+ s := hdr.ID;
+ AOut.WriteLn(Format(' ipfheader.id: %4.2x %2x %2x ("%s") : Magic word' ,[Byte(hdr.id[0]), Byte(hdr.id[1]), Byte(hdr.id[2]), s]));
+ if (hdr.flags and $01) > 0 then
+ s := 'INF'
+ else
+ s := 'HLP';
+ AOut.WriteLn(Format(' ipfheader.flags: %8.2x (%s format) : File format' ,[hdr.flags, s]));
+ AOut.WriteLn(Format(' ipfheader.size: %8.4x (%0:7d bytes) : Size of this header structure', [hdr.hdrsize]));
+ AOut.WriteLn(Format(' ipfheader.version: %6d.%d : version of file format?', [hdr.version_hi, hdr.version_lo]));
+ AOut.WriteLn(Format(' ipfheader.ntoc: %8.4x (%0:13d) : No of TOC entries', [hdr.ntoc]));
+ AOut.WriteLn(Format(' ipfheader.tocstart: %8.8x (%0:7d bytes) : 32bit file offset to start of TOC', [hdr.tocstart]));
+ AOut.WriteLn(Format(' ipfheader.toclen: %8.8x (%0:7d bytes) : bytes occupied by TOC entries', [hdr.toclen]));
+ AOut.WriteLn(Format(' ipfheader.tocoffsetsstart: %8.8x (%0:7d bytes) : file offset to array of TOC offsets', [hdr.tocoffsetsstart]));
+ AOut.WriteLn(Format(' ipfheader.nres: %8.4x (%0:13d) : number of panels with resource numbers', [hdr.nres]));
+ AOut.WriteLn(Format(' ipfheader.resstart: %8.8x (%0:7d bytes) : 32bit file offset of ressource number table', [hdr.resstart]));
+ AOut.WriteLn(Format(' ipfheader.nname: %8.4x (%0:13d) : number of panels with textual name', [hdr.nname]));
+ AOut.WriteLn(Format(' ipfheader.namestart: %8.8x (%0:7d bytes) : 32bit file offset to panel name table', [hdr.namestart]));
+ AOut.WriteLn(Format(' ipfheader.nindex: %8.4x (%0:13d) : number of index entries', [hdr.nindex]));
+ AOut.WriteLn(Format(' ipfheader.indexstart: %8.8x (%0:7d bytes) : 32bit file offset to index table', [hdr.indexstart]));
+ AOut.WriteLn(Format(' ipfheader.indexlen: %8.8x (%0:7d bytes) : size of index table', [hdr.indexlen]));
+ AOut.WriteLn(Format(' ipfheader.icmdCount: %8.4x (%0:13d) : number of icmd index items', [hdr.icmdCount]));
+ AOut.WriteLn(Format(' ipfheader.icmdOffset: %8.8x (%0:7d bytes) : file offset to icmd index items', [hdr.icmdOffset]));
+ AOut.WriteLn(Format(' ipfheader.icmdSize: %8.8x (%0:7d bytes) : size of icmd index table', [hdr.icmdSize]));
+ t1 := TOverlaySearchStart(hdr.searchstart);
+ i := t1.SearchOffset;
+ AOut.WriteLn(Format(' ipfheader.searchstart :31 %8.8x (%0:7d bytes) : 31bit file offset of full text search table', [i, i]));
+ if t1.IsRec16bitSize then
+ s := 'search rec is 16bit size'
+ else
+ s := 'search rec is 8bit size';
+ AOut.WriteLn(Format(' ipfheader.recSize :1 %s (%s) : if high bit set, search record size is 16bit', [BoolToStr(t1.IsRec16bitSize, True), s]));
+ AOut.WriteLn(Format(' ipfheader.searchlen: %8.8x (%0:7d bytes) : size of full text search table', [hdr.searchlen]));
+ AOut.WriteLn(Format(' ipfheader.nslots: %8.4x (%0:13d) : number of "slots"', [hdr.nslots]));
+ AOut.WriteLn(Format(' ipfheader.slotsstart: %8.8x (%0:7d bytes) : 32bit file offset of the slots array', [hdr.slotsstart]));
+ AOut.WriteLn(Format(' ipfheader.dictlen: %8.8x (%0:7d bytes) : bytes occupied by the "dictionary"', [hdr.dictlen]));
+ AOut.WriteLn(Format(' ipfheader.ndict: %8.4x (%0:13d) : number of entries in the dictionary', [hdr.ndict]));
+ AOut.WriteLn(Format(' ipfheader.dictstart: %8.8x (%0:7d bytes) : 32bit file offset to start of dictionary', [hdr.dictstart]));
+ AOut.WriteLn(Format(' ipfheader.imgstart: %8.8x (%0:7d bytes) : 32bit file offset to image data', [hdr.imgstart]));
+ AOut.WriteLn(Format(' ipfheader.maxCVTIndex: %8.2x (%0:13d) : highest index inside panel''s local dictionary', [hdr.maxCVTIndex]));
+ AOut.WriteLn(Format(' ipfheader.nlsstart: %8.8x (%0:7d bytes) : 32bit file offset of NLS table', [hdr.nlsstart, hdr.nlsstart]));
+ AOut.WriteLn(Format(' ipfheader.nlslen: %8.8x (%0:7d bytes) : size of NLS table', [hdr.nlslen]));
+ AOut.WriteLn(Format(' ipfheader.extstart: %8.8x (%0:7d bytes) : 32bit file offset of extended data block', [hdr.extstart]));
+ AOut.WriteLn(Format(' ipfheader.reserved: %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x %2.2x : for future use. set to zero.',
+ [hdr.reserved[0], hdr.reserved[1], hdr.reserved[2], hdr.reserved[3], hdr.reserved[4], hdr.reserved[5],
+ hdr.reserved[6], hdr.reserved[7], hdr.reserved[8], hdr.reserved[9], hdr.reserved[10], hdr.reserved[11] ]));
+ AOut.WriteLn(Format(' ipfheader.title: "%s" : ASCII title of database', [hdr.title]));
+
+ AOut.WriteLn('');
+ AOut.WriteLn('Extended Header Section');
+ AIn.Seek(hdr.extstart, soBeginning);
+ AIn.Read(eHdr, SizeOf(TExtendedHelpFileHeader));
+ AOut.WriteLn(Format(' extheader.NumFontEntry %8.4x (%0:13d) : Font Table - number of entries', [eHdr.NumFontEntry]));
+ AOut.WriteLn(Format(' extheader.FontTableOffset %8.8x (%0:7d bytes) : Font Table - 32bit offset in file', [eHdr.FontTableOffset]));
+ AOut.WriteLn(Format(' extheader.NumDataBase %8.4x (%0:13d) : Data Base - No of files', [eHdr.NumDataBase]));
+ AOut.WriteLn(Format(' extheader.DataBaseOffset %8.8x (%0:7d bytes) : Data Base - 32bit offset in file', [eHdr.DataBaseOffset]));
+ AOut.WriteLn(Format(' extheader.DataBaseSize %8.8x (%0:7d bytes) : Data Base - Size in bytse', [eHdr.DataBaseSize]));
+ AOut.WriteLn(Format(' extheader.EntryInGNameTable %8.4x (%0:13d) : Global Names - No entries', [eHdr.EntryInGNameTable]));
+ AOut.WriteLn(Format(' extheader.HelpPanelGNameTblOffset %8.8x (%0:7d bytes) : Global Names - 32bit offset in file', [eHdr.HelpPanelGNameTblOffset]));
+ AOut.WriteLn(Format(' extheader.StringsOffset %8.8x (%0:7d bytes) : Strings - 32bit offset in file', [eHdr.StringsOffset]));
+ AOut.WriteLn(Format(' extheader.StringsSize %8.4x (%0:7d bytes) : Strings - Total bytes of all strings', [eHdr.StringsSize]));
+ AOut.WriteLn(Format(' extheader.ChildPagesOffset %8.8x (%0:7d bytes) : Child Pages - 32bit offset in file', [eHdr.ChildPagesOffset]));
+ AOut.WriteLn(Format(' extheader.ChildPagesSize %8.8x (%0:7d bytes) : Child Pages - Total bytes of all strings', [eHdr.ChildPagesSize]));
+ AOut.WriteLn(Format(' extheader.NumGIndexEntry %8.8x (%0:13d) : Total number of Global Index items', [eHdr.NumGIndexEntry]));
+ AOut.WriteLn(Format(' extheader.CtrlOffset %8.8x (%0:7d bytes) : Ctrl Buttons : offset in file', [eHdr.CtrlOffset]));
+ AOut.WriteLn(Format(' extheader.CtrlSize %8.8x (%0:7d bytes) : Ctrl Buttons : size in bytes', [eHdr.CtrlSize]));
+ AOut.WriteLn(Format(' extheader.reserved: %8.8x %8.8x %8.8x %8.8x : for future use. set to zero.',
+ [eHdr.reserved[0], eHdr.reserved[1], eHdr.reserved[2], eHdr.reserved[3]]));
+
+ finally
+ // no nothing
+ end;
+end;
+
+end.
+
diff --git a/docview/src/docdump/readnlsdata.pas b/docview/src/docdump/readnlsdata.pas
new file mode 100644
index 00000000..68609235
--- /dev/null
+++ b/docview/src/docdump/readnlsdata.pas
@@ -0,0 +1,31 @@
+unit readnlsdata;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, filestreamhelper;
+
+procedure ProcessNLSData(AIn: TFileStream; AOut: TFileTextStream);
+
+implementation
+
+uses
+ readheader;
+
+procedure ProcessNLSData(AIn: TFileStream; AOut: TFileTextStream);
+begin
+ AOut.WriteLn('');
+ AOut.WriteLn('NLS Data');
+ if hdr.nlslen > 0 then
+ begin
+ AOut.WriteLn(' <todo - process NLS data>');
+
+ end
+ else
+ AOut.WriteLn('NLS Data is not present');
+end;
+
+end.
+
diff --git a/docview/src/docdump/readstrings.pas b/docview/src/docdump/readstrings.pas
new file mode 100644
index 00000000..7b397408
--- /dev/null
+++ b/docview/src/docdump/readstrings.pas
@@ -0,0 +1,56 @@
+{
+ Dump the String table data
+}
+unit readstrings;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, filestreamhelper;
+
+procedure ProcessStringsTable(AIn: TFileStream; AOut: TFileTextStream);
+
+
+implementation
+
+uses
+ readheader;
+
+procedure ProcessStringsTable(AIn: TFileStream; AOut: TFileTextStream);
+var
+ name: string;
+ pData: pointer;
+ p: pointer;
+ pLength: pByte;
+ bytes: integer;
+begin
+ AOut.WriteLn('');
+ AOut.WriteLn('Strings Data');
+
+ if eHdr.StringsSize > 0 then
+ begin
+ pData := nil;
+ AIn.Seek(eHdr.StringsOffset, soBeginning);
+ GetMem(pData, eHdr.StringsSize); // allocate temp space for data
+ AIn.Read(pData^, eHdr.StringsSize); // read all data in one shot
+ p := pData; // p is our incrementing position in the data
+ bytes := 0;
+ while bytes < eHdr.StringsSize do;
+ begin
+ pLength := p; // length byte, including itself
+ bytes := bytes + pLength^;
+ SetString(name, p+1, pLength^-1); // use length value minus the length byte to get the string length
+ AOut.WriteLn(Format(' %s', [name]));
+ inc(p, pLength^); // skip to next entry using full length (including length byte)
+ end;
+ FreeMem(pData, eHdr.StringsSize); // free allocated space
+ end
+ else
+ AOut.WriteLn(' There are no strings');
+
+end;
+
+end.
+
diff --git a/docview/src/docdump/readtoc.pas b/docview/src/docdump/readtoc.pas
new file mode 100644
index 00000000..0cfae395
--- /dev/null
+++ b/docview/src/docdump/readtoc.pas
@@ -0,0 +1,171 @@
+{
+ Dump the Table of Contents data
+}
+unit readtoc;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, filestreamhelper;
+
+procedure ProcessTOC(AIn: TFileStream; AOut: TFileTextStream);
+
+implementation
+
+uses
+ IPFFileFormatUnit, readheader, u_Tools;
+
+type
+ TTOCOverlay = bitpacked record
+ length: uint8; // length of the entry including this byte (but not including extended data)
+ nestlevel: Unsigned_4;
+ unknown: boolean;
+ extended: boolean;
+ hidden: boolean;
+ haschildren: boolean;
+ numSlots: uint8; // number of "slots" occupied by the text for this toc entry
+ end;
+
+
+ TTOCExtendedOverlay = bitpacked record
+ setPos: boolean;
+ setSize: boolean;
+ setView: boolean;
+ setStyle: boolean;
+ noSearch: boolean;
+ noPrint: boolean;
+ setCtrl: boolean;
+ setTutor: boolean;
+ clear: boolean;
+ unknown1: Unsigned_1;
+ setGroup: boolean;
+ isParent: boolean;
+ unknown2: Unsigned_4;
+ end;
+
+
+procedure ProcessTOC(AIn: TFileStream; AOut: TFileTextStream);
+var
+ Count: integer;
+ VisCount: integer;
+ pOffsets: UInt32ArrayPointer;
+ toc: TTOCEntryStart;
+ olay: TTOCOverlay;
+ tocextolay: TTOCExtendedOverlay;
+ pData: pointer;
+ pEntry: pTTOCEntryStart;
+ pExtendedInfo: pExtendedTOCEntry;
+ p: PByte;
+ i: integer;
+ titleLen: integer;
+ title: string;
+begin
+ AOut.WriteLn('');
+ AOut.WriteLn('Table of Contents');
+ VisCount := 0;
+ GetMem(pOffsets, SizeOf(uint32) * hdr.ntoc);
+ AIn.Seek(hdr.tocoffsetsstart, soBeginning);
+ AIn.Read(pOffsets^, SizeOf(uint32) * hdr.ntoc); // now we have array of toc offsets
+
+ AIn.Seek(hdr.tocstart, soBeginning);
+ GetMem(pData, hdr.toclen);
+ AIn.Read(pData^, hdr.toclen);
+ pEntry := pData;
+ for count := 1 to hdr.ntoc do
+ begin
+// AIn.Read(toc, SizeOf(TTOCEntryStart));
+// FillChar(olay, SizeOf(TTOCOverlay), 0);
+ p := PByte(pEntry) + sizeof(TTOCEntryStart);
+ i := Longint(p^);
+
+ olay.extended := (pEntry^.flags and TOCEntryExtended ) = TOCEntryExtended;
+ olay.nestlevel := (pEntry^.flags and TOCEntryLevelMask);
+ olay.hidden := (pEntry^.flags and TOCEntryHidden) = TOCEntryHidden;
+ olay.haschildren := (pEntry^.flags and TOCEntryHasChildren) = TOCEntryHasChildren;
+
+ AOut.WriteLn(Format(' TOC Entry #%d at offset %8.8x (%d bytes)', [count, p^, i]));
+ AOut.WriteLn(Format(' tocentry.length: %2.2x (%0:d bytes)', [pEntry^.length]));
+ AOut.WriteLn(Format(' tocentry.nestlevel: %d', [olay.nestlevel]));
+ AOut.WriteLn(Format(' tocentry.unknown: %s', [iif(olay.unknown, 'set', 'clear')]));
+ AOut.WriteLn(Format(' tocentry.extended: %s', [iif(olay.extended, 'yes', 'no')]));
+ AOut.WriteLn(Format(' tocentry.hidden: %s', [iif(olay.hidden, 'yes', 'no')]));
+ AOut.WriteLn(Format(' tocentry.haschildren: %s', [iif(olay.haschildren, 'yes', 'no')]));
+ AOut.WriteLn(Format(' tocentry.numSlots: %d', [pEntry^.numSlots]));
+ if not olay.hidden then
+ inc(VisCount);
+ if olay.extended then
+ begin
+ pExtendedInfo := pExtendedTOCEntry( p ); // next data to follow must be Extended TOC Entry
+
+ AOut.WriteLn(' Extended TOC Entry');
+ tocextolay := TTOCExtendedOverlay(pExtendedInfo^);
+
+ AOut.Writeln(Format(' ExtTocEntry.setPos: %s', [iif(tocextolay.setPos, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.setSize: %s', [iif(tocextolay.setSize, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.setView: %s', [iif(tocextolay.setView, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.setStyle: %s', [iif(tocextolay.setStyle, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.noSearch: %s', [iif(tocextolay.noSearch, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.noPrint: %s', [iif(tocextolay.noPrint, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.setCtrl: %s', [iif(tocextolay.setCtrl, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.setTutor: %s', [iif(tocextolay.setTutor, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.clear: %s', [iif(tocextolay.clear, 'clear', 'set')]));
+ AOut.Writeln(Format(' ExtTocEntry.unknown1: %1.1x', [tocextolay.unknown1]));
+ AOut.Writeln(Format(' ExtTocEntry.setGroup: %s', [iif(tocextolay.setGroup, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.isParent: %s', [iif(tocextolay.isParent, 'yes', 'no')]));
+ AOut.Writeln(Format(' ExtTocEntry.unknown2: %1.1x', [tocextolay.unknown2]));
+
+ inc( p, sizeof( TExtendedTOCEntry ) ); // move p past two flag bytes
+
+ if ( pExtendedInfo^.w1 and 1 ) > 0 then
+ // skip position
+ inc( p, sizeof( THelpXYPair ) );
+
+ if ( pExtendedInfo^.w1 and 2 ) > 0 then
+ // skip size
+ inc( p, sizeof( THelpXYPair ) );
+
+ if ( pExtendedInfo^.w1 and 8 ) > 0 then
+ // skip window controls
+ inc( p, sizeof(word) ); // increment by 2
+
+ if ( pExtendedInfo^.w1 and $40 ) > 0 then
+ // skip something else, unknown... style? 2 bytes
+ inc( p, sizeof(word) ); // increment by 2
+
+ if ( pExtendedInfo^.w2 and 4 ) > 0 then
+ begin
+// _ContentsGroupIndex := pUInt16(p)^;
+ // read group
+ inc( p, sizeof( uint16 ) );
+ end;
+ end;
+
+ // skip slot numbers for now.
+// _pSlotNumbers := pUInt16(p);
+ inc( p, pEntry^.numSlots * sizeof(uint16) );
+
+ // Calculate the remainder of the tocentry length - that is the bytes used for TOC topic (title) text
+ titleLen := pEntry^.length - ( longword( p ) - longword( pEntry ) );
+
+ // Read title
+ if TitleLen > 0 then
+ SetString(Title, Pointer(p), TitleLen)
+ else
+ Title := '<unknown>';
+ AOut.WriteLn(Format(' toc Title: %s', [title]));
+
+
+ p := PByte(pEntry);
+ inc(p, pEntry^.Length);
+ pEntry := pTTOCEntryStart(p);
+ end;
+
+ AOut.WriteLn(Format(' TOC visible count: %d', [VisCount]));
+ FreeMem(pOffsets, SizeOf(uint32) * hdr.ntoc);
+ FreeMem(pData, hdr.toclen);
+end;
+
+end.
+
diff --git a/docview/src/docdump/u_Tools.pas b/docview/src/docdump/u_Tools.pas
new file mode 100644
index 00000000..96192db9
--- /dev/null
+++ b/docview/src/docdump/u_Tools.pas
@@ -0,0 +1,52 @@
+{
+ This unit will grow to include all handy functions that can be used in
+ different Lazarus projects.
+
+ There may be no links to other non-standard units!
+}
+unit u_Tools;
+
+{$mode objfpc}{$H+}
+
+interface
+
+ { Missing iif() known from Visual Basic - return a string }
+ function iif(fCon: Boolean; sTrue, sFalse: String): String;
+ { Missing iif() known from Visual Basic - return an Integer }
+ function iif(fCon: Boolean; iTrue, iFalse: Integer): Integer;
+ { Missing iif() known from Visual Basic - return an Extended }
+ function iif(fCon: Boolean; iTrue, iFalse: Extended): Extended;
+
+
+implementation
+uses
+ SysUtils;
+
+
+function iif(fCon: Boolean; sTrue, sFalse: String): String;
+begin
+ if fCon then
+ Result := sTrue
+ else
+ Result := sFalse;
+end;
+
+function iif(fCon: Boolean; iTrue, iFalse: Integer): Integer;
+begin
+ if fCon then
+ Result := iTrue
+ else
+ Result := iFalse;
+end;
+
+function iif(fCon: Boolean; iTrue, iFalse: Extended): Extended;
+begin
+ if fCon then
+ Result := iTrue
+ else
+ Result := iFalse;
+end;
+
+
+end.
+
generated by cgit v1.2.3-70-g09d2 (git 2.48.0) at 2025-01-17 16:36:38 +0000