--- Merging r24322 into '.':

U    packages/fcl-extra/src/win/daemonapp.inc
--- Merging r24457 into '.':
U    packages/fcl-extra/src/daemonapp.pp
--- Merging r24697 into '.':
U    packages/paszlib/src/ziputils.pas
--- Merging r24805 into '.':
U    packages/paszlib/src/zipper.pp
--- Merging r24979 into '.':
U    packages/chm/src/chmfilewriter.pas
U    packages/chm/src/chmwriter.pas
U    packages/chm/src/chmcmd.lpr
U    packages/chm/src/chmls.lpr
U    packages/chm/src/chmsitemap.pas
U    packages/chm/src/chmreader.pas
U    packages/chm/src/chmtypes.pas
--- Merging r25188 into '.':
U    compiler/cfileutl.pas

# revisions: 24322,24457,24697,24805,24979,25188
r24322 | michael | 2013-04-25 20:24:08 +0200 (Thu, 25 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-extra/src/win/daemonapp.inc

* Fixed Bug #24320 with patch as suggested by submitter
r24457 | michael | 2013-05-07 10:05:39 +0200 (Tue, 07 May 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-extra/src/daemonapp.pp

* Allow disable of registering of message file
r24697 | michael | 2013-06-01 12:18:57 +0200 (Sat, 01 Jun 2013) | 1 line
Changed paths:
   M /trunk/packages/paszlib/src/ziputils.pas

* Fix use of char as filename
r24805 | michael | 2013-06-04 17:48:42 +0200 (Tue, 04 Jun 2013) | 1 line
Changed paths:
   M /trunk/packages/paszlib/src/zipper.pp

* Changed sharing mode
r24979 | marco | 2013-06-26 16:31:30 +0200 (Wed, 26 Jun 2013) | 12 lines
Changed paths:
   M /trunk/packages/chm/src/chmcmd.lpr
   M /trunk/packages/chm/src/chmfilewriter.pas
   M /trunk/packages/chm/src/chmls.lpr
   M /trunk/packages/chm/src/chmreader.pas
   M /trunk/packages/chm/src/chmsitemap.pas
   M /trunk/packages/chm/src/chmtypes.pas
   M /trunk/packages/chm/src/chmwriter.pas

 * First set of patches for making mergable CHM files, committed after a point with 0 regressions.
    * IDXHDR internal file added.
    * better defaults for [Windows] lines.
    * Avoid duplication topic if both in index and separately in hhp. Size reduction for many hhp scenarios, no difference for fpdoc
    * System section 13 (copy of idxhdr)
    * index/toc files registered as topic type 2. (incontents field)
      * duplicate code for creating topics cleaned up, all now use addtopic
    * correct number of topics in system file.
    * some bugfixes in binary index.
    * some more global properties supported in sitemaps.

 * many extra (dumping) options for chmls tool.
r25188 | jonas | 2013-07-30 15:39:32 +0200 (Tue, 30 Jul 2013) | 2 lines
Changed paths:
   M /trunk/compiler/cfileutl.pas

  * only call findclose if findfirst succeeded

git-svn-id: branches/fixes_2_6@25473 -

compiler/cfileutl.pas

@@ -288,8 +288,8 @@ end;
                     DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
                 end;
             until findnext(dir) <> 0;
+            findclose(dir);
           end;
-        findclose(dir);
       end;
 
 
@@ -1109,8 +1109,8 @@ end;
                         end;
                     end;
                 until findnext(dir) <> 0;
+                FindClose(dir);
               end;
-            FindClose(dir);
 {$endif usedircache}
             if not subdirfound then
               WarnNonExistingPath(currpath);

packages/chm/src/chmcmd.lpr

@@ -25,7 +25,7 @@ program chmcmd;
 uses
   Classes, Sysutils, chmfilewriter, GetOpts;
 
-Const 
+Const
   CHMCMDVersion = '2.6.0';
 
 Procedure Usage;
@@ -129,7 +129,7 @@ begin
        except
          on e:exception do
            begin
-             Writeln('This HHP CHM project seems corrupt, please check it ',name);
+             Writeln('This HHP CHM project seems corrupt, please check it ',name,' (', e.message,')');
              halt(1);
            end;
        end;

packages/chm/src/chmfilewriter.pas

@@ -63,6 +63,10 @@ type
     FSpareString   : TStringIndex;
     FBasePath      : String;     // location of the .hhp file. Needed to resolve relative paths
     FReadmeMessage : String;     // readme message
+    FToc,
+    FIndex         : TCHMSiteMap;
+    FTocStream,
+    FIndexStream   : TMemoryStream;
   protected
     function GetData(const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean;
     procedure LastFileAdded(Sender: TObject);
@@ -79,6 +83,7 @@ type
     procedure SaveToFile(AFileName: String); virtual;
     procedure WriteChm(AOutStream: TStream); virtual;
     function ProjectDir: String;
+    procedure LoadSitemaps;
     procedure AddFileWithContext(contextid:integer;filename:ansistring;contextname:ansistring='');
     procedure Error(errorkind:TChmProjectErrorKind;msg:String;detaillevel:integer=0);
     // though stored in the project file, it is only there for the program that uses the unit
@@ -139,45 +144,32 @@ end;
 
 procedure TChmProject.LastFileAdded(Sender: TObject);
 var
-  IndexStream: TFileStream;
-  TOCStream: TFileStream;
   Writer: TChmWriter;
-  TOCSitemap  : TChmSiteMap;
-  IndexSiteMap: TChmSiteMap;
 begin
   // Assign the TOC and index files
   Writer := TChmWriter(Sender);
   {$ifdef chmindex}
     Writeln('binindex filename ',IndexFileName);
   {$endif}
-  if (IndexFileName <> '') and FileExists(IndexFileName) then begin
-    IndexStream := TFileStream.Create(IndexFileName, fmOpenRead);
-    Writer.AppendIndex(IndexStream);
+  if assigned(FIndexStream) then
+    begin
+    FIndexStream.position:=0;
+    Writer.AppendIndex(FIndexStream);
     if MakeBinaryIndex then
     begin
       {$ifdef chmindex}
         Writeln('into binindex ');
       {$endif}
-      IndexStream.Position := 0;
-      IndexSitemap := TChmSiteMap.Create(stIndex);
-      indexSitemap.LoadFromStream(IndexStream);
-      Writer.AppendBinaryIndexFromSiteMap(IndexSitemap,False);
-      IndexSitemap.Free;
+      Writer.AppendBinaryIndexFromSiteMap(FIndex,False);
     end;
-    IndexStream.Free;
   end;
-  if (TableOfContentsFileName <> '') and FileExists(TableOfContentsFileName) then begin
-    TOCStream := TFileStream.Create(TableOfContentsFileName, fmOpenRead);
-    Writer.AppendTOC(TOCStream);
+  if assigned(FTocStream) then
+    begin
+    Writer.AppendTOC(FTOCStream);
     if MakeBinaryTOC then
     begin
-      TOCStream.Position := 0;
-      TOCSitemap := TChmSiteMap.Create(stTOC);
-      TOCSitemap.LoadFromStream(TOCStream);
-      Writer.AppendBinaryTOCFromSiteMap(TOCSitemap);
-      TOCSitemap.Free;
+      Writer.AppendBinaryTOCFromSiteMap(FToc);
     end;
-    TOCStream.Free;
   end;
   if not assigned(sender) then
     Writer.Free;
@@ -210,6 +202,10 @@ begin
   FTotalFileList.FreeAndClear;
   FTotalFileList.Free;
   fAllowedExtensions.Free;
+  FToc.free;
+  FIndex.free;
+  FTocStream.Free;
+  FIndexStream.Free;
   inherited Destroy;
 end;
 
@@ -401,7 +397,7 @@ procedure addalias(const key,value :string);
 
 var i,j : integer;
     node: TCHMContextNode;
-    keyupper : string;
+    keyupper,valueupper : string;
 begin
  { Defaults other than global }
    MakeBinaryIndex:=True;
@@ -419,7 +415,9 @@ begin
     writeln('alias new node:',key);
    {$endif}
     node:=TCHMContextNode.create;
-    node.URLName:=value;
+    valueupper:=stringReplace(value, '\', '/', [rfReplaceAll]);
+    valueupper:= StringReplace(valueupper, '//', '/', [rfReplaceAll]);
+    node.URLName:=valueupper;
     node.contextname:=key;
   end
  else
@@ -552,7 +550,7 @@ begin
     for j:=0 to strs.count-1 do
       begin
           nd:=TChmContextNode.Create;
-          nd.urlname:=strs[j];
+          nd.urlname:=StringReplace(strs[j],'\', '/', [rfReplaceAll]);
           nd.contextnumber:=0;
           nd.contextname:='';
           Files.AddObject(nd.urlname,nd);
@@ -941,7 +939,6 @@ var
   helplist,
   localfilelist: TStringList;
   i      : integer;
-  x      : TChmSiteMap;
   strrec : TStringIndex;
 begin
 
@@ -974,45 +971,29 @@ begin
      otherfiles.addstrings(localfilelist);
      localfilelist.clear;
    end;
- if FTableOfContentsFileName<>'' then
+ if assigned(FToc) then
    begin
-     if fileexists(FTableOfContentsFileName) then
-       begin
        Error(chmnote,'Scanning TOC file : '+FTableOfContentsFileName+'.',3);
-        x:=TChmSiteMap.Create(sttoc);
         try
-          x.loadfromfile(FTableOfcontentsFilename);
-          scansitemap(x,localfilelist,true);
+          scansitemap(ftoc,localfilelist,true);
           otherfiles.addstrings(localfilelist);
         except
           on e: Exception do
-            error(chmerror,'Error loading TOC file '+FTableOfContentsFileName);
+            error(chmerror,'Error scanning TOC file ('+FTableOfContentsFileName+')');
           end;
-        x.free;
-       end
-     else
-       error(chmerror,'Can''t find TOC file'+FTableOfContentsFileName);
    end;
   LocalFileList.clear;
-  if FIndexFileName<>'' then
-   begin
-     if fileexists(FIndexFileName) then
-       begin
-       Error(chmnote,'Scanning Index file : '+FIndexFileName+'.',3);
-        x:=TChmSiteMap.Create(stindex);
-        try
-          x.loadfromfile(FIndexFileName);
-          scansitemap(x,localfilelist,true);
-          otherfiles.addstrings(localfilelist);
-        except
-          on e: Exception do
-            error(chmerror,'Error loading index file '+FIndexFileName);
-          end;
-        x.free;
-       end
-     else
-       error(chmerror,'Can''t find TOC index file '+FIndexFileName);
-   end;
+  if assigned(FIndex) then
+    begin
+      Error(chmnote,'Scanning Index file : '+FIndexFileName+'.',3);
+      try
+        scansitemap(FIndex,localfilelist,true);
+        otherfiles.addstrings(localfilelist);
+      except
+        on e: Exception do
+          error(chmerror,'Error scanning index file ('+FIndexFileName+')');
+        end;
+    end;
  localfilelist.free;
 end;
 
@@ -1025,8 +1006,10 @@ var
   nd         : TChmContextNode;
   I          : Integer;
 begin
-  // Scan html for "rest" files.
 
+  LoadSiteMaps;
+
+  // Scan html for "rest" files.
   If ScanHtmlContents Then
     ScanHtml;                 // Since this is slowing we opt to skip this step, and only do this on html load.
 
@@ -1056,6 +1039,7 @@ begin
   Writer.IndexName := ExtractFileName(IndexFileName);
   Writer.TocName   := ExtractFileName(TableOfContentsFileName);
   Writer.ReadmeMessage := ReadmeMessage;
+  Writer.DefaultWindow := FDefaultWindow;
   for i:=0 to files.count-1 do
     begin
       nd:=TChmContextNode(files.objects[i]);
@@ -1066,6 +1050,10 @@ begin
     end;
   if FWIndows.Count>0 then
     Writer.Windows:=FWIndows;
+  if FMergeFiles.Count>0 then
+    Writer.Mergefiles:=FMergeFiles;
+  if assigned(ftoc) then
+    Writer.TocSitemap:=ftoc;
 
   // and write!
 
@@ -1078,6 +1066,54 @@ begin
   Writer.Free;
 end;
 
+procedure TChmProject.LoadSitemaps;
+// #IDXHDR (merged files) goes into the system file, and need to keep  TOC sitemap around
+begin
+   if FTableOfContentsFileName<>'' then
+   begin
+     if fileexists(FTableOfContentsFileName) then
+       begin
+         FTocStream:=TMemoryStream.Create;
+         try
+           FTocStream.loadfromfile(FTableOfContentsFilename);
+           writeln(ftableofcontentsfilename, ' ' ,ftocstream.size);
+           FTocStream.Position:=0;
+           FToc:=TChmSiteMap.Create(sttoc);
+           FToc.loadfromstream(FTocStream);
+           ftoc.savetofile('bla.something');
+         except
+          on e:exception do
+            begin
+               error(chmerror,'Error loading TOC file '+FTableOfContentsFileName);
+               freeandnil(ftoc); freeandnil(FTocStream);
+             end;
+           end;
+       end
+     else
+       error(chmerror,'Can''t find TOC file'+FTableOfContentsFileName);
+   end;
+   if FIndexFileName<>'' then
+   begin
+     if fileexists(FIndexFileName) then
+       begin
+        FIndexStream:=TMemoryStream.Create;
+        try
+          FIndexStream.LoadFromFile(FIndexFileName);
+          FIndexStream.Position:=0;
+          FIndex:=TChmSiteMap.Create(stindex);
+          FIndex.loadfromfile(FIndexFileName);
+        except
+          on e: Exception do
+            begin
+              error(chmerror,'Error loading index file '+FIndexFileName);
+              freeandnil(findex); freeandnil(findexstream);
+            end;
+          end;
+       end
+     else
+       error(chmerror,'Can''t find index file '+FIndexFileName);
+   end;
+end;
 
 
 end.

packages/chm/src/chmls.lpr

@@ -1,4 +1,8 @@
 { Copyright (C) <2005> <Andrew Haines> chmls.lpr
+  Mostly rewritten by Marco van de Voort 2009-2012
+
+  An util that concentrates on listing and decompiling various sections
+   of a CHM.
 
   This library is free software; you can redistribute it and/or modify it
   under the terms of the GNU Library General Public License as published by
@@ -13,8 +17,7 @@
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-}
-{
+
   See the file COPYING, included in this distribution,
   for details about the copyright.
 }
@@ -28,8 +31,10 @@ program chmls;
 
 uses
   Classes, GetOpts, SysUtils, Types,
+  StreamEx,
   chmreader, chmbase, chmsitemap;
 
+{$R-} // CHM spec puts "-1" in dwords etc.
 type
 
   { TListObject }
@@ -49,11 +54,11 @@ type
     procedure OnFileEntry(Name: String; Offset, UncompressedSize, ASection: Integer);
   end;
 
-
-  TCmdEnum = (cmdList,cmdExtract,cmdExtractall,cmdUnblock,cmdextractalias,cmdextracttoc,cmdextractindex,cmdNone);        // One dummy element at the end avoids rangecheck errors.
+Type
+  TCmdEnum = (cmdList,cmdExtract,cmdExtractall,cmdUnblock,cmdextractalias,cmdextracttoc,cmdextractindex,cmdprintidxhdr,cmdprintsystem,cmdprintwindows,cmdprinttopics,cmdNone);        // One dummy element at the end avoids rangecheck errors.
 
 Const
-  CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','EXTRACTALIAS','EXTRACTTOC','EXTRACTINDEX','');
+  CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','EXTRACTALIAS','EXTRACTTOC','EXTRACTINDEX','PRINTIDXHDR','PRINTSYSTEM','PRINTWINDOWS','PRINTTOPICS','');
 
 var
   theopts : array[1..4] of TOption;
@@ -89,6 +94,15 @@ begin
   writeln(stderr,'            Extracts the toc (mainly to check binary TOC)');
   writeln(stderr,' extractindex <chmfilename> [filename]');
   writeln(stderr,'            Extracts the index (mainly to check binary index)');
+  writeln(stderr,' printidxhdr <chmfilename>');
+  writeln(stderr,'            prints #IDXHDR in readable format ');
+  writeln(stderr,' printsystem <chmfilename>');
+  writeln(stderr,'            prints #SYSTEM in readable format ');
+  writeln(stderr,' printwindows <chmfilename>');
+  writeln(stderr,'            prints #WINDOWS in readable format ');
+  writeln(stderr,' printtopics <chmfilename>');
+  writeln(stderr,'            prints #TOPICS in readable format ');
+
   Halt(1);
 end;
 
@@ -286,7 +300,7 @@ begin
   if (length(readfrom)>1) and (readfrom[1]<>'/') then
     readfrom:='/'+readfrom;
 
-  fs:=TFileStream.create(chm,fmOpenRead);
+  fs:=TFileStream.create(chm,fmOpenRead or fmShareDenyNone);
   r:=TChmReader.Create(fs,True);
   m:=r.getobject(readfrom);
   if assigned(m) then
@@ -453,7 +467,452 @@ begin
  Files.Free;
 end;
 
-const 
+
+procedure readchunk13(m:TMemoryStream;r:TChmReader);
+
+var i,cnt,cnt2: integer;
+    s : ansistring;
+
+procedure fetchstring;
+
+begin
+  cnt:=m.ReadDWordLE;
+  s:='';
+  if (cnt>0) then
+   s:=r.readstringsentry(cnt);
+end;
+
+
+begin
+  setlength(s,4);
+  for i:=1 to 4 do
+    s[i]:=ansichar(m.readbyte);
+  Writeln('Identifier tag                                :',s);
+  Writeln('Unknown timestamp/checksum                    :',leton(m.readdword));
+  Writeln('Always 1                                      :',leton(m.readdword));
+  Writeln('Number of topic nodes incl. contents & index  :',leton(m.readdword));
+  Writeln('    The following are mostly parameters of the "text/site properties" object of the sitemap contents');
+  Writeln('0 (meaning unknown)                           :',leton(m.readdword));
+  fetchstring;
+  Writeln('Imagelist param index in #strings (0,-1=none) :',cnt);
+  if (cnt>0) then
+      writeln('    = ',s);
+  Writeln('0 (meaning unknown)                           :',leton(m.readdword));
+  cnt:=m.ReadDWordLE;
+  if cnt=1 then
+    s:='Folder'
+  else
+    if cnt=0 then
+      s:='None'
+    else
+      s:='unknown value!';
+  Writeln('imagetype param text/site.                    :',cnt,' = ',s);
+  Writeln('Background value                              :',inttohex(leton(m.readdword),8));
+  Writeln('Foreground value                              :',inttohex(leton(m.readdword),8));
+  fetchstring;
+  Writeln('Font  param index in #strings (0,-1=none)     :',cnt);
+  if (cnt>0) then
+      writeln('    = ',s);
+  Writeln('Windows Styles                                :',inttohex(leton(m.readdword),8));
+  Writeln('ExWindows Styles                              :',inttohex(leton(m.readdword),8));
+  Writeln('Unknown, often -1 or 0                        :',leton(m.readdword));
+  FetchString;
+  Write  ('Framename                                     :',cnt);
+  if (cnt>0) then
+      write('    = ',s);
+  Writeln;
+  FetchString;
+  Writeln('Windowname                                    :',cnt);
+  if (cnt>0) then
+      writeln('    = ',s);
+  Writeln('Number of Information Types                   :',leton(m.readdword));
+  Writeln('Unknown. Often 1. Also 0, 3.                  :',leton(m.readdword));
+  cnt2:=m.ReadDWordLE;
+  Writeln('Number of files in the [MERGE FILES] list     :',cnt2);
+  Writeln('Unknown. Often 0.                             :',leton(m.readdword),'(Non-zero mostly in files with some files in the merge files list)');
+  if cnt2>0 then
+    for i:=0 to cnt2-1 do
+      begin
+        fetchstring;
+        Writeln(' Offset ', cnt, ' = ',s);
+      end;
+end;
+
+procedure PrintIDXHDR(filespec:TStringDynArray);
+
+var s,
+    chm,
+    prefixfn,
+    symbolname : ansistring;
+    i,cnt,cnt2: integer;
+    cl : TList;
+    x : PcontextItem;
+    f : textfile;
+    fs: TFileStream;
+    r : TChmReader;
+    m : TMemorystream;
+
+
+begin
+  symbolname:='helpid';
+  chm:=filespec[0];
+  prefixfn:=changefileext(chm,'');
+  if not Fileexists(chm) then
+    begin
+      writeln(stderr,' Can''t find file ',chm);
+      halt(1);
+    end;
+  fs:=TFileStream.create(chm,fmOpenRead);
+  r:=TCHMReader.create(fs,true);
+  m:=r.getobject('/#IDXHDR');
+  if not assigned(m) then
+    begin
+      writeln(stderr,'This CHM doesn''t contain a #IDXHDR internal file');
+      halt(1);
+    end;
+  m.position:=0;
+  Writeln(' --- #IDXHDR ---');
+  readchunk13(m,r);
+  m.free;
+  r.free;
+end;
+
+
+procedure PrintWindows(filespec:TStringDynArray);
+
+var s,
+    chm,
+    prefixfn,
+    symbolname : ansistring;
+    i,cnt,cnt2: integer;
+    x : PcontextItem;
+    f : textfile;
+    fs: TFileStream;
+    r : TChmReader;
+    m : TMemorystream;
+
+function fetchstring:string;
+
+var xx : longint;
+begin
+  xx:=m.ReadDWordLE;
+  if (xx>0) then
+    result:=r.readstringsentry(xx)+ ' (index value = '+inttostr(xx)+')'
+  else
+    result:='(0)';
+end;
+
+function printstructsize(sz:integer):string;
+
+begin
+ case sz of
+       188 : result:='Compatibility 1.0';
+       196 : result:='Compatibility 1.1 or later';
+      else
+       result:='unknown';
+       end;
+end;
+
+begin
+  chm:=filespec[0];
+  prefixfn:=changefileext(chm,'');
+  if not Fileexists(chm) then
+    begin
+      writeln(stderr,' Can''t find file ',chm);
+      halt(1);
+    end;
+  fs:=TFileStream.create(chm,fmOpenRead);
+  r:=TCHMReader.create(fs,true);
+  m:=r.getobject('/#WINDOWS');
+  if not assigned(m) then
+    begin
+      writeln(stderr,'This CHM doesn''t contain a #WINDOWS internal file. Odd.');
+      halt(1);
+    end;
+  m.position:=0;
+  cnt:=m.ReadDWordLE;
+  Writeln('Entries in #Windows                         : ',Cnt);
+  cnt2:=m.ReadDWordLE;
+  Writeln('Structure size                              : ',cnt2, ' = ',printstructsize(Cnt2));
+  writeln;
+  i:=0;
+  while (i<cnt) do
+    begin
+      cnt2:=m.ReadDWordLE;
+      Writeln('00 Structure size                            : ',cnt2, ' = ',printstructsize(Cnt2));
+
+      Writeln('04 htmlhelp.h indicates "BOOL fUniCodeStrings: ',m.ReadDWordLE);
+      Writeln('08 WindowType                                : ',fetchstring);
+      cnt2:=m.ReadDWordLE;
+      Write  ('0C Which window properties are valid         : ');
+      if (cnt2 and $00002)>0 then Write(' "Navigation pane style"');
+      if (cnt2 and $00004)>0 then Write(' "Window style flags"');
+      if (cnt2 and $00008)>0 then Write(' "Window extended style flags"');
+      if (cnt2 and $00010)>0 then Write(' "Initial window position"');
+      if (cnt2 and $00020)>0 then Write(' "Navigation pane width"');
+      if (cnt2 and $00040)>0 then Write(' "Window show state"');
+      if (cnt2 and $00080)>0 then Write(' "Info types"');
+      if (cnt2 and $00100)>0 then Write(' "Buttons"');
+      if (cnt2 and $00200)>0 then Write(' "Navigation Pane initially closed state"');
+      if (cnt2 and $00400)>0 then Write(' "Tab position"');
+      if (cnt2 and $00800)>0 then Write(' "Tab order"');
+      if (cnt2 and $01000)>0 then Write(' "History count"');
+      if (cnt2 and $02000)>0 then Write(' "Default Pane"');
+      writeln(' ( = ',inttohex(cnt2,8),')');
+      Writeln('10 A bit field of navigation pane styles     : ',inttohex(m.readdwordLE,8));
+      Writeln('14 Title Bar Text                            : ',fetchstring);
+      Writeln('18 Style Flags                               : ',inttohex(m.readdwordLE,8));
+      Writeln('1C Extended Style Flags                      : ',inttohex(m.readdwordLE,8));
+      Writeln('20 Initial position (left,top,right,bottom   : ',m.readdwordLE,' ' ,m.readdwordLE,' ',m.readdwordLE,' ',m.readdwordLE);
+      Writeln('30 Window ShowState                          : ',inttohex(m.readdwordLE,8));
+      Writeln('34 HWND hwndHelp; OUT: window handle"        : ',inttohex(m.readdwordLE,8));
+      Writeln('38 HWND hwndCaller; OUT: who called window"  : ',inttohex(m.readdwordLE,8));
+      Writeln('3C HH_INFOTYPE* paInfoTypes                  : ',inttohex(m.readdwordLE,8));
+      Writeln('40 HWND hwndToolBar;                         : ',inttohex(m.readdwordLE,8));
+      Writeln('44 HWND hwndNavigation;                      : ',inttohex(m.readdwordLE,8));
+      Writeln('48 HWND hwndHTML;                            : ',inttohex(m.readdwordLE,8));
+      Writeln('4C Width of the navigation pane in pixels    : ',inttohex(m.readdwordLE,8));
+      Writeln('50 Topic panel coordinates left,top,right,bottom : ',m.readdwordLE,' ' ,m.readdwordLE,' ',m.readdwordLE,' ',m.readdwordLE);
+      Writeln('60 TOC File                                  : ',fetchstring);
+      Writeln('64 Index File                                : ',fetchstring);
+      Writeln('68 Default File                              : ',fetchstring);
+      Writeln('6C File when Home button is pressed          : ',fetchstring);
+      inc(i);
+
+    end;
+
+  m.free;
+  r.free;
+end;
+
+procedure PrintTopics(filespec:TStringDynArray);
+var s,
+    chm,
+    prefixfn,
+    symbolname : ansistring;
+    i,cnt,cnt2: integer;
+    cl : TList;
+    x : PcontextItem;
+    f : textfile;
+    fs: TFileStream;
+    r : TChmReader;
+    m : TMemorystream;
+    chunktype,
+    chunksize : Word;
+
+    entries : integer;
+begin
+  chm:=filespec[0];
+  prefixfn:=changefileext(chm,'');
+  if not Fileexists(chm) then
+    begin
+      writeln(stderr,' Can''t find file ',chm);
+      halt(1);
+    end;
+  fs:=TFileStream.create(chm,fmOpenRead);
+  r:=TCHMReader.create(fs,true);
+  m:=r.getobject('/#TOPICS');
+  if not assigned(m) then
+    begin
+      writeln(stderr,'This CHM doesn''t contain a #SYSTEM internal file. Odd.');
+      halt(1);
+    end;
+  m.position:=0;
+  entries:=m.size div 16;
+  if entries>0 then
+    for i:=0 to entries-1 do
+      begin
+        writeln('#TOPICS entry : ',i);
+        cnt:=m.ReadDWordLE;
+        writeln(' TOCIDX index:',cnt,5);
+        write  (' Tag name    :');
+        cnt2:=m.ReadDWordLE;
+        if cnt2=-1 then
+          writeln(cnt2)
+        else
+         begin
+           s:=r.ReadStringsEntry(cnt2);
+           writeln(s,'(',cnt2,')');
+         end;
+        write  (' Tag value   :');
+        cnt2:=m.ReadDWordLE;
+        if cnt2=-1 then
+          writeln(cnt2)
+        else
+         begin
+           s:=r.ReadUrlStr(cnt2);
+           writeln(s,'(',cnt2,')');
+         end;
+        cnt2:=m.ReadWordLE;
+        writeln(' contents val:',cnt2, '(2=not in contents, 6 in contents, 0/4 unknown)');
+        cnt2:=m.ReadWordLE;
+        writeln(' unknown val :',cnt2, '(0,2,4,8,10,12,16,32)');
+      end;
+  m.free;
+  r.free;
+end;
+
+procedure PrintSystem(filespec:TStringDynArray);
+
+var s,
+    chm,
+    prefixfn,
+    symbolname : ansistring;
+    i,cnt,cnt2: integer;
+    cl : TList;
+    x : PcontextItem;
+    f : textfile;
+    fs: TFileStream;
+    r : TChmReader;
+    m : TMemorystream;
+    chunktype,
+    chunksize : Word;
+
+procedure fetchstring;
+
+begin
+  cnt:=m.ReadDWordLE;
+  s:='';
+  if (cnt>0) then
+   s:=r.readstringsentry(cnt);
+end;
+
+
+function printnulterminated(sz:word):string;
+begin
+ setlength(result,sz);
+ if sz>0 then
+   begin
+     m.read(result[1],sz);
+   end;
+end;
+
+procedure printentry4(m:TMemoryStream;chsz:dword);
+var q : QWord;
+    ts : TFileTime;
+begin
+  writeln('(4)');
+  if chsz<32 then
+    begin
+      Writeln('   is too small', chsz, ' bytes instead of 32');
+      m.position:=m.position+chsz;
+      exit;
+    end;
+  writeln(' LCID from HHP file                : ',m.readdwordLE );
+  writeln(' One if DBCS in use                : ',m.readdwordLE );
+  writeln(' one if fullttext search is on     : ',m.readdwordLE );
+  writeln(' Non zero if there are KLinks      : ',m.readdwordLE );
+  writeln(' Non zero if there are ALinks      : ',m.readdwordLE );
+  ts.dwlowdatetime:=m.readdwordLE;
+  ts.dwhighdatetime:=m.readdwordLE;
+  writeln(' Timestamp                         : ',ts.dwhighdatetime,':', ts.dwlowdatetime );
+  writeln(' 0/1 except in dsmsdn.chi has 1    : ',m.readdwordLE );
+  writeln(' 0 (unknown)                       : ',m.readdwordLE );
+end;
+
+procedure printentry8(m:TMemoryStream;chsz:dword);
+var q : QWord;
+    ts : TFileTime;
+begin
+  writeln('(8)');
+  if chsz<16 then
+    begin
+      Writeln('   is too small', chsz, ' bytes instead of 16');
+      m.position:=m.position+chsz;
+      exit;
+    end;
+  writeln(' 0 (or 4 in some)                  : ',m.readdwordLE );
+  fetchstring;
+  writeln(' Abbreviation                      : ',cnt,' = ',s);
+  writeln(' 3 or 5 depending on 1st field     : ',m.readdwordLE );
+  fetchstring;
+  writeln(' Abbreviation explanation          : ',cnt,' = ',s);
+  if chsz>16 then
+    writeln('   x size is larger than 16');
+  m.position:=m.position+chsz-16;
+end;
+
+begin
+  symbolname:='helpid';
+  chm:=filespec[0];
+  prefixfn:=changefileext(chm,'');
+  if not Fileexists(chm) then
+    begin
+      writeln(stderr,' Can''t find file ',chm);
+      halt(1);
+    end;
+  fs:=TFileStream.create(chm,fmOpenRead);
+  r:=TCHMReader.create(fs,true);
+  m:=r.getobject('/#SYSTEM');
+  if not assigned(m) then
+    begin
+      writeln(stderr,'This CHM doesn''t contain a #SYSTEM internal file. Odd.');
+      halt(1);
+    end;
+  m.position:=0;
+  cnt:=m.ReadDWordLE;
+  case cnt of
+   2 : s:='Compatibility 1.0';
+   3 : s:='Compatibility 1.1 or later';
+  else
+   s:='unknown';
+   end;
+
+  Writeln(' --- #SYSTEM---');
+
+  while (m.size-m.position)>=8 do
+    begin
+      chunktype := m.readwordle;
+      Chunksize := m.readwordle;
+      if (m.size-m.position)>=chunksize then
+        begin
+          case chunktype of
+            0 : Writeln('(0)  Contents file from [options]  :',printnulterminated(chunksize));
+            1 : Writeln('(1)  Index file from [options]     :',printnulterminated(chunksize));
+            2 : Writeln('(2)  Default topic from [options]  :',printnulterminated(chunksize));
+            3 : Writeln('(3)  Title from [options]          :',printnulterminated(chunksize));
+            4 : printentry4(m,chunksize);
+            5 : Writeln('(5)  Default Window from [options] :',printnulterminated(chunksize));
+            6 : Writeln('(6)  Compiled file from [options]  :',printnulterminated(chunksize));
+            7 : Writeln('(7)  DWord when Binary Index is on :',m.readdwordle, '(= entry in #urltbl has same first dword');
+            8 : printentry8(m,chunksize);
+            9 : Writeln('(9)  CHM compiler version          :',printnulterminated(chunksize));
+            10: begin
+                  writeln('(10) Timestamp (32-bit?)           :',m.readdwordle);
+                  m.position:=m.position+chunksize-4;
+                end;
+            11: Writeln('(11)  DWord when Binary TOC is on   :',m.readdwordle, '(= entry in #urltbl has same first dword');
+            12: begin
+                  writeln('(12) Number of Information files   :',m.readdwordle);
+                  m.position:=m.position+chunksize-4;
+                end;
+            13: begin
+                  cnt:=m.position;
+                  Writeln('(13)');
+                  readchunk13(m,r);
+                  m.position:=chunksize+cnt;
+                end;
+            14: begin
+                  writeln('(14) MS Office related windowing constants ', chunksize,' bytes');
+                  m.position:=m.position+chunksize;
+                end;
+            15: Writeln('(15) Information type checksum     :',m.readdwordle,' (Unknown algorithm & data source)');
+            16: Writeln('(16) Default Font from [options]   :',printnulterminated(chunksize));
+          else
+            begin
+              writeln('Not (yet) handled chunk, type ',chunktype,' of size ',chunksize);
+              m.position:=m.position+chunksize;
+            end;
+
+          end;
+        end;
+    end;
+
+  m.free;
+  r.free;
+end;
+
+const
    siteext : array[TSiteMapType] of string = ('.hhc','.hhk');
 
 procedure extracttocindex(filespec:TStringDynArray;sttype:TSiteMapType);
@@ -604,18 +1063,43 @@ begin
                         else
                           WrongNrParam(cmdnames[cmd],length(localparams));
                        end;
-       cmdextracttoc : begin
+      cmdextracttoc : begin
                         if length(localparams)>0 then
                           extracttocindex(localparams,sttoc)
                         else
                           WrongNrParam(cmdnames[cmd],length(localparams));
                        end;
-       cmdextractindex: begin
+      cmdextractindex: begin
                         if length(localparams)>0 then
                           extracttocindex(localparams,stindex)
 	                        else
                           WrongNrParam(cmdnames[cmd],length(localparams));
                        end;
+
+      cmdprintidxhdr: begin
+                        if length(localparams)=1 then
+                          printidxhdr(localparams)
+	                else
+                          WrongNrParam(cmdnames[cmd],length(localparams));
+                       end;
+      cmdprintsystem   : begin
+                          if length(localparams)=1 then
+                            printsystem(localparams)
+                          else
+                            WrongNrParam(cmdnames[cmd],length(localparams));
+                         end;
+      cmdprintwindows  : begin
+                          if length(localparams)=1 then
+                            printwindows(localparams)
+                          else
+                            WrongNrParam(cmdnames[cmd],length(localparams));
+                         end;
+      cmdprinttopics   : begin
+                          if length(localparams)=1 then
+                            printtopics(localparams)
+                          else
+                            WrongNrParam(cmdnames[cmd],length(localparams));
+                         end;
       end; {case cmd of}
   end
  else

packages/chm/src/chmreader.pas

@@ -109,16 +109,15 @@ type
     fDefaultWindow: String;
   private
     FSearchReader: TChmSearchReader;
+  public
     procedure ReadCommonData;
     function  ReadStringsEntry(APosition: DWord): String;
     function  ReadStringsEntryFromStream ( strm:TStream ) : String;
     function  ReadURLSTR(APosition: DWord): String;
     function  CheckCommonStreams: Boolean;
     procedure ReadWindows(mem:TMemoryStream);
-  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(ForceXML:boolean=false): TChmSiteMap;
@@ -1079,9 +1078,32 @@ begin
 end;
 
 procedure parselistingblock(p:pbyte);
+var
+    itemstack:TObjectStack;
+    curitemdepth : integer;
+    parentitem:TChmSiteMap;
+
+procedure updateparentitem(entrydepth:integer);
+begin
+  if entrydepth>curitemdepth then
+    begin
+      if curitemdepth<>0 then
+        itemstack.push(parentitem);
+      curitemdepth:=entrydepth;
+    end
+  else
+   if entrydepth>curitemdepth then
+    begin
+      if curitemdepth<>0 then
+        itemstack.push(parentitem);
+      curitemdepth:=entrydepth;
+    end
+end;
+
 var hdr:PBTreeBlockHeader;
     head,tail : pbyte;
     isseealso,
+    entrydepth,
     nrpairs : Integer;
     i : integer;
     PE : PBtreeBlockEntry;
@@ -1091,8 +1113,8 @@ var hdr:PBTreeBlockHeader;
     seealsostr,
     topic,
     Name : AnsiString;
-    item : TChmSiteMapItem;
 begin
+  //setlength (curitem,10);
   hdr:=PBTreeBlockHeader(p);
   hdr^.Length          :=LEToN(hdr^.Length);
   hdr^.NumberOfEntries :=LEToN(hdr^.NumberOfEntries);
@@ -1102,10 +1124,12 @@ begin
   tail:=p+(2048-hdr^.length);
   head:=p+sizeof(TBtreeBlockHeader);
 
+  itemstack:=TObjectStack.create;
   {$ifdef binindex}
   writeln('previndex  : ',hdr^.IndexOfPrevBlock);
   writeln('nextindex  : ',hdr^.IndexOfNextBlock);
   {$endif}
+  curitemdepth:=0;
   while head<tail do
     begin
       if not ReadWCharString(Head,Tail,Name) Then
@@ -1118,13 +1142,14 @@ begin
       PE :=PBtreeBlockEntry(head);
       NrPairs  :=LEToN(PE^.nrpairs);
       IsSeealso:=LEToN(PE^.isseealso);
+      EntryDepth:=LEToN(PE^.entrydepth);
       CharIndex:=LEToN(PE^.CharIndex);
       {$ifdef binindex}
-        Writeln('seealso:     ',IsSeeAlso);
-        Writeln('entrydepth:  ',LEToN(PE^.entrydepth));
+        Writeln('seealso   :  ',IsSeeAlso);
+        Writeln('entrydepth:  ',EntryDepth);
         Writeln('charindex :  ',charindex );
         Writeln('Nrpairs   :  ',NrPairs);
-        writeln('seealso data : ');
+        Writeln('CharIndex :  ',charindex);
       {$endif}
 
       inc(head,sizeof(TBtreeBlockEntry));
@@ -1133,10 +1158,22 @@ begin
           if not ReadWCharString(Head,Tail,SeeAlsoStr) Then
             Break;
           // have to figure out first what to do with it.
+          // is See Also really mutually exclusive with pairs?
+          // or is the number of pairs equal to the number of seealso
+          // strings?
+          {$ifdef binindex}
+            writeln('seealso: ',seealsostr);
+          {$endif}
+
         end
       else
         begin
          if NrPairs>0 Then
+          begin
+            {$ifdef binindex}
+             writeln('Pairs   : ');
+            {$endif}
+
             for i:=0 to nrpairs-1 do
               begin
                 if head<tail Then
@@ -1151,6 +1188,7 @@ begin
                   end;
               end;
           end;
+         end;
       if nrpairs<>0 Then
         createentry(Name,CharIndex,Topic,Title);
       inc(head,4); // always 1
@@ -1183,9 +1221,10 @@ begin
    SiteMap:=TChmSitemap.Create(StIndex);
    Item   :=Nil;  // cached last created item, in case we need to make
                   // a child.
+
    TryTextual:=True;
    BHdr.LastLstBlock:=0;
-   if LoadBtreeHeader(index,BHdr) and (BHdr.LastLstBlock>0) Then
+   if LoadBtreeHeader(index,BHdr) and (BHdr.LastLstBlock>=0) Then
     begin
        if BHdr.BlockSize=defblocksize then
          begin

packages/chm/src/chmsitemap.pas

@@ -18,7 +18,7 @@
   See the file COPYING.FPC, included in this distribution,
   for details about the copyright.
 }
-unit chmsitemap; 
+unit chmsitemap;
 
 {$mode objfpc}{$H+}
 
@@ -26,11 +26,11 @@ interface
 
 uses
   Classes, SysUtils, fasthtmlparser;
-  
+
 type
   TChmSiteMapItems = class; // forward
   TChmSiteMap = class;
-  
+
   { TChmSiteMapItem }
 
   TChmSiteMapItem = class(TPersistent)
@@ -45,6 +45,9 @@ type
     FSeeAlso: String;
     FText: String;
     FURL: String;
+    FMerge : String;
+    FFrameName : String;
+    FWindowName : String;
     procedure SetChildren(const AValue: TChmSiteMapItems);
   public
     constructor Create(AOwner: TChmSiteMapItems);
@@ -60,10 +63,11 @@ type
     property IncreaseImageIndex: Boolean read FIncreaseImageIndex write FIncreaseImageIndex;
     property Comment: String read FComment write FComment;
     property Owner: TChmSiteMapItems read FOwner;
-    //property FrameName: String read FFrameName write FFrameName;
-    //property WindowName: String read FWindowName write FWindowName;
-    //property Type_: Integer read FType_ write FType_; either Local or URL
-    //property Merge: Boolean read FMerge write FMerge;
+
+    property FrameName: String read FFrameName write FFrameName;
+    property WindowName: String read FWindowName write FWindowName;
+//    property Type_: Integer read FType_ write FType_; either Local or URL
+    property Merge: String read FMerge write FMerge;
   end;
 
   { TChmSiteMapItems }
@@ -194,6 +198,7 @@ var
   //TagAttribute,
   TagAttributeName,
   TagAttributeValue: String;
+  isParam,IsMerged : string;
 begin
   //WriteLn('TAG:', AActualTag);
   TagName := GetTagName(ACaseInsensitiveTag);
@@ -241,40 +246,77 @@ begin
          end;
        end
        else begin // we are the properties of the object tag
-         if (FLevel > 0 ) and (smbtOBJECT in FSiteMapBodyTags) then begin
-
-           if LowerCase(GetTagName(AActualTag)) = 'param' then begin
-
-             TagAttributeName := GetVal(AActualTag, 'name');
-             TagAttributeValue := GetVal(AActualTag, 'value');
-
-             if TagAttributeName <> '' then begin
-               if CompareText(TagAttributeName, 'keyword') = 0 then begin
-                 ActiveItem.Text := TagAttributeValue;
-               end
-               else if CompareText(TagAttributeName, 'name') = 0 then begin
-                 if ActiveItem.Text = '' then ActiveItem.Text := TagAttributeValue;
-               end
-               else if CompareText(TagAttributeName, 'local') = 0 then begin
-                 ActiveItem.Local := TagAttributeValue;
-               end
-               else if CompareText(TagAttributeName, 'URL') = 0 then begin
-                 ActiveItem.URL := TagAttributeValue;
-               end
-               else if CompareText(TagAttributeName, 'ImageNumber') = 0 then begin
-                 ActiveItem.ImageNumber := StrToInt(TagAttributeValue);
-               end
-               else if CompareText(TagAttributeName, 'New') = 0 then begin
-                 ActiveItem.IncreaseImageIndex := (LowerCase(TagAttributeValue) = 'yes');
-               end
-               else if CompareText(TagAttributeName, 'Comment') = 0 then begin
-                 ActiveItem.Comment := TagAttributeValue;
-               end;
-               //else if CompareText(TagAttributeName, '') = 0 then begin
-               //end;
+         if (smbtOBJECT in FSiteMapBodyTags) then
+           begin
+            if (FLevel > 0 ) then 
+             begin
+
+              if LowerCase(GetTagName(AActualTag)) = 'param' then begin
+
+                TagAttributeName := GetVal(AActualTag, 'name');
+                TagAttributeValue := GetVal(AActualTag, 'value');
+                //writeln('name,value',tagattributename, ' ',tagattributevalue);
+                if TagAttributeName <> '' then begin
+                  if CompareText(TagAttributeName, 'keyword') = 0 then begin
+                    ActiveItem.Text := TagAttributeValue;
+                  end
+                  else if CompareText(TagAttributeName, 'name') = 0 then begin
+                    if ActiveItem.Text = '' then ActiveItem.Text := TagAttributeValue;
+                  end
+                  else if CompareText(TagAttributeName, 'local') = 0 then begin
+                    ActiveItem.Local := TagAttributeValue;
+                  end
+                  else if CompareText(TagAttributeName, 'URL') = 0 then begin
+                    ActiveItem.URL := TagAttributeValue;
+                  end
+                  else if CompareText(TagAttributeName, 'ImageNumber') = 0 then begin
+                    ActiveItem.ImageNumber := StrToInt(TagAttributeValue);
+                  end
+                  else if CompareText(TagAttributeName, 'New') = 0 then begin
+                    ActiveItem.IncreaseImageIndex := (LowerCase(TagAttributeValue) = 'yes');
+                  end
+                  else if CompareText(TagAttributeName, 'Comment') = 0 then begin
+                    ActiveItem.Comment := TagAttributeValue
+                  end
+                  else if CompareText(TagAttributeName, 'Merge') = 0 then begin
+                    ActiveItem.Merge:= TagAttributeValue
+                  end;
+                  //else if CompareText(TagAttributeName, '') = 0 then begin
+                  //end;
+                end;
+              end;
+            end
+           else
+             begin // object and level is zero?
+               if LowerCase(GetTagName(AActualTag)) = 'param' then begin
+                 begin
+                   TagAttributeName := uppercase(GetVal(AActualTag, 'name'));
+                   TagAttributeValue := GetVal(AActualTag, 'value');
+                   if TagAttributeName = 'FRAMENAME' then
+                     framename:=TagAttributeValue
+                   else
+                     if TagAttributeName = 'WINDOWNAME' then
+                       WINDOWname:=TagAttributeValue
+                   else
+                     if TagAttributeName = 'WINDOW STYLES' then
+                       WindowStyles:=StrToIntDef(TagAttributeValue,0)
+                   else
+                     if TagAttributeName = 'EXWINDOW STYLES' then
+                       ExWindowStyles:=StrToIntDef(TagAttributeValue,0)
+                   else
+                     if TagAttributeName = 'FONT' then
+                       FONT:=TagAttributeValue
+                   else
+                     if TagAttributeName = 'IMAGELIST' then
+                      IMAGELIST:=TagAttributeValue
+                    else
+                     if TagAttributeName = 'IMAGETYPE' then
+                      UseFolderImages:=uppercase(TagAttributeValue)='FOLDER';
+                  // writeln('0:',flevel,' ' ,aactualtag,' ',tagname,' ' ,tagattributename, ' ' ,tagattributevalue);
+                 end;
+                 end;
              end;
-           end;
-         end;
+          end;
        end;
      end;
   //end
@@ -346,7 +388,7 @@ begin
     fs.free;
     end;
 end;
-                    
+
 procedure TChmSiteMap.SaveToStream(AStream: TStream);
 var
   Indent: Integer;
@@ -407,7 +449,7 @@ begin
   WriteString('<meta name="GENERATOR" content="Microsoft&reg; HTML Help Workshop 4.1">');  // Should we change this?
   WriteString('<!-- Sitemap 1.0 -->');
   WriteString('</HEAD><BODY>');
-  
+
   // Site Properties
   WriteString('<OBJECT type="text/site properties">');
   Inc(Indent, 8);

packages/chm/src/chmtypes.pas

@@ -240,6 +240,8 @@ type
 
 function PageBookInfoRecordSize(ARecord: PTOCEntryPageBookInfo): Integer;
 
+Const defvalidflags = [valid_Navigation_pane_style,valid_Window_style_flags,valid_Initial_window_position,valid_Navigation_pane_width,valid_Buttons,valid_Tab_position];
+
 implementation
 uses chmbase;
 
@@ -485,22 +487,20 @@ var ind,len,
     arr     : array[0..3] of integer;
     s2      : string;
 begin
-  flags:=[];
   j:=pos('=',txt);
   if j>0 then
     txt[j]:=',';
   ind:=1; len:=length(txt);
   window_type       :=getnext(txt,ind,len);
   Title_bar_text    :=getnext(txt,ind,len);
-  index_file        :=getnext(txt,ind,len);
   Toc_file          :=getnext(txt,ind,len);
+  index_file        :=getnext(txt,ind,len);
   Default_File      :=getnext(txt,ind,len);
   Home_button_file  :=getnext(txt,ind,len);
   Jumpbutton_1_File :=getnext(txt,ind,len);
   Jumpbutton_1_Text :=getnext(txt,ind,len);
   Jumpbutton_2_File :=getnext(txt,ind,len);
   Jumpbutton_2_Text :=getnext(txt,ind,len);
-
   nav_style         :=getnextint(txt,ind,len,flags,valid_navigation_pane_style);
   navpanewidth      :=getnextint(txt,ind,len,flags,valid_navigation_pane_width);
   buttons           :=getnextint(txt,ind,len,flags,valid_buttons);
@@ -588,6 +588,7 @@ end;
 Constructor TCHMWindow.create(s:string='');
 
 begin
+ flags:=defvalidflags;
  if s<>'' then
    load_from_ini(s);
 end;

packages/chm/src/chmwriter.pas

@@ -23,7 +23,7 @@ unit chmwriter;
 { $DEFINE LZX_USETHREADS}
 
 interface
-uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, contnrs, Avl_Tree{$IFDEF LZX_USETHREADS}, lzxcompressthread{$ENDIF};
+uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, contnrs, StreamEx, Avl_Tree{$IFDEF LZX_USETHREADS}, lzxcompressthread{$ENDIF};
 
 Const
    DefaultHHC = 'Default.hhc';
@@ -147,11 +147,13 @@ Type
     FURLSTRStream: TMemoryStream;  // the #URLSTR file
     FFiftiMainStream: TMemoryStream;
     FContextStream: TMemoryStream; // the #IVB file
+    FIDXHdrStream : TMemoryStream; // the #IDXHDR and chunk 13 in #SYSTEM
     FTitle: String;
     FHasTOC: Boolean;
     FHasIndex: Boolean;
     FIndexedFiles: TIndexedWordList;
     FAvlStrings   : TAVLTree;    // dedupe strings
+    FAVLTopicdedupe : TAVlTree;  // Topic deduping, if we load it both from hhp and TOC
     FAvlURLStr    : TAVLTree;    // dedupe urltbl + binindex must resolve URL to topicid
     SpareString   : TStringIndex;
     SpareUrlStr   : TUrlStrIndex;
@@ -159,6 +161,10 @@ Type
     FDefaultWindow: String;
     FTocName      : String;
     FIndexName    : String;
+    FMergeFiles   : TStringList;
+    FTocSM        : TCHMSitemap;
+    FHasKLinks    : Boolean;
+    FNrTopics     : Integer;
   protected
     procedure FileAdded(AStream: TStream; const AEntry: TFileEntryRec); override;
   private
@@ -170,6 +176,8 @@ Type
     procedure WriteSTRINGS;
     procedure WriteTOPICS;
     procedure WriteIVB; // context ids
+    procedure CreateIDXHDRStream;
+    procedure WriteIDXHDR;
     procedure WriteURL_STR_TBL;
     procedure WriteOBJINST;
     procedure WriteFiftiMain;
@@ -178,10 +186,11 @@ Type
     function AddString(AString: String): LongWord;
     function AddURL(AURL: String; TopicsIndex: DWord): LongWord;
     procedure CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
-    function AddTopic(ATitle,AnUrl:AnsiString):integer;
+    function AddTopic(ATitle,AnUrl:AnsiString;code:integer=-1):integer;
+    procedure ScanSitemap(asitemap:TCHMSiteMap);
     function NextTopicIndex: Integer;
     procedure Setwindows (AWindowList:TObjectList);
-
+    procedure SetMergefiles(src:TStringList);
   public
     constructor Create(AOutStream: TStream; FreeStreamOnDestroy: Boolean); override;
     destructor Destroy; override;
@@ -193,6 +202,7 @@ Type
     procedure AppendIndex(AStream: TStream);
     procedure AppendSearchDB(AName: String; AStream: TStream);
     procedure AddContext(AContext: DWord; ATopic: String);
+    procedure AddDummyALink;
 
     property Title: String read FTitle write FTitle;
     property FullTextSearch: Boolean read FFullTextSearch write FFullTextSearch;
@@ -205,6 +215,8 @@ Type
     property TOCName : String read FTocName write FTocName;
     property IndexName : String read FIndexName write FIndexName;
     property DefaultWindow : string read fdefaultwindow write fdefaultwindow;
+    property MergeFiles :TStringList read FMergeFiles write setmergefiles;
+    property Tocsitemap :TChmSitemap read ftocsm write ftocsm;
   end;
 
 Function CompareStrings(Node1, Node2: Pointer): integer; // also used in filewriter
@@ -932,7 +944,7 @@ begin
 end;
 
 
-procedure TChmWriter.WriteSystem;
+procedure TChmWriter.WriteSYSTEM;
 var
   Entry: TFileEntryRec;
   TmpStr: String;
@@ -941,7 +953,6 @@ const
   VersionStr = 'HHA Version 4.74.8702'; // does this matter?
 begin
 
-
   // this creates the /#SYSTEM file
   Entry.Name := '#SYSTEM';
   Entry.Path := '/';
@@ -977,10 +988,11 @@ begin
   FSection0.WriteWord(NToLE(Word(36))); // size
 
   FSection0.WriteDWord(NToLE(DWord($0409)));
-  FSection0.WriteDWord(1);
-  FSection0.WriteDWord(NToLE(DWord(Ord(FFullTextSearch and FFullTextSearchAvailable))));
-  FSection0.WriteDWord(0);
   FSection0.WriteDWord(0);
+  FSection0.WriteDWord(NToLE(DWord(Ord(FFullTextSearch and FFullTextSearchAvailable))));
+
+  FSection0.WriteDWord(NToLE(Dword(Ord(FHasKLinks))) ); // klinks
+  FSection0.WriteDWord(0); // alinks
 
   // two for a QWord
   FSection0.WriteDWord(0);
@@ -990,8 +1002,6 @@ begin
   FSection0.WriteDWord(0);
 
 
-
-
   ////////////////////////<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
   // 2  default page to load
   if FDefaultPage <> '' then begin
@@ -1077,6 +1087,14 @@ begin
   end;
 
 
+  // 13
+  if FIDXHdrStream.size>0 then
+  begin
+    FSection0.WriteWord(NToLE(Word(13)));
+    FSection0.WriteWord(NToLE(Word(FIDXHdrStream.size)));
+    FSection0.copyfrom(FIDXHdrStream,0);
+  end;
+
   Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
   FInternalFiles.AddEntry(Entry);
 end;
@@ -1104,11 +1122,14 @@ begin
 end;
 
 procedure TChmWriter.WriteTOPICS;
-//var
-  //FHits: Integer;
 begin
   if FTopicsStream.Size = 0 then
     Exit;
+  if tocname<>'' then
+    AddTopic('',self.TOCName,2);
+  if indexname<>'' then
+    AddTopic('',self.IndexName,2);
+
   FTopicsStream.Position := 0;
   PostAddStreamToArchive('#TOPICS', '/', FTopicsStream);
  // I commented the code below since the result seemed unused
@@ -1116,6 +1137,14 @@ begin
  //   FIndexedFiles.ForEach(@IterateWord,FHits);
 end;
 
+procedure TChmWriter.WriteIDXHDR;
+begin
+  if FIDXHdrStream.Size = 0 then
+    Exit;
+  FIDXHdrStream.Position := 0;
+  PostAddStreamToArchive('#IDXHDR', '/', FIDXHdrStream);
+end;
+
 procedure TChmWriter.WriteIVB;
 begin
   if FContextStream = nil then exit;
@@ -1128,6 +1157,98 @@ begin
   AddStreamToArchive('#IVB', '/', FContextStream);
 end;
 
+const idxhdrmagic ='T#SM';
+
+procedure TChmWriter.CreateIDXHDRStream;
+var i : Integer;
+begin
+   if fmergefiles.count=0 then  // I assume text/site properties could also trigger idxhdr
+     exit;
+
+   FIDXHdrStream.setsize(4096);
+   FIDXHdrStream.position:=0;
+   FIDXHdrStream.write(idxhdrmagic[1],4);     //  0 Magic
+   FIDXHdrStream.writedword(ntole(1));        //  4 Unknown timestamp/checksum
+   FIDXHdrStream.writedword(ntole(1));        //  8 1 (unknown)
+   FIDXHdrStream.writedword(ntole(FNrTopics));        //  C Number of topic nodes including the contents & index files
+   FIDXHdrStream.writedword(ntole(0));        // 10 0 (unknown)
+
+   // 14 Offset in the #STRINGS file of the ImageList param of the "text/site properties" object of the sitemap contents (0/-1 = none)
+   if assigned(ftocsm) and (ftocsm.ImageList<>'') then
+     FIDXHdrStream.writedwordLE(addstring(ftocsm.ImageList))
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   // 18 0 (unknown)
+   FIDXHdrStream.writedwordLE(0);
+
+   // 1C 1 if the value of the ImageType param of the "text/site properties" object of the sitemap contents is Folder. 0 otherwise.
+   if assigned(ftocsm) and (ftocsm.UseFolderImages) then
+     FIDXHdrStream.writedwordLE(1)
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   // 20 The value of the Background param of the "text/site properties" object of the sitemap contents
+   if assigned(ftocsm) then
+     FIDXHdrStream.writedwordLE(ftocsm.Backgroundcolor)
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   // 24 The value of the Foreground param of the "text/site properties" object of the sitemap contents
+   if assigned(ftocsm) then
+     FIDXHdrStream.writedwordLE(ftocsm.Foregroundcolor)
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   // 28 Offset in the #STRINGS file of the Font param of the "text/site properties" object of the sitemap contents (0/-1 = none)
+   if assigned(ftocsm) and (ftocsm.Font<>'') then
+     FIDXHdrStream.writedwordLE(addstring(ftocsm.font))
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   // 2C The value of the Window Styles param of the "text/site properties" object of the sitemap contents
+   if assigned(ftocsm) then
+     FIDXHdrStream.writedwordLE(FTocsm.WindowStyles)
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   // 30 The value of the EXWindow Styles param of the "text/site properties" object of the sitemap contents
+   if assigned(ftocsm) then
+     FIDXHdrStream.writedwordLE(FTocSm.ExWindowStyles)
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   // 34 Unknown. Often -1. Sometimes 0.
+   FIDXHdrStream.writedwordLE(0);
+
+   // 38 Offset in the #STRINGS file of the FrameName param of the "text/site properties" object of the sitemap contents (0/-1 = none)
+   if assigned(ftocsm) and (ftocsm.framename<>'') then
+     FIDXHdrStream.writedwordLE(addstring(FTocsm.Framename))
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   // 3C Offset in the #STRINGS file of the WindowName param of the "text/site properties" object of the sitemap contents (0/-1 = none)
+   if assigned(ftocsm) and (ftocsm.windowname<>'') then
+     FIDXHdrStream.writedwordLE(addstring(FTocsm.windowname))
+   else
+     FIDXHdrStream.writedwordLE(0);
+   FIDXHdrStream.writedword(ntole(0));        // 40 Number of information types.
+   FIDXHdrStream.writedword(ntole(0));        // 44 Unknown. Often 1. Also 0, 3.
+   FIDXHdrStream.writedword(ntole(fmergefiles.count));        // 48 Number of files in the [MERGE FILES] list.
+
+   // 4C Unknown. Often 0. Non-zero mostly in files with some files in the merge files list.
+   if fmergefiles.count>0 then
+     FIDXHdrStream.writedwordLE(1)
+   else
+     FIDXHdrStream.writedwordLE(0);
+
+   for i:=0 to FMergefiles.count-1 do
+     FIDXHdrStream.WriteDword(addstring(fmergefiles[i]));
+
+   for i:=0 to 1004-fmergefiles.count-1 do
+    FIDXHdrStream.WriteDword(0);
+end;
+
 procedure TChmWriter.WriteURL_STR_TBL;
 begin
   if FURLSTRStream.Size <> 0 then begin
@@ -1295,8 +1416,8 @@ begin
       for i:=0 to FWindows.Count-1 Do
         begin
           Win:=TChmWindow(FWindows[i]);
-          WindowStream.WriteDword(NToLE(dword(196 )));                   //  0 size of entry.
-          WindowStream.WriteDword(NToLE(dword(0 )));                     //  4 unknown (bool Unicodestrings?)
+          WindowStream.WriteDwordLE (196);                               //  0 size of entry.
+          WindowStream.WriteDwordLE (0);                                 //  4 unknown (bool Unicodestrings?)
           WindowStream.WriteDword(NToLE(addstring(win.window_type )));   //  8 Arg 0, name of window
           WindowStream.WriteDword(NToLE(dword(win.flags )));             //  C valid fields
           WindowStream.WriteDword(NToLE(dword(win.nav_style)));          // 10 arg 10 navigation pane style
@@ -1353,6 +1474,8 @@ begin
   WriteITBITS;
   // This creates and writes the #SYSTEM file to section0
   WriteSystem;
+  if Assigned(FTocSM)  then
+   Scansitemap(FTocSM);
 end;
 
 procedure TChmWriter.WriteFinalCompressedFiles;
@@ -1360,8 +1483,10 @@ begin
   inherited WriteFinalCompressedFiles;
   WriteTOPICS;
   WriteURL_STR_TBL;
-  WriteSTRINGS;
   WriteWINDOWS;
+  CreateIDXHDRStream;
+  WriteIDXHDR;
+  WriteSTRINGS;
   WriteFiftiMain;
 end;
 
@@ -1388,30 +1513,38 @@ begin
   FURLTBLStream := TMemoryStream.Create;
   FFiftiMainStream := TMemoryStream.Create;
   FIndexedFiles := TIndexedWordList.Create;
+  FAVLTopicdedupe  :=TAVLTree.Create(@CompareStrings);  // dedupe filenames in topics.
   FAvlStrings   := TAVLTree.Create(@CompareStrings);    // dedupe strings
   FAvlURLStr    := TAVLTree.Create(@CompareUrlStrs);    // dedupe urltbl + binindex must resolve URL to topicid
   SpareString   := TStringIndex.Create;                 // We need an object to search in avltree
   SpareUrlStr   := TUrlStrIndex.Create;                 //    to avoid create/free circles we keep one in spare
+  FIDXHdrStream := TMemoryStream.Create;                // the #IDXHDR and chunk 13 in #SYSTEM
                                                         //    for searching purposes
   FWindows      := TObjectlist.Create(True);
   FDefaultWindow:= '';
+  FMergeFiles   :=TStringList.Create;
+  FNrTopics     :=0;
 end;
 
 destructor TChmWriter.Destroy;
 begin
   if Assigned(FContextStream) then FContextStream.Free;
+  FMergeFiles.Free;
   FIndexedFiles.Free;
   FStringsStream.Free;
   FTopicsStream.Free;
   FURLSTRStream.Free;
   FURLTBLStream.Free;
   FFiftiMainStream.Free;
+  FIDXHdrStream.Create;
   SpareString.free;
   SpareUrlStr.free;
   FAvlUrlStr.FreeAndClear;
   FAvlUrlStr.Free;
   FAvlStrings.FreeAndClear;
   FAvlStrings.Free;
+  FAVLTopicdedupe.FreeAndClear;
+  FAVLTopicdedupe.free;
   FWindows.Free;
 
   inherited Destroy;
@@ -1431,7 +1564,7 @@ begin
   SpareString.TheString:=AString;
   n:=fAvlStrings.FindKey(SpareString,@CompareStrings);
   if assigned(n) then
-   exit(TStringIndex(n.data).strid);
+    exit(TStringIndex(n.data).strid);
 
   // each entry is a null terminated string
   Pos := DWord(FStringsStream.Position);
@@ -1445,9 +1578,9 @@ begin
   end;
 
   Result := FStringsStream.Position;
-  FStringsStream.WriteBuffer(AString[1], Length(AString));
+  if length(AString)>0 Then
+    FStringsStream.WriteBuffer(AString[1], Length(AString));
   FStringsStream.WriteByte(0);
-
   StrRec:=TStringIndex.Create;
   StrRec.TheString:=AString;
   StrRec.Strid    :=Result;
@@ -1516,46 +1649,44 @@ begin
   FURLTBLStream.WriteDWord(NtoLE(UrlIndex));
 end;
 
-
-
 procedure TChmWriter.CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
-
-  var
+var
     TopicEntry: TTopicEntry;
     ATitle: String;
 begin
   if Pos('.ht', AFileEntry.Name) > 0 then
   begin
     ATitle := FIndexedFiles.IndexFile(AStream, NextTopicIndex, FSearchTitlesOnly);
-    if ATitle <> '' then
-      TopicEntry.StringsOffset := AddString(ATitle)
-    else
-      TopicEntry.StringsOffset := $FFFFFFFF;
-    TopicEntry.URLTableOffset := AddURL(AFileEntry.Path+AFileEntry.Name, NextTopicIndex);
-    TopicEntry.InContents := 2;
-    TopicEntry.Unknown := 0;
-    TopicEntry.TocOffset := 0;
-    FTopicsStream.WriteDWord(LEtoN(TopicEntry.TocOffset));
-    FTopicsStream.WriteDWord(LEtoN(TopicEntry.StringsOffset));
-    FTopicsStream.WriteDWord(LEtoN(TopicEntry.URLTableOffset));
-    FTopicsStream.WriteWord(LEtoN(TopicEntry.InContents));
-    FTopicsStream.WriteWord(LEtoN(TopicEntry.Unknown));
-  end;
+    AddTopic(ATitle,AFileEntry.Path+AFileEntry.Name,-1);
+ end;
 end;
 
-function TChmWriter.AddTopic(ATitle,AnUrl:AnsiString):integer;
+function TChmWriter.AddTopic(ATitle,AnUrl:AnsiString;code:integer=-1):integer;
 
 var
     TopicEntry: TTopicEntry;
 
 begin
+    anurl:=StringReplace(anurl, '\', '/', [rfReplaceAll]);
     if ATitle <> '' then
       TopicEntry.StringsOffset := AddString(ATitle)
     else
       TopicEntry.StringsOffset := $FFFFFFFF;
     result:=NextTopicIndex;
     TopicEntry.URLTableOffset := AddURL(AnUrl, Result);
-    TopicEntry.InContents := 2;
+    if code=-1 then
+      begin
+       if ATitle<>'' then
+         TopicEntry.InContents := 6
+       else
+         TopicEntry.InContents := 2;
+       if pos('#',AnUrl)>0 then
+         TopicEntry.InContents := 0;
+      end
+     else
+       TopicEntry.InContents := code;
+
+    inc(FNrTopics);
     TopicEntry.Unknown := 0;
     TopicEntry.TocOffset := 0;
     FTopicsStream.WriteDWord(LEtoN(TopicEntry.TocOffset));
@@ -1565,6 +1696,30 @@ begin
     FTopicsStream.WriteWord(LEtoN(TopicEntry.Unknown));
 end;
 
+procedure TChmWriter.ScanSitemap(asitemap:TCHMSiteMap);
+procedure scanitems(it:TChmSiteMapItems);
+
+var i : integer;
+    x : TChmSiteMapItem;
+    s : string;
+    strrec : TStringIndex;
+
+begin
+  for i:=0 to it.count -1 do
+    begin
+      x:=it.item[i];
+//      if sanitizeurl(fbasepath,x.local,S) then   // sanitize, remove stuff etc.
+//        begin
+//          writeln(x.text,' : ',x.local,' ',x.url,' ' ,x.merge);
+
+      if assigned(x.children) and (x.children.count>0) then
+        scanitems(x.children);
+    end;
+end;
+begin
+ scanitems(asitemap.items);
+end;
+
 function TChmWriter.NextTopicIndex: Integer;
 begin
   Result := FTopicsStream.Size div 16;
@@ -1807,28 +1962,40 @@ Var
   blocknplusentries : Integer;  // The other blocks indexed on creation.
   datastream,mapstream,propertystream : TMemoryStream;
 
-procedure preparecurrentblock;
-
+procedure preparecurrentblock(force:boolean);
 var p: PBTreeBlockHeader;
-
 begin
+  {$ifdef binindex}
+  writeln('prepcurblock ' ,Entries,' ',lastblock,' ' ,blocknr,' ',indexstream.position);
+  {$endif}
   p:=@curblock[0];
+  fillchar(p^,sizeof(TBtreeBlockHeader),#0);
   p^.Length:=NToLE(Defblocksize-curind);
   p^.NumberOfEntries:=Entries;
-  p^.IndexOfPrevBlock:=lastblock;
+  p^.IndexOfPrevBlock:=cardinal(lastblock); // lastblock can be -1, avoid rangecheck
   p^.IndexOfNextBlock:=Blocknr;
+  if force and (blocknr=0) then   // only one listblock -> no indexblocks.
+    p^.IndexOfNextBlock:=dword(-1);
   IndexStream.Write(curblock[0],Defblocksize);
+  fillchar(curblock[0],DefBlockSize,#0);
   MapStream.Write(NToLE(MapEntries),sizeof(dword));
   MapStream.Write(NToLE(BlockNr),Sizeof(DWord));
   MapEntries:=TotalEntries;
   curind:=sizeof(TBtreeBlockHeader);   // index into current block;
   lastblock:=blocknr;
   inc(blocknr);
+  Entries:=0;
+  {$ifdef binindex}
+  writeln('prepcurblock post' , indexstream.position);
+  {$endif}
 end;
 
 procedure prepareindexblockn(listingblocknr:integer);
 var p:PBTreeIndexBlockHeader;
 begin
+  {$ifdef binindex}
+  writeln('prepindexblockn');
+  {$endif}
   p:=@Blockn[IndexBlockNr];
   p^.Length:=defblocksize-BlockInd;
   p^.NumberOfEntries:=BlockEntries;
@@ -1838,18 +2005,21 @@ begin
   BlockEntries:=0;
   BlockInd:=0;
   if Indexblocknr>=length(blockn) then
-    setlength(blockn,length(blockn)+1);  // larger increments also possible. #blocks is kept independantly.
+    begin
+      setlength(blockn,length(blockn)+1);  // larger increments also possible. #blocks is kept independantly.
+      fillchar(blockn[0][0],sizeof(blockn[0]),#0);
+    end;
   p:=@Blockn[IndexBlockNr];
   p^.IndexOfChildBlock:=ListingBlockNr;
   blockind:=sizeof(TBTreeIndexBlockHeader);
 end;
 
-procedure finalizeindexblockn(p:pbyte;var ind:integer;Entries:integer);
+procedure finalizeindexblockn(p:pbyte;var ind:integer;xEntries:integer);
 var ph:PBTreeIndexBlockHeader;
 begin
   ph:=PBTreeIndexBlockHeader(p);
   ph^.Length:=defblocksize-Ind;
-  ph^.NumberOfEntries:=Entries;
+  ph^.NumberOfEntries:=xEntries;
 // p^.IndexOfChildBlock  // already entered on block creation, since of first entry, not last.
 //  inc(Ind);
 end;
@@ -1858,6 +2028,10 @@ procedure CurEntryToIndex(entrysize:integer);
 var p,pentry : pbyte;
     indexentrysize : integer;
 begin
+  {$ifdef binindex}
+  writeln('curentrytoindex ', entrysize);
+  {$endif}
+
   indexentrysize:=entrysize-sizeof(dword);         // index entry is 4 bytes shorter, and only the last dword differs
   if (blockind+indexentrysize)>=Defblocksize then
     prepareindexblockn(blocknr);
@@ -1877,6 +2051,7 @@ var p      : pbyte;
     i      : Integer;
 begin
   inc(TotalEntries);
+  fillchar(testblock[0],DefBlockSize,#0);
   p:=@TestBlock[0];
   for i:=1 to Length(str) do
     WriteWord(p,Word(str[i]));   // write the wstr in little endian
@@ -1886,7 +2061,7 @@ begin
  // else
 //    seealso:=2;
   WriteWord(p,seealso);          // =0 not a see also 2 =seealso
-  WriteWord(p,2);                // Entrydepth.  We can't know it, so write 2.
+  WriteWord(p,0);                // Entrydepth.  We can't know it, so write 2.
   WriteDword(p,commaatposition); // position of the comma
   WriteDword(p,0);               // unused 0
   WriteDword(p,1);               // for now only local pair.
@@ -1897,19 +2072,29 @@ begin
   WriteDword(p,mod13value);      //a value that increments with 13.
   mod13value:=mod13value+13;
   entrysize:=p-pbyte(@testblock[0]);
+  {$ifdef binindex}
+    writeln(curind, ' ',entrysize, ' ',defblocksize);
+  {$endif}
   if (curind+entrysize)>=Defblocksize then
     begin
-      preparecurrentblock;
+      {$ifdef binindex}
+      writeln('larger!');
+      {$endif}
+      preparecurrentblock(False);
       EntrytoIndex:=true;
     end;
   if EntryToIndex Then
     begin
+      {$ifdef binindex}
+      writeln('entrytoindex');
+      {$endif}
       CurEntryToIndex(entrysize);
       EntryToIndex:=False;
     end;
   move(testblock[0],curblock[curind],entrysize);
   inc(curind,entrysize);
   datastream.write(DataEntry,Sizeof(DataEntry));
+  inc(Entries);
 end;
 
 procedure MoveIndexEntry(nr:integer;bytes:integer;childblock:integer);
@@ -1931,7 +2116,10 @@ begin
       FinalizeIndexBlockn(@blocknplus1[blocknplusindex][0],blockind,blocknplusentries);
       inc(blocknplusindex);
       if blocknplusindex>=length(blocknplus1) then
-        setlength(blocknplus1,length(blocknplus1)+1);
+        begin
+          setlength(blocknplus1,length(blocknplus1)+1);
+          fillchar(blocknplus1[length(blocknplus1)-1][0],sizeof(blocknplus1[0]),#0);
+        end;
       blockInd:=Sizeof(TBTreeIndexBlockHeader);
       pdword(@blocknplus1[blocknplusindex][0])[4]:=NToLE(ChildBlock);  /// init 2nd level index to first 1st level index block
       end;
@@ -2035,17 +2223,28 @@ begin
   indexblocknr:=0;   // nr of first index block.
   BlockEntries:=0;   // entries into current block;
   MapEntries  :=0;   // entries before the current listing block, for MAP file
+  TreeDepth   :=0;
 
+  fillchar(testblock[0],DefBlockSize,#0);
+  fillchar(curblock[0],DefBlockSize,#0);
   curind      :=sizeof(TBTreeBlockHeader);      // index into current listing block;
   blockind    :=sizeof(TBtreeIndexBlockHeader); // index into current index block
 
   Setlength(blockn,1);
+  fillchar(blockn[0][0],sizeof(blockn[0]),#0);
   pdword(@blockn[0][4])^:=NToLE(0);  /// init first listingblock nr to 0 in the first index block
   EntryToIndex   := True;
+  {$ifdef binindex}
+  writeln('items:',asitemap.items.count);
+  {$endif}
   for i:=0 to ASiteMap.Items.Count-1 do
     begin
       item := TChmSiteMapItem(ASiteMap.Items.Item[i]);
       key  :=Item.Text;
+       {$ifdef binindex}
+        writeln('item: ',i,' ',key);
+       {$endif}
+
       {$ifdef chm_windowsbinindex}
       // append 2 to all index level 0 entries. This
       // so we can see if Windows loads the binary or textual index.
@@ -2054,10 +2253,10 @@ begin
       CombineWithChildren(Item,Key,length(key),true);
       {$endif}
     end;
-  PrepareCurrentBlock;     // flush last listing block.
+  PrepareCurrentBlock(True);     // flush last listing block.
+
   Listingblocks:=blocknr;   // blocknr is from now on the number of the first block in blockn.
                             // we still need the # of listingblocks for the header though
-
   {$ifdef binindex}
     writeln('binindex: listingblocks : '+inttostr(listingblocks),' indexblocks: ',indexblocknr,' entries:',blockentries);
   {$endif}
@@ -2067,70 +2266,75 @@ begin
   // and repeat until we have no entries left.
 
   // First we finalize the current set of blocks
-
-  if  Blockind<>sizeof(TBtreeIndexBlockHeader) Then
-    begin
-      {$ifdef binindex}
-        writeln('finalizing level 1 index');
-      {$endif}
-      FinalizeIndexBlockN(@blockn[indexblocknr][0],blockind,blockentries); // also increasing indexblocknr
-      inc(IndexBlockNr);
-    end;
-  {$ifdef binindex}
-    writeln('binindex: listingblocks : '+inttostr(listingblocks),' indexblocks: ',indexblocknr,' entries:',blockentries);
-  {$endif}
-
-
-  while (Indexblocknr>1) do
+  if blocknr>1 then
     begin
+      if  Blockind<>sizeof(TBtreeIndexBlockHeader) Then
+        begin
+          {$ifdef binindex}
+            writeln('finalizing level 1 index');
+          {$endif}
+          FinalizeIndexBlockN(@blockn[indexblocknr][0],blockind,blockentries); // also increasing indexblocknr
+          inc(IndexBlockNr);
+        end;
       {$ifdef binindex}
-        printloopvars(1);
+        writeln('binindex: listingblocks : '+inttostr(listingblocks),' indexblocks: ',indexblocknr,' entries:',blockentries);
       {$endif}
 
-      blockind      :=sizeof(TBtreeIndexBlockHeader);
-      pdword(@blockn[0][4])^:=NToLE(Listingblocks);  /// init 2nd level index to first 1st level index block
-      blocknplusindex     :=0;
-      blocknplusentries   :=0;
-      if length(blocknplus1)<1 then
-        Setlength(blocknplus1,1);
 
-      EntryToIndex        :=True;
-      {$ifdef binindex}
-        printloopvars(2);
-      {$endif}
-      for i:=0 to Indexblocknr-1 do
+      while (Indexblocknr>1) do
         begin
-          Entrybytes:=ScanIndexBlock(@blockn[i][0]);
-//          writeln('after scan ,',i, ' bytes: ',entrybytes,' blocknr:',blocknr,' indexblocknr:',indexblocknr,' to:',blocknr+i);
-          MoveIndexEntry(i,Entrybytes,blocknr+i);
-          indexStream.Write(blockn[i][0],defblocksize);
-        end;
+          {$ifdef binindex}
+            printloopvars(1);
+          {$endif}
 
-      {$ifdef binindex}
-        printloopvars(3);
-      {$endif}
+          blockind      :=sizeof(TBtreeIndexBlockHeader);
+          pdword(@blockn[0][4])^:=NToLE(Listingblocks);  /// init 2nd level index to first 1st level index block
+          blocknplusindex     :=0;
+          blocknplusentries   :=0;
+          if length(blocknplus1)<1 then
+            begin
+              Setlength(blocknplus1,1);
+              fillchar(blocknplus1[0][0],sizeof(blocknplus1[0]),#0);
+            end;
+
+          EntryToIndex        :=True;
+          {$ifdef binindex}
+            printloopvars(2);
+          {$endif}
+          for i:=0 to Indexblocknr-1 do
+            begin
+              Entrybytes:=ScanIndexBlock(@blockn[i][0]);
+    //          writeln('after scan ,',i, ' bytes: ',entrybytes,' blocknr:',blocknr,' indexblocknr:',indexblocknr,' to:',blocknr+i);
+              MoveIndexEntry(i,Entrybytes,blocknr+i);
+              indexStream.Write(blockn[i][0],defblocksize);
+            end;
 
-      If Blockind<>sizeof(TBtreeIndexBlockHeader) Then
-        begin
           {$ifdef binindex}
-            logentry('finalizing');
+            printloopvars(3);
           {$endif}
-          FinalizeIndexBlockn(@blocknplus1[blocknplusindex][0],blockind,blocknplusentries);
-          inc(blocknplusindex);
-        end;
 
-      inc(blocknr,indexblocknr);
+          If Blockind<>sizeof(TBtreeIndexBlockHeader) Then
+            begin
+              {$ifdef binindex}
+                logentry('finalizing');
+              {$endif}
+              FinalizeIndexBlockn(@blocknplus1[blocknplusindex][0],blockind,blocknplusentries);
+              inc(blocknplusindex);
+            end;
 
-      indexblocknr:=blocknplusindex;
-      blockn:=copy(blocknplus1); setlength(blocknplus1,1);
-      {$ifdef binindex}
-        printloopvars(5);
-      {$endif}
+          inc(blocknr,indexblocknr);
 
-      inc(TreeDepth);
+          indexblocknr:=blocknplusindex;
+          blockn:=copy(blocknplus1); setlength(blocknplus1,1);
+          {$ifdef binindex}
+            printloopvars(5);
+          {$endif}
+
+          inc(TreeDepth);
+        end;
+      indexStream.Write(blockn[0][0],defblocksize);
+      inc(blocknr);
     end;
-  indexStream.Write(blockn[0][0],defblocksize);
-  inc(blocknr);
   // Fixup header.
   hdr.ident[0]:=chr($3B); hdr.ident[1]:=chr($29);
   hdr.flags          :=NToLE(word($2));           // bit $2 is always 1, bit $0400 1 if dir? (always on)
@@ -2141,7 +2345,7 @@ begin
   hdr.indexrootblock :=NToLE(dword(blocknr-1));    // Index of the root block in the file.
   hdr.unknown1       :=NToLE(dword(-1));           // always -1
   hdr.nrblock        :=NToLE(blocknr);      // Number of blocks
-  hdr.treedepth      :=NToLE(TreeDepth);    // The depth of the tree of blocks (1 if no index blocks, 2 one level of index blocks, ...)
+  hdr.treedepth      :=NToLE(word(TreeDepth));    // The depth of the tree of blocks (1 if no index blocks, 2 one level of index blocks, ...)
   hdr.nrkeywords     :=NToLE(Totalentries); // number of keywords in the file.
   hdr.codepage       :=NToLE(dword(1252));         // Windows code page identifier (usually 1252 - Windows 3.1 US (ANSI))
   hdr.lcid           :=NToLE(0);            //  ???? LCID from the HHP file.
@@ -2165,6 +2369,7 @@ begin
   PropertyStream.Free;
   MapStream.Free;
   DataStream.Free;
+  FHasKLinks:=TotalEntries>0;
 end;
 
 procedure TChmWriter.AppendBinaryTOCStream(AStream: TStream);
@@ -2187,6 +2392,7 @@ begin
 end;
 
 begin
+  AddDummyALink;
   stadd('BTree',IndexStream);
   stadd('Data', DataStream);
   stadd('Map' , MapStream);
@@ -2226,7 +2432,17 @@ begin
   FContextStream.WriteDWord(Offset);
 end;
 
-procedure TChmWriter.SetWindows(AWindowList:TObjectList);
+procedure TChmWriter.AddDummyALink;
+var stream  : TMemoryStream;
+begin
+    stream:=tmemorystream.create;
+    stream.WriteDWord(0);
+    stream.position:=0;
+    AddStreamToArchive('Property','/$WWAssociativeLinks/',stream,True);
+    stream.free;
+end;
+
+procedure TChmWriter.Setwindows(AWindowList: TObjectList);
 
 var i : integer;
     x : TCHMWindow;
@@ -2240,6 +2456,13 @@ begin
     end;
 end;
 
+procedure TChmWriter.SetMergefiles(src:TStringList);
+var i : integer;
+begin
+  FMergeFiles.Clear;
+  for i:=0 to Src.count -1 do
+      FMergefiles.add(src[i]);
+end;
 
 end.
 

packages/fcl-extra/src/daemonapp.pp

@@ -335,6 +335,7 @@ Type
     FRunMode: TDaemonRunMode;
     FSysData: TObject;
     FControllerCount : Integer;
+    FAutoRegisterMessageFile : Boolean;
     procedure BindDaemonDefs(AMapper: TCustomDaemonMapper);
     function  InstallRun: Boolean;
     procedure SysInstallDaemon(Daemon: TCustomDaemon);
@@ -362,6 +363,7 @@ Type
     procedure DoLog(EventType: TEventType; const Msg: String); override;
     Property SysData : TObject Read FSysData Write FSysData;
   Public
+    Constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
     Procedure ShowException(E : Exception); override;
     Function CreateDaemon(DaemonDef : TDaemonDef) : TCustomDaemon;
@@ -376,6 +378,7 @@ Type
     Property GUIMainLoop : TGuiLoopEvent Read FGUIMainLoop Write FGuiMainLoop;
     Property GuiHandle : THandle Read FGUIHandle Write FGUIHandle;
     Property RunMode : TDaemonRunMode Read FRunMode;
+    Property AutoRegisterMessageFile : Boolean Read FAutoRegisterMessageFile Write FAutoRegisterMessageFile default true;
   end;
   TCustomDaemonApplicationClass = Class of TCustomDaemonApplication;
   
@@ -692,7 +695,6 @@ end;
 
 { TCustomServiceApplication }
 
-
 procedure TCustomDaemonApplication.CreateServiceMapper(Var AMapper : TCustomDaemonMapper);
 
 begin
@@ -794,7 +796,6 @@ Var
 
 begin
   FrunMode:=drmInstall;
-  EventLog.RegisterMessageFile('');
   SysStartInstallDaemons;
   try
     FMapper.DoOnInstall;
@@ -826,7 +827,8 @@ Var
 
 begin
   FrunMode:=drmUnInstall;
-  EventLog.UnRegisterMessageFile;
+  if FAutoRegisterMessageFile then
+    EventLog.UnRegisterMessageFile;
   SysStartUnInstallDaemons;
   Try
     FMapper.DoOnUnInstall;
@@ -919,7 +921,8 @@ begin
     begin
     FEventLog:=TEventlog.Create(Self);
     FEventLog.RaiseExceptionOnError:=False;
-    FEventLog.RegisterMessageFile('');
+    if FAutoRegisterMessageFile then
+      FEventLog.RegisterMessageFile('');
     end;
   result := FEventLog;
 end;
@@ -932,6 +935,13 @@ begin
   inherited Destroy;
 end;
 
+constructor TCustomDaemonApplication.Create(AOwner : TComponent);
+
+begin
+  inherited;
+  FAutoRegisterMessageFile:=True;
+end;
+
 procedure TCustomDaemonApplication.DoRun;
 
 begin

packages/fcl-extra/src/win/daemonapp.inc

@@ -368,6 +368,8 @@ begin
           else
             Terminate;
           end;
+        if not Terminated then
+          WaitMessage;  
       Until Terminated;
       end;
   finally

packages/paszlib/src/zipper.pp

@@ -1605,7 +1605,7 @@ Begin
   if Assigned(FOnOpenInputStream) then
     FOnOpenInputStream(Self, FZipStream);
   if FZipStream = nil then
-    FZipStream:=TFileStream.Create(FFileName,fmOpenRead);
+    FZipStream:=TFileStream.Create(FFileName,fmOpenRead or fmShareDenyWrite);
 End;
 
 

packages/paszlib/src/ziputils.pas

@@ -98,11 +98,11 @@ begin
   fp := nil;
   try
     case mode of
-      fopenread: fp  := TFileStream.Create(filename, fmOpenRead);
-      fopenwrite: fp := TFileStream.Create(filename, fmCreate);
+      fopenread: fp  := TFileStream.Create(strpas(filename), fmOpenRead);
+      fopenwrite: fp := TFileStream.Create(strpas(filename), fmCreate);
       fappendwrite:
       begin
-        fp := TFileStream.Create(filename, fmOpenReadWrite);
+        fp := TFileStream.Create(strpas(filename), fmOpenReadWrite);
         fp.Seek(soFromEnd, 0);
       end;
     end;
@@ -187,7 +187,7 @@ begin
   OldFileMode := FileMode;
 
   GetMem(fp, SizeOf(file));
-  Assign(fp^, filename);
+  Assign(fp^, strpas(filename));
   {$i-}
   Case mode of
   fopenread: