--- Merging r13673 into '.':

U    packages/chm/src/chmfilewriter.pas
U    packages/chm/src/chmwriter.pas
U    packages/chm/src/chmreader.pas
U    packages/chm/src/chmsitemap.pas
U    packages/chm/src/chmtypes.pas
--- Merging r13682 into '.':
U    utils/fpdoc/dw_htmlchm.inc
--- Merging r13740 into '.':
U    packages/chm/src/paslzx.pas
G    packages/chm/src/chmreader.pas
--- Merging r13759 into '.':
G    packages/chm/src/chmwriter.pas

git-svn-id: branches/fixes_2_4@13775 -

packages/chm/src/chmfilewriter.pas

@@ -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;

packages/chm/src/chmreader.pas

@@ -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;
@@ -985,7 +1081,7 @@ begin
       Exit;
     end;
     // if FirstBlock is odd (1,3,5,7 etc) we have to read the even block before it first.
-    if (FirstBlock <> 0) and (FirstBlock mod 2 > 0) then begin
+    if FirstBlock and 1 = 1 then begin
       fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + (ResetTable[FirstBLock-1]);
       ReadCount := ResetTable[FirstBlock] - ResetTable[FirstBlock-1];
       BlockWriteLength:=BlockSize;
@@ -1035,7 +1131,7 @@ begin
       end;
       
       // if the next block is an even numbered block we have to reset the decompressor state
-      if (X < LastBlock) and (X mod 2 > 0) then LZXreset(LZXState);
+      if (X < LastBlock) and (X and 1 = 1) then LZXreset(LZXState);
 
     end;
     FreeMem(OutBuf);
@@ -1142,7 +1238,7 @@ AChm: TChmReader;
 AIndex: Integer;
 begin
   if not FileExists(AFileName) then exit;
-  AStream := TFileStream.Create(AFileName, fmOpenRead);
+  AStream := TFileStream.Create(AFileName, fmOpenRead, fmShareDenyWrite);
   AChm := TChmReader.Create(AStream, True);
   AIndex := AddObject(AFileName, AChm);
   fLastChm := AChm;

packages/chm/src/chmsitemap.pas

@@ -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;

packages/chm/src/chmtypes.pas

@@ -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;

packages/chm/src/chmwriter.pas

@@ -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  
+    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

packages/chm/src/paslzx.pas

@@ -593,7 +593,7 @@ begin
             i := bits.read(16, inpos);
             j := bits.read(16, inpos);
         end;
-        pState^.intel_filesize := (i shl 16) or j; ///* or 0 if not encoded */
+        pState^.intel_filesize := LongInt((i shl 16) or j); ///* or 0 if not encoded */
         pState^.header_read := 1;
     end;
 

utils/fpdoc/dw_htmlchm.inc

@@ -232,7 +232,8 @@ begin
       TOC.Items.Item[i].Children.Item[j].Children.Sort(TListSortCompare(@TOCSort));
     end;
   end;
-  
+
+  fchm.AppendBinaryTOCFromSiteMap(Toc);  
   TOC.SaveToStream(Stream);
   TOC.Free;
 
@@ -444,6 +445,7 @@ begin
   FChm.TempRawStream := FTempUncompressed;
   FChm.OnGetFileData := @RetrieveOtherFiles;
   FChm.OnLastFile := @LastFileAdded;
+  fchm.hasbinarytoc:=true;
   
   ProcessOptions;