paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-06 03:10:39 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Added reading and writing binary TOC for chms.

Browse Source 
* Fixed a small bug in chmwriter where strings could have been written across blocks.
* Added a methon to TChmReader to get the toc sitemap. Will use binary toc first if available then text if not.

git-svn-id: trunk@13673 -
This commit is contained in:
andrew 2009-09-08 02:35:27 +00:00
parent 40c5ed111c
commit 76769d8e18
5 changed files with 412 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
packages/chm/src/chmfilewriter.pas
View File

@ -41,6 +41,7 @@ type
FDefaultPage: String;
FFiles: TStrings;
FIndexFileName: String;
FMakeBinaryTOC: Boolean;
FMakeSearchable: Boolean;
FFileName: String;
FOnProgress: TChmProgressCB;
@ -64,6 +65,7 @@ type
property Files: TStrings read FFiles write FFiles;
property AutoFollowLinks: Boolean read FAutoFollowLinks write FAutoFollowLinks;
property TableOfContentsFileName: String read FTableOfContentsFileName write FTableOfContentsFileName;
property MakeBinaryTOC: Boolean read FMakeBinaryTOC write FMakeBinaryTOC;
property Title: String read FTitle write FTitle;
property IndexFileName: String read FIndexFileName write FIndexFileName;
property MakeSearchable: Boolean read FMakeSearchable write FMakeSearchable;
@ -75,7 +77,7 @@ type
implementation
uses XmlCfg;
uses XmlCfg, chmsitemap;
{ TChmProject }
@ -98,6 +100,7 @@ var
IndexStream: TFileStream;
TOCStream: TFileStream;
Writer: TChmWriter;
TOCSitemap: TChmSiteMap;
begin
// Assign the TOC and index files
Writer := TChmWriter(Sender);
@ -109,6 +112,14 @@ begin
if (TableOfContentsFileName <> '') and FileExists(TableOfContentsFileName) then begin
TOCStream := TFileStream.Create(TableOfContentsFileName, fmOpenRead);
Writer.AppendTOC(TOCStream);
if MakeBinaryTOC then
begin
TOCStream.Position := 0;
TOCSitemap := TChmSiteMap.Create(stTOC);
TOCSitemap.LoadFromStream(TOCStream);
Writer.AppendBinaryTOCFromSiteMap(TOCSitemap);
TOCSitemap.Free;
end;
TOCStream.Free;
end;
@ -142,6 +153,7 @@ begin
end;
IndexFileName := Cfg.GetValue('Files/IndexFile/Value','');
TableOfContentsFileName := Cfg.GetValue('Files/TOCFile/Value','');
MakeBinaryTOC := Cfg.GetValue('Files/MakeBinaryTOC/Value', True);
AutoFollowLinks := Cfg.GetValue('Settings/AutoFollowLinks/Value', False);
MakeSearchable := Cfg.GetValue('Settings/MakeSearchable/Value', False);
@ -168,6 +180,7 @@ begin
end;
Cfg.SetValue('Files/IndexFile/Value', IndexFileName);
Cfg.SetValue('Files/TOCFile/Value', TableOfContentsFileName);
Cfg.SetValue('Files/MakeBinaryTOC/Value',MakeBinaryTOC);
Cfg.SetValue('Settings/AutoFollowLinks/Value', AutoFollowLinks);
Cfg.SetValue('Settings/MakeSearchable/Value', MakeSearchable);
@ -189,6 +202,7 @@ var
Writer: TChmWriter;
TOCStream,
IndexStream: TFileStream;
begin
IndexStream := nil;
TOCStream := nil;
@ -207,6 +221,7 @@ begin
Writer.Title := Title;
Writer.DefaultFont := DefaultFont;
Writer.FullTextSearch := MakeSearchable;
Writer.HasBinaryTOC := MakeBinaryTOC;
// and write!
Writer.Execute;

126
packages/chm/src/chmreader.pas
View File

@ -28,7 +28,7 @@ unit chmreader;
interface
uses
Classes, SysUtils, chmbase, paslzx, chmFIftiMain;
Classes, SysUtils, chmbase, paslzx, chmFIftiMain, chmsitemap;
type
@ -109,12 +109,14 @@ type
procedure ReadCommonData;
function ReadStringsEntry(APosition: DWord): String;
function ReadURLSTR(APosition: DWord): String;
function CheckCommonStreams: Boolean;
public
constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); override;
destructor Destroy; override;
public
function GetContextUrl(Context: THelpContext): String;
function LookupTopicByID(ATopicID: Integer; out ATitle: String): String; // returns a url
function GetTOCSitemap: TChmSiteMap;
function HasContextList: Boolean;
property DefaultPage: String read fDefaultPage;
property IndexFile: String read fIndexFile;
@ -164,6 +166,7 @@ const
function ChmErrorToStr(Error: Integer): String;
implementation
uses ChmTypes;
function ChmErrorToStr(Error: Integer): String;
begin
@ -457,22 +460,31 @@ function TChmReader.ReadURLSTR ( APosition: DWord ) : String;
var
URLStrURLOffset: DWord;
begin
if not CheckCommonStreams then
Exit;
fURLTBLStream.Position := APosition;
fURLTBLStream.ReadDWord; // unknown
fURLTBLStream.ReadDWord; // TOPIC index #
fURLSTRStream.Position := LEtoN(fURLTBLStream.ReadDWord);
fURLSTRStream.ReadDWord;
fURLSTRStream.ReadDWord;
if fURLSTRStream.Position < fURLSTRStream.Size-1 then
Result := '/'+PChar(fURLSTRStream.Memory+fURLSTRStream.Position);
end;
function TChmReader.CheckCommonStreams: Boolean;
begin
if fTOPICSStream = nil then
fTOPICSStream := GetObject('/#TOPICS');
if fURLSTRStream = nil then
fURLSTRStream := GetObject('/#URLSTR');
if fURLTBLStream = nil then
fURLTBLStream := GetObject('/#URLTBL');
if (fURLTBLStream <> nil) and (fURLSTRStream <> nil) then
begin
fURLTBLStream.Position := APosition;
fURLTBLStream.ReadDWord; // unknown
fURLTBLStream.ReadDWord; // TOPIC index #
fURLSTRStream.Position := LEtoN(fURLTBLStream.ReadDWord);
fURLSTRStream.ReadDWord;
fURLSTRStream.ReadDWord;
if fURLSTRStream.Position < fURLSTRStream.Size-1 then
Result := '/'+PChar(fURLSTRStream.Memory+fURLSTRStream.Position);
end;
Result := (fTOPICSStream <> nil)
and (fURLSTRStream <> nil)
and (fURLTBLStream <> nil);
end;
constructor TChmReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
@ -848,9 +860,7 @@ begin
Result := '';
ATitle := '';
//WriteLn('Getting topic# ',ATopicID);
if fTOPICSStream = nil then
fTOPICSStream := GetObject('/#TOPICS');
if fTOPICSStream = nil then
if not CheckCommonStreams then
Exit;
fTOPICSStream.Position := ATopicID * 16;
if fTOPICSStream.Position = ATopicID * 16 then
@ -865,6 +875,92 @@ begin
end;
end;
function TChmReader.GetTOCSitemap: TChmSiteMap;
function AddTOCItem(TOC: TStream; AItemOffset: DWord; SiteMapITems: TChmSiteMapItems): DWord;
var
Props: DWord;
Item: TChmSiteMapItem;
NextEntry: DWord;
TopicsIndex: DWord;
Title: String;
begin
Toc.Position:= AItemOffset + 4;
Item := SiteMapITems.NewItem;
Props := LEtoN(TOC.ReadDWord);
if (Props and TOC_ENTRY_HAS_LOCAL) = 0 then
Item.Text:= ReadStringsEntry(LEtoN(TOC.ReadDWord))
else
begin
TopicsIndex := LEtoN(TOC.ReadDWord);
Item.Local := LookupTopicByID(TopicsIndex, Title);
Item.Text := Title;
end;
TOC.ReadDWord;
Result := LEtoN(TOC.ReadDWord);
if Props and TOC_ENTRY_HAS_CHILDREN > 0 then
begin
NextEntry := LEtoN(TOC.ReadDWord);
repeat
NextEntry := AddTOCItem(TOC, NextEntry, Item.Children);
until NextEntry = 0;
end;
end;
var
TOC: TStream;
TOPICSOffset: DWord;
EntriesOffset: DWord;
EntryCount: DWord;
EntryInfoOffset: DWord;
NextItem: DWord;
begin
Result := nil;
// First Try Binary
TOC := GetObject('/#TOCIDX');
if TOC = nil then
begin
// Second Try text toc
TOC := GetObject(TOCFile);
if TOC <> nil then
begin
Result := TChmSiteMap.Create(stTOC);
Result.LoadFromStream(TOC);
Toc.Free;
end;
Exit;
end;
// TOPICS URLSTR URLTBL must all exist to read binary toc
// if they don't then try text file
if not CheckCommonStreams then
begin
TOC.Free;
TOC := GetObject(TOCFile);
if TOC <> nil then
begin
Result := TChmSiteMap.Create(stTOC);
Result.LoadFromStream(TOC);
Toc.Free;
end;
Exit;
end;
// Binary Toc Exists
Result := TChmSiteMap.Create(stTOC);
EntryInfoOffset := NtoLE(TOC.ReadDWord);
EntriesOffset := NtoLE(TOC.ReadDWord);
EntryCount := NtoLE(TOC.ReadDWord);
TOPICSOffset := NtoLE(TOC.ReadDWord);
NextItem := EntryInfoOffset;
repeat
NextItem := AddTOCItem(Toc, NextItem, Result.Items);
until NextItem = 0;
end;
function TChmReader.HasContextList: Boolean;
begin
Result := fContextList.Count > 0;

13
packages/chm/src/chmsitemap.pas
View File

@ -70,6 +70,7 @@ type
TChmSiteMapItems = class(TPersistent)
private
FInternalData: Dword;
FList: TList;
FOwner: TChmSiteMap;
FParentItem: TChmSiteMapItem;
@ -89,6 +90,7 @@ type
property Count: Integer read GetCount;
property ParentItem: TChmSiteMapItem read FParentItem;
property Owner: TChmSiteMap read FOwner;
property InternalData: Dword read FInternalData write FInternalData;
end;
@ -194,14 +196,14 @@ begin
//WriteLn('TAG:', AActualTag);
TagName := GetTagName(ACaseInsensitiveTag);
if not (smtHTML in FSiteMapTags) then begin
if TagName = 'HTML' then Include(FSiteMapTags, smtHTML);
{ if not (smtHTML in FSiteMapTags) then begin
if (TagName = 'HTML') or (TagName = '/HTML') then Include(FSiteMapTags, smtHTML);
end
else begin // looking for /HTML
if TagName = '/HTML' then Exclude(FSiteMapTags, smtHTML);
end;
end;}
if (smtHTML in FSiteMapTags) then begin
//if (smtHTML in FSiteMapTags) then begin
if not (smtBODY in FSiteMapTags) then begin
if TagName = 'BODY' then Include(FSiteMapTags, smtBODY);
end
@ -263,7 +265,7 @@ begin
end;
end;
end;
end
//end
end;
procedure TChmSiteMap.FoundText(AText: string);
@ -460,6 +462,7 @@ begin
FList := TList.Create;
FParentItem := AParentItem;
FOwner := AOwner;
FInternalData := maxLongint;
end;
destructor TChmSiteMapItems.Destroy;

53
packages/chm/src/chmtypes.pas
View File

@ -91,10 +91,63 @@ type
end;
TTOCIdxHeader = record
BlockSize: DWord; // 4096
EntriesOffset: DWord;
EntriesCount: DWord;
TopicsOffset: DWord;
EmptyBytes: array[0..4079] of byte;
end;
const
TOC_ENTRY_HAS_NEW = 2;
TOC_ENTRY_HAS_CHILDREN = 4;
TOC_ENTRY_HAS_LOCAL = 8;
type
PTOCEntryPageBookInfo = ^TTOCEntryPageBookInfo;
TTOCEntryPageBookInfo = record
Unknown1: Word; // = 0
EntryIndex: Word; // multiple entry info's can have this value but the TTocEntry it points to points back to the first item with this number. Wierd.
Props: DWord; // BitField. See TOC_ENTRY_*
TopicsIndexOrStringsOffset: DWord; // if TOC_ENTRY_HAS_LOCAL is in props it's the Topics Index
// else it's the Offset In Strings of the Item Text
ParentPageBookInfoOffset: DWord;
NextPageBookOffset: DWord; // same level of tree only
// Only if TOC_ENTRY_HAS_CHILDREN is set are these written
FirstChildOffset: DWord;
Unknown3: DWord; // = 0
end;
TTocEntry = record
PageBookInfoOffset: DWord;
IncrementedInt: DWord; // first is $29A
TopicsIndex: DWord; // Index of Entry in #TOPICS file
end;
TTopicEntry = record
TocOffset,
StringsOffset,
URLTableOffset: DWord;
InContents: Word;// 2 = in contents 6 = not in contents
Unknown: Word; // 0,2,4,8,10,12,16,32
end;
function PageBookInfoRecordSize(ARecord: PTOCEntryPageBookInfo): Integer;
implementation
uses chmbase;
function PageBookInfoRecordSize(ARecord: PTOCEntryPageBookInfo): Integer;
begin
if (TOC_ENTRY_HAS_CHILDREN and ARecord^.Props) > 0 then
Result := 28
else
Result := 20;
end;
{ TDirectoryChunk }
function TDirectoryChunk.CanHold(ASize: Integer): Boolean;

239
packages/chm/src/chmwriter.pas
View File

@ -22,7 +22,7 @@ unit chmwriter;
{$MODE OBJFPC}{$H+}
interface
uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer;
uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap;
type
@ -39,6 +39,7 @@ type
TChmWriter = class(TObject)
FOnLastFile: TNotifyEvent;
private
FHasBinaryTOC: Boolean;
ForceExit: Boolean;
@ -73,6 +74,7 @@ type
FWindowSize: LongWord;
FReadCompressedSize: QWord; // Current Size of Uncompressed data that went in Section1 (compressed)
FIndexedFiles: TIndexedWordList;
FPostStreamActive: Boolean;
// Linear order of file
ITSFHeader: TITSFHeader;
HeaderSection0Table: TITSFHeaderEntry; // points to HeaderSection0
@ -107,6 +109,7 @@ type
function AddString(AString: String): LongWord;
function AddURL(AURL: String; TopicsIndex: DWord): LongWord;
procedure CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
function NextTopicIndex: Integer;
// callbacks for lzxcomp
function AtEndOfData: Longbool;
function GetData(Count: LongInt; Buffer: PByte): LongInt;
@ -118,6 +121,8 @@ type
destructor Destroy; override;
procedure Execute;
procedure AppendTOC(AStream: TStream);
procedure AppendBinaryTOCFromSiteMap(ASiteMap: TChmSiteMap);
procedure AppendBinaryTOCStream(AStream: TStream);
procedure AppendIndex(AStream: TStream);
procedure AppendSearchDB(AName: String; AStream: TStream);
procedure AddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
@ -132,6 +137,7 @@ type
property Title: String read FTitle write FTitle;
property FullTextSearch: Boolean read FFullTextSearch write FFullTextSearch;
property SearchTitlesOnly: Boolean read FSearchTitlesOnly write FSearchTitlesOnly;
property HasBinaryTOC: Boolean read FHasBinaryTOC write FHasBinaryTOC;
property DefaultFont: String read FDefaultFont write FDefaultFont;
property DefaultPage: String read FDefaultPage write FDefaultPage;
property TempRawStream: TStream read FTempStream write SetTempRawStream;
@ -517,6 +523,22 @@ begin
// }
Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
FInternalFiles.AddEntry(Entry);
{// 7 Binary Index
if FHasBinaryIndex then
begin
FSection0.WriteWord(NToLE(Word(7)));
FSection0.WriteWord(NToLE(Word(4)));
FSection0.WriteDWord(DWord(0)); // what is this number to be?
end;}
// 11 Binary TOC
if FHasBinaryTOC then
begin
FSection0.WriteWord(NToLE(Word(11)));
FSection0.WriteWord(NToLE(Word(4)));
FSection0.WriteDWord(DWord(0)); // what is this number to be?
end;
end;
procedure TChmWriter.WriteITBITS;
@ -815,10 +837,23 @@ begin
end;
function TChmWriter.AddString(AString: String): LongWord;
var
NextBlock: DWord;
Pos: DWord;
begin
// #STRINGS starts with a null char
if FStringsStream.Size = 0 then FStringsStream.WriteByte(0);
// each entry is a null terminated string
Pos := DWord(FStringsStream.Position);
// Strings are contained in $1000 byte blocks and cannot cross blocks
NextBlock := ($0000F000 and Pos) + $00001000;
if Length(AString) + 1 > NextBlock then
begin
FStringsStream.Size:= NextBlock;
FStringsStream.Position := NextBlock;
end;
Result := FStringsStream.Position;
FStringsStream.WriteBuffer(AString[1], Length(AString));
FStringsStream.WriteByte(0);
@ -911,6 +946,7 @@ begin
if (AtEndOfData)
and (FCurrentStream <> FPostStream) then
begin
FPostStreamActive := True;
if Assigned(FOnLastFile) then
FOnLastFile(Self);
FCurrentStream.Free;
@ -989,31 +1025,19 @@ begin
end;
procedure TChmWriter.CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
type
TTopicEntry = record
TocOffset,
StringsOffset,
URLTableOffset: DWord;
InContents: Word;// 2 = in contents 6 = not in contents
Unknown: Word; // 0,2,4,8,10,12,16,32
end;
function GetNewTopicsIndex: Integer;
begin
Result := FTopicsStream.Size div 16;
end;
var
TopicEntry: TTopicEntry;
ATitle: String;
begin
if Pos('.ht', AFileEntry.Name) > 0 then
begin
ATitle := FIndexedFiles.IndexFile(AStream, GetNewTopicsIndex, FSearchTitlesOnly);
ATitle := FIndexedFiles.IndexFile(AStream, NextTopicIndex, FSearchTitlesOnly);
if ATitle <> '' then
TopicEntry.StringsOffset := AddString(ATitle)
else
TopicEntry.StringsOffset := $FFFFFFFF;
TopicEntry.URLTableOffset := AddURL(AFileEntry.Path+AFileEntry.Name, GetNewTopicsIndex);
TopicEntry.URLTableOffset := AddURL(AFileEntry.Path+AFileEntry.Name, NextTopicIndex);
TopicEntry.InContents := 2;
TopicEntry.Unknown := 0;
TopicEntry.TocOffset := 0;
@ -1025,6 +1049,11 @@ begin
end;
end;
function TChmWriter.NextTopicIndex: Integer;
begin
Result := FTopicsStream.Size div 16;
end;
constructor TChmWriter.Create(OutStream: TStream; FreeStreamOnDestroy: Boolean);
begin
if OutStream = nil then Raise Exception.Create('TChmWriter.OutStream Cannot be nil!');
@ -1119,6 +1148,180 @@ begin
PostAddStreamToArchive('default.hhc', '/', AStream, True);
end;
procedure TChmWriter.AppendBinaryTOCFromSiteMap(ASiteMap: TChmSiteMap);
var
Header: TTOCIdxHeader;
Entry: TTocEntry;
EntryInfo: TTOCEntryPageBookInfo;
EntryInfoStream,
EntryTopicOffsetStream,
EntryStream: TMemoryStream;
TOCIDXStream: TMemoryStream;
NextLevelItems,
CurrentLevelItems: TFPList;
i,j: Integer;
MenuItem: TChmSiteMapItem;
MenuItems: TChmSiteMapItems;
TopicEntry: TTopicEntry;
EntryCount: DWord = $29A;
procedure FixParentBookFirstChildOffset(AChildOffset: DWord);
var
ParentEntry: TTOCEntryPageBookInfo;
begin
// read parent entry
EntryInfoStream.Position := MenuItems.InternalData;
EntryInfoStream.Read(ParentEntry, SizeOf(ParentEntry));
// update child offset
ParentEntry.FirstChildOffset:= NtoLE(DWord(4096 + AChildOffset));
// write back to stream
EntryInfoStream.Position := MenuItems.InternalData;
EntryInfoStream.Write(ParentEntry, SizeOf(ParentEntry));
// move to end of stream
EntryInfoStream.Position := AChildOffset;
end;
begin
FillChar(Header, 4096, 0);
// create streams
TOCIDXStream := TMemoryStream.Create;
EntryInfoStream := TMemoryStream.Create;
EntryTopicOffsetStream := TMemoryStream.Create;
EntryStream := TMemoryStream.Create;
NextLevelItems := TFPList.Create;
NextLevelItems.Add(ASiteMap.Items);
if NextLevelItems.Count = 0 then
FreeAndNil(NextLevelItems);
while NextLevelItems <> nil do
begin WriteLn('Loop');
CurrentLevelItems := NextLevelItems;
NextLevelItems := TFPList.Create;
for i := 0 to CurrentLevelItems.Count-1 do
begin
MenuItems := TChmSiteMapItems(CurrentLevelItems.Items[i]);
for j := 0 to MenuItems.Count-1 do
begin
MenuItem := MenuItems.Item[j];
// first figure out the props
EntryInfo.Props := 0;
if MenuItem.Children.Count > 0 then
EntryInfo.Props := EntryInfo.Props or TOC_ENTRY_HAS_CHILDREN;
if Length(MenuItem.Local) > 0 then
EntryInfo.Props := EntryInfo.Props or TOC_ENTRY_HAS_LOCAL;
if EntryInfo.Props and TOC_ENTRY_HAS_LOCAL > 0 then
begin
// Write #TOPICS entry
TopicEntry.TocOffset := NtoLE(DWord(4096 + EntryInfoStream.Position));
TopicEntry.StringsOffset := NtoLE(AddString(MenuItem.Text));
TopicEntry.URLTableOffset := NtoLE(AddURL(MenuItem.Local, NextTopicIndex));
TopicEntry.InContents := NtoLE(Word( 2 ));
TopicEntry.Unknown := 0;
EntryInfo.TopicsIndexOrStringsOffset := NtoLE(Dword(NextTopicIndex));;
FTopicsStream.Write(TopicEntry, SizeOf(TopicEntry));
EntryTopicOffsetStream.WriteDWord(EntryInfo.TopicsIndexOrStringsOffset);
// write TOCEntry
Entry.PageBookInfoOffset:= NtoLE(4096 + EntryInfoStream.Position);
Entry.IncrementedInt := NtoLE(EntryCount);
EntryStream.Write(Entry, SizeOf(Entry));
Inc(EntryCount);
end
else
begin
EntryInfo.TopicsIndexOrStringsOffset := NtoLE(AddString(MenuItem.Text));
end;
// write TOCEntryInfo
EntryInfo.Unknown1 := 0;
EntryInfo.EntryIndex := NtoLE(Word(EntryCount - $29A)); //who knows how useful any of this is
if MenuItems.InternalData <> maxLongint then
EntryInfo.ParentPageBookInfoOffset := MenuItems.InternalData
else
EntryInfo.ParentPageBookInfoOffset := 0;
if j = MenuItems.Count-1 then
EntryInfo.NextPageBookOffset := 0
else if (EntryInfo.Props and TOC_ENTRY_HAS_CHILDREN) > 0 then
EntryInfo.NextPageBookOffset := 4096 + EntryInfoStream.Position + 28
else
EntryInfo.NextPageBookOffset := 4096 + EntryInfoStream.Position + 20;
// Only if TOC_ENTRY_HAS_CHILDREN is set are these written
EntryInfo.FirstChildOffset := 0; // we will update this when the child is written
// in fact lets update the *parent* of this item now if needed
if (j = 0) and (MenuItems.InternalData <> maxLongint) then
FixParentBookFirstChildOffset(EntryInfoStream.Position);
EntryInfo.Unknown3 := 0;
// fix endian order
EntryInfo.Props := NtoLE(EntryInfo.Props);
EntryInfo.ParentPageBookInfoOffset := NtoLE(EntryInfo.ParentPageBookInfoOffset);
EntryInfo.NextPageBookOffset := NtoLE(EntryInfo.NextPageBookOffset);
if MenuItem.Children.Count > 0 then
begin
NextLevelItems.Add(MenuItem.Children);
MenuItem.Children.InternalData := EntryInfoStream.Position;
end;
// write to stream
EntryInfoStream.Write(EntryInfo, PageBookInfoRecordSize(@EntryInfo));
end;
end;
FreeAndNil(CurrentLevelItems);
if NextLevelItems.Count = 0 then
FreeAndNil(NextLevelItems);
end;
// write all streams to TOCIdxStream and free everything
EntryInfoStream.Position:=0;
EntryTopicOffsetStream.Position:=0;
EntryStream.Position:=0;
Header.BlockSize := NtoLE(DWord(4096));
Header.EntriesCount := NtoLE(DWord(EntryCount - $29A));
Header.EntriesOffset := NtoLE(DWord(4096 + EntryInfoStream.Size + EntryTopicOffsetStream.Size));
Header.TopicsOffset := NtoLE(DWord(4096 + EntryInfoStream.Size));
TOCIDXStream.Write(Header, SizeOf(Header));
TOCIDXStream.CopyFrom(EntryInfoStream, EntryInfoStream.Size);
EntryInfoStream.Free;
TOCIDXStream.CopyFrom(EntryTopicOffsetStream, EntryTopicOffsetStream.Size);
EntryTopicOffsetStream.Free;
TOCIDXStream.CopyFrom(EntryStream, EntryStream.Size);
EntryStream.Free;
TOCIDXStream.Position := 0;
AppendBinaryTOCStream(TOCIDXStream);
TOCIDXStream.Free;
end;
procedure TChmWriter.AppendBinaryTOCStream(AStream: TStream);
begin
AddStreamToArchive('#TOCIDX', '/', AStream, True);
end;
procedure TChmWriter.AppendIndex(AStream: TStream);
begin
FHasIndex := True;
@ -1139,6 +1342,12 @@ var
TargetStream: TStream;
Entry: TFileEntryRec;
begin
// in case AddStreamToArchive is used after we should be writing to the post stream
if FPostStreamActive then
begin
PostAddStreamToArchive(AFileName, APath, AStream, Compress);
Exit;
end;
if AStream = nil then Exit;
if Compress then
TargetStream := FCurrentStream