chmwriter.pas 40 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222
  1. { Copyright (C) <2005> <Andrew Haines> chmwriter.pas
  2. This library is free software; you can redistribute it and/or modify it
  3. under the terms of the GNU Library General Public License as published by
  4. the Free Software Foundation; either version 2 of the License, or (at your
  5. option) any later version.
  6. This program is distributed in the hope that it will be useful, but WITHOUT
  7. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  8. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  9. for more details.
  10. You should have received a copy of the GNU Library General Public License
  11. along with this library; if not, write to the Free Software Foundation,
  12. Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  13. }
  14. {
  15. See the file COPYING.FPC, included in this distribution,
  16. for details about the copyright.
  17. }
  18. unit chmwriter;
  19. {$MODE OBJFPC}{$H+}
  20. interface
  21. uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer;
  22. type
  23. TGetDataFunc = function (const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean of object;
  24. // DataName : A FileName or whatever so that the getter can find and open the file to add
  25. // PathInChm: This is the absolute path in the archive. i.e. /home/user/helpstuff/
  26. // becomes '/' and /home/user/helpstuff/subfolder/ > /subfolder/
  27. // FileName : /home/user/helpstuff/index.html > index.html
  28. // Stream : the file opened with DataName should be written to this stream
  29. { TChmWriter }
  30. TChmWriter = class(TObject)
  31. FOnLastFile: TNotifyEvent;
  32. private
  33. ForceExit: Boolean;
  34. FDefaultFont: String;
  35. FDefaultPage: String;
  36. FFullTextSearch: Boolean;
  37. FInternalFiles: TFileEntryList; // Contains a complete list of files in the chm including
  38. FFrameSize: LongWord; // uncompressed files and special internal files of the chm
  39. FCurrentStream: TStream; // used to buffer the files that are to be compressed
  40. FCurrentIndex: Integer;
  41. FOnGetFileData: TGetDataFunc;
  42. FSearchTitlesOnly: Boolean;
  43. FStringsStream: TMemoryStream; // the #STRINGS file
  44. FTopicsStream: TMemoryStream; // the #TOPICS file
  45. FURLTBLStream: TMemoryStream; // the #URLTBL file. has offsets of strings in URLSTR
  46. FURLSTRStream: TMemoryStream; // the #URLSTR file
  47. FFiftiMainStream: TMemoryStream;
  48. FContextStream: TMemoryStream; // the #IVB file
  49. FSection0: TMemoryStream;
  50. FSection1: TStream; // Compressed Stream
  51. FSection1Size: QWord;
  52. FSection1ResetTable: TMemoryStream; // has a list of frame positions NOT window positions
  53. FDirectoryListings: TStream;
  54. FOutStream: TStream;
  55. FFileNames: TStrings;
  56. FDestroyStream: Boolean;
  57. FTempStream: TStream;
  58. FPostStream: TStream;
  59. FTitle: String;
  60. FHasTOC: Boolean;
  61. FHasIndex: Boolean;
  62. FWindowSize: LongWord;
  63. FReadCompressedSize: QWord; // Current Size of Uncompressed data that went in Section1 (compressed)
  64. FIndexedFiles: TIndexedWordList;
  65. // Linear order of file
  66. ITSFHeader: TITSFHeader;
  67. HeaderSection0Table: TITSFHeaderEntry; // points to HeaderSection0
  68. HeaderSection1Table: TITSFHeaderEntry; // points to HeaderSection1
  69. HeaderSuffix: TITSFHeaderSuffix; //contains the offset of CONTENTSection0 from zero
  70. HeaderSection0: TITSPHeaderPrefix;
  71. HeaderSection1: TITSPHeader; // DirectoryListings header
  72. // DirectoryListings
  73. // CONTENT Section 0 (section 1 is contained in section 0)
  74. // EOF
  75. // end linear header parts
  76. procedure InitITSFHeader;
  77. procedure InitHeaderSectionTable;
  78. procedure SetTempRawStream(const AValue: TStream);
  79. procedure WriteHeader(Stream: TStream);
  80. procedure CreateDirectoryListings;
  81. procedure WriteDirectoryListings(Stream: TStream);
  82. procedure StartCompressingStream;
  83. procedure WriteSYSTEM;
  84. procedure WriteITBITS;
  85. procedure WriteSTRINGS;
  86. procedure WriteTOPICS;
  87. procedure WriteIVB; // context ids
  88. procedure WriteURL_STR_TBL;
  89. procedure WriteOBJINST;
  90. procedure WriteFiftiMain;
  91. procedure WriteREADMEFile;
  92. procedure WriteFinalCompressedFiles;
  93. procedure WriteSection0;
  94. procedure WriteSection1;
  95. procedure WriteDataSpaceFiles(const AStream: TStream);
  96. function AddString(AString: String): LongWord;
  97. function AddURL(AURL: String; TopicsIndex: DWord): LongWord;
  98. procedure CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
  99. // callbacks for lzxcomp
  100. function AtEndOfData: Longbool;
  101. function GetData(Count: LongInt; Buffer: PByte): LongInt;
  102. function WriteCompressedData(Count: Longint; Buffer: Pointer): LongInt;
  103. procedure MarkFrame(UnCompressedTotal, CompressedTotal: LongWord);
  104. // end callbacks
  105. public
  106. constructor Create(OutStream: TStream; FreeStreamOnDestroy: Boolean);
  107. destructor Destroy; override;
  108. procedure Execute;
  109. procedure AppendTOC(AStream: TStream);
  110. procedure AppendIndex(AStream: TStream);
  111. procedure AppendSearchDB(AName: String; AStream: TStream);
  112. procedure AddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
  113. procedure PostAddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
  114. procedure AddContext(AContext: DWord; ATopic: String);
  115. property WindowSize: LongWord read FWindowSize write FWindowSize default 2; // in $8000 blocks
  116. property FrameSize: LongWord read FFrameSize write FFrameSize default 1; // in $8000 blocks
  117. property FilesToCompress: TStrings read FFileNames;
  118. property OnGetFileData: TGetDataFunc read FOnGetFileData write FOnGetFileData;
  119. property OnLastFile: TNotifyEvent read FOnLastFile write FOnLastFile;
  120. property OutStream: TStream read FOutStream;
  121. property Title: String read FTitle write FTitle;
  122. property FullTextSearch: Boolean read FFullTextSearch write FFullTextSearch;
  123. property SearchTitlesOnly: Boolean read FSearchTitlesOnly write FSearchTitlesOnly;
  124. property DefaultFont: String read FDefaultFont write FDefaultFont;
  125. property DefaultPage: String read FDefaultPage write FDefaultPage;
  126. property TempRawStream: TStream read FTempStream write SetTempRawStream;
  127. //property LocaleID: dword read ITSFHeader.LanguageID write ITSFHeader.LanguageID;
  128. end;
  129. implementation
  130. uses dateutils, sysutils, paslzxcomp, chmFiftiMain;
  131. const
  132. LZX_WINDOW_SIZE = 16; // 16 = 2 frames = 1 shl 16
  133. LZX_FRAME_SIZE = $8000;
  134. {$I chmobjinstconst.inc}
  135. { TChmWriter }
  136. procedure TChmWriter.InitITSFHeader;
  137. begin
  138. with ITSFHeader do begin
  139. ITSFsig := ITSFFileSig;
  140. Version := NToLE(DWord(3));
  141. // we fix endian order when this is written to the stream
  142. HeaderLength := NToLE(DWord(SizeOf(TITSFHeader) + (SizeOf(TITSFHeaderEntry)*2) + SizeOf(TITSFHeaderSuffix)));
  143. Unknown_1 := NToLE(DWord(1));
  144. TimeStamp:= NToBE(MilliSecondOfTheDay(Now)); //bigendian
  145. LanguageID := NToLE(DWord($0409)); // English / English_US
  146. Guid1 := ITSFHeaderGUID;
  147. Guid2 := ITSFHeaderGUID;
  148. end;
  149. end;
  150. procedure TChmWriter.InitHeaderSectionTable;
  151. begin
  152. // header section 0
  153. HeaderSection0Table.PosFromZero := LEToN(ITSFHeader.HeaderLength);
  154. HeaderSection0Table.Length := SizeOf(TITSPHeaderPrefix);
  155. // header section 1
  156. HeaderSection1Table.PosFromZero := HeaderSection0Table.PosFromZero + HeaderSection0Table.Length;
  157. HeaderSection1Table.Length := SizeOf(TITSPHeader)+FDirectoryListings.Size;
  158. //contains the offset of CONTENT Section0 from zero
  159. HeaderSuffix.Offset := HeaderSection1Table.PosFromZero + HeaderSection1Table.Length;
  160. // now fix endian stuff
  161. HeaderSection0Table.PosFromZero := NToLE(HeaderSection0Table.PosFromZero);
  162. HeaderSection0Table.Length := NToLE(HeaderSection0Table.Length);
  163. HeaderSection1Table.PosFromZero := NToLE(HeaderSection1Table.PosFromZero);
  164. HeaderSection1Table.Length := NToLE(HeaderSection1Table.Length);
  165. with HeaderSection0 do begin // TITSPHeaderPrefix;
  166. Unknown1 := NToLE(DWord($01FE));
  167. Unknown2 := 0;
  168. // at this point we are putting together the headers. content sections 0 and 1 are complete
  169. FileSize := NToLE(HeaderSuffix.Offset + FSection0.Size + FSection1Size);
  170. Unknown3 := 0;
  171. Unknown4 := 0;
  172. end;
  173. with HeaderSection1 do begin // TITSPHeader; // DirectoryListings header
  174. ITSPsig := ITSPHeaderSig;
  175. Version := NToLE(DWord(1));
  176. DirHeaderLength := NToLE(DWord(SizeOf(TITSPHeader))); // Length of the directory header
  177. Unknown1 := NToLE(DWord($0A));
  178. ChunkSize := NToLE(DWord($1000));
  179. Density := NToLE(DWord(2));
  180. // updated when directory listings were created
  181. //IndexTreeDepth := 1 ; // 1 if there is no index 2 if there is one level of PMGI chunks. will update as
  182. //IndexOfRootChunk := -1;// if no root chunk
  183. //FirstPMGLChunkIndex,
  184. //LastPMGLChunkIndex: LongWord;
  185. Unknown2 := NToLE(Longint(-1));
  186. //DirectoryChunkCount: LongWord;
  187. LanguageID := NToLE(DWord($0409));
  188. GUID := ITSPHeaderGUID;
  189. LengthAgain := NToLE(DWord($54));
  190. Unknown3 := NToLE(Longint(-1));
  191. Unknown4 := NToLE(Longint(-1));
  192. Unknown5 := NToLE(Longint(-1));
  193. end;
  194. // more endian stuff
  195. HeaderSuffix.Offset := NToLE(HeaderSuffix.Offset);
  196. end;
  197. procedure TChmWriter.SetTempRawStream(const AValue: TStream);
  198. begin
  199. if (FCurrentStream.Size > 0) or (FSection1.Size > 0) then
  200. raise Exception.Create('Cannot set the TempRawStream once data has been written to it!');
  201. if AValue = nil then
  202. raise Exception.Create('TempRawStream cannot be nil!');
  203. if FCurrentStream = AValue then
  204. exit;
  205. FCurrentStream.Free;
  206. FCurrentStream := AValue;
  207. end;
  208. procedure TChmWriter.WriteHeader(Stream: TStream);
  209. begin
  210. Stream.Write(ITSFHeader, SizeOf(TITSFHeader));
  211. Stream.Write(HeaderSection0Table, SizeOf(TITSFHeaderEntry));
  212. Stream.Write(HeaderSection1Table, SizeOf(TITSFHeaderEntry));
  213. Stream.Write(HeaderSuffix, SizeOf(TITSFHeaderSuffix));
  214. Stream.Write(HeaderSection0, SizeOf(TITSPHeaderPrefix));
  215. end;
  216. procedure TChmWriter.CreateDirectoryListings;
  217. type
  218. TFirstListEntry = record
  219. Entry: array[0..511] of byte;
  220. Size: Integer;
  221. end;
  222. var
  223. Buffer: array [0..511] of Byte;
  224. IndexBlock: TPMGIDirectoryChunk;
  225. ListingBlock: TDirectoryChunk;
  226. I: Integer;
  227. Size: Integer;
  228. FESize: Integer;
  229. FileName: String;
  230. FileNameSize: Integer;
  231. LastListIndex: Integer;
  232. FirstListEntry: TFirstListEntry;
  233. ChunkIndex: Integer;
  234. ListHeader: TPMGListChunk;
  235. const
  236. PMGL = 'PMGL';
  237. PMGI = 'PMGI';
  238. procedure UpdateLastListChunk;
  239. var
  240. Tmp: QWord;
  241. begin
  242. if ChunkIndex < 1 then begin
  243. Exit;
  244. end;
  245. Tmp := FDirectoryListings.Position;
  246. FDirectoryListings.Position := (LastListIndex) * $1000;
  247. FDirectoryListings.Read(ListHeader, SizeOf(TPMGListChunk));
  248. FDirectoryListings.Position := (LastListIndex) * $1000;
  249. ListHeader.NextChunkIndex := NToLE(ChunkIndex);
  250. FDirectoryListings.Write(ListHeader, SizeOf(TPMGListChunk));
  251. FDirectoryListings.Position := Tmp;
  252. end;
  253. procedure WriteIndexChunk(ShouldFinish: Boolean = False);
  254. var
  255. IndexHeader: TPMGIIndexChunk;
  256. ParentIndex,
  257. TmpIndex: TPMGIDirectoryChunk;
  258. begin
  259. with IndexHeader do begin
  260. PMGIsig := PMGI;
  261. UnusedSpace := NToLE(IndexBlock.FreeSpace);
  262. end;
  263. IndexBlock.WriteHeader(@IndexHeader);
  264. IndexBlock.WriteChunkToStream(FDirectoryListings, ChunkIndex, ShouldFinish);
  265. IndexBlock.Clear;
  266. if HeaderSection1.IndexOfRootChunk < 0 then HeaderSection1.IndexOfRootChunk := ChunkIndex;
  267. if ShouldFinish then begin;
  268. HeaderSection1.IndexTreeDepth := 2;
  269. ParentIndex := IndexBlock.ParentChunk;
  270. if ParentIndex <> nil then repeat // the parent index is notified by our child index when to write
  271. HeaderSection1.IndexOfRootChunk := ChunkIndex;
  272. TmpIndex := ParentIndex;
  273. ParentIndex := ParentIndex.ParentChunk;
  274. TmpIndex.Free;
  275. Inc(HeaderSection1.IndexTreeDepth);
  276. Inc(ChunkIndex);
  277. until ParentIndex = nil;
  278. end;
  279. Inc(ChunkIndex);
  280. end;
  281. procedure WriteListChunk;
  282. begin
  283. with ListHeader do begin
  284. PMGLsig := PMGL;
  285. UnusedSpace := NToLE(ListingBlock.FreeSpace);
  286. Unknown1 := 0;
  287. PreviousChunkIndex := NToLE(LastListIndex);
  288. NextChunkIndex := NToLE(Longint(-1)); // we update this when we write the next chunk
  289. end;
  290. if HeaderSection1.FirstPMGLChunkIndex <= 0 then
  291. HeaderSection1.FirstPMGLChunkIndex := NToLE(ChunkIndex);
  292. HeaderSection1.LastPMGLChunkIndex := NToLE(ChunkIndex);
  293. ListingBlock.WriteHeader(@ListHeader);
  294. ListingBlock.WriteChunkToStream(FDirectoryListings);
  295. ListingBlock.Clear;
  296. UpdateLastListChunk;
  297. LastListIndex := ChunkIndex;
  298. Inc(ChunkIndex);
  299. // now add to index
  300. if not IndexBlock.CanHold(FirstListEntry.Size) then
  301. WriteIndexChunk;
  302. IndexBlock.WriteEntry(FirstListEntry.Size, @FirstListEntry.Entry[0])
  303. end;
  304. begin
  305. // first sort the listings
  306. FInternalFiles.Sort;
  307. HeaderSection1.IndexTreeDepth := 1;
  308. HeaderSection1.IndexOfRootChunk := -1;
  309. ChunkIndex := 0;
  310. IndexBlock := TPMGIDirectoryChunk.Create(SizeOf(TPMGIIndexChunk));
  311. ListingBlock := TDirectoryChunk.Create(SizeOf(TPMGListChunk));
  312. LastListIndex := -1;
  313. // add files to a pmgl block until it is full.
  314. // after the block is full make a pmgi block and add the first entry of the pmgl block
  315. // repeat until the index block is full and start another.
  316. // the pmgi chunks take care of needed parent chunks in the tree
  317. for I := 0 to FInternalFiles.Count-1 do begin
  318. Size := 0;
  319. FileName := FInternalFiles.FileEntry[I].Path + FInternalFiles.FileEntry[I].Name;
  320. FileNameSize := Length(FileName);
  321. // filename length
  322. Inc(Size, WriteCompressedInteger(@Buffer[Size], FileNameSize));
  323. // filename
  324. Move(FileName[1], Buffer[Size], FileNameSize);
  325. Inc(Size, FileNameSize);
  326. FESize := Size;
  327. // File is compressed...
  328. Inc(Size, WriteCompressedInteger(@Buffer[Size], Ord(FInternalFiles.FileEntry[I].Compressed)));
  329. // Offset from section start
  330. Inc(Size, WriteCompressedInteger(@Buffer[Size], FInternalFiles.FileEntry[I].DecompressedOffset));
  331. // Size when uncompressed
  332. Inc(Size, WriteCompressedInteger(@Buffer[Size], FInternalFiles.FileEntry[I].DecompressedSize));
  333. if not ListingBlock.CanHold(Size) then
  334. WriteListChunk;
  335. ListingBlock.WriteEntry(Size, @Buffer[0]);
  336. if ListingBlock.ItemCount = 1 then begin // add the first list item to the index
  337. Move(Buffer[0], FirstListEntry.Entry[0], FESize);
  338. FirstListEntry.Size := FESize + WriteCompressedInteger(@FirstListEntry.Entry[FESize], ChunkIndex);
  339. end;
  340. end;
  341. if ListingBlock.ItemCount > 0 then WriteListChunk;
  342. if ChunkIndex > 1 then begin
  343. if (IndexBlock.ItemCount > 1)
  344. or ( (IndexBlock.ItemCount > 0) and (HeaderSection1.IndexOfRootChunk > -1) )
  345. then WriteIndexChunk(True);
  346. end;
  347. HeaderSection1.DirectoryChunkCount := NToLE(DWord(FDirectoryListings.Size div $1000));
  348. IndexBlock.Free;
  349. ListingBlock.Free;
  350. //now fix some endian stuff
  351. HeaderSection1.IndexOfRootChunk := NToLE(HeaderSection1.IndexOfRootChunk);
  352. HeaderSection1.IndexTreeDepth := NtoLE(HeaderSection1.IndexTreeDepth);
  353. end;
  354. procedure TChmWriter.WriteDirectoryListings(Stream: TStream);
  355. begin
  356. Stream.Write(HeaderSection1, SizeOf(HeaderSection1));
  357. FDirectoryListings.Position := 0;
  358. Stream.CopyFrom(FDirectoryListings, FDirectoryListings.Size);
  359. FDirectoryListings.Position := 0;
  360. //TMemoryStream(FDirectoryListings).SaveToFile('dirlistings.pmg');
  361. end;
  362. procedure TChmWriter.WriteSystem;
  363. var
  364. Entry: TFileEntryRec;
  365. TmpStr: String;
  366. TmpTitle: String;
  367. const
  368. VersionStr = 'HHA Version 4.74.8702'; // does this matter?
  369. begin
  370. // this creates the /#SYSTEM file
  371. Entry.Name := '#SYSTEM';
  372. Entry.Path := '/';
  373. Entry.Compressed := False;
  374. Entry.DecompressedOffset := FSection0.Position;
  375. { if FileExists('#SYSTEM') then
  376. begin
  377. TmpStream := TMemoryStream.Create;
  378. TmpStream.LoadFromFile('#SYSTEM');
  379. TmpStream.Position := 0;
  380. FSection0.CopyFrom(TmpStream, TmpStream.Size);
  381. end; }
  382. // EntryCodeOrder: 10 9 4 2 3 16 6 0 1 5
  383. FSection0.WriteDWord(NToLE(Word(3))); // Version
  384. if Title <> '' then
  385. TmpTitle := Title
  386. else
  387. TmpTitle := 'default';
  388. // Code -> Length -> Data
  389. // 10
  390. FSection0.WriteWord(NToLE(Word(10)));
  391. FSection0.WriteWord(NToLE(Word(SizeOf(DWord))));
  392. FSection0.WriteDWord(NToLE(MilliSecondOfTheDay(Now)));
  393. // 9
  394. FSection0.WriteWord(NToLE(Word(9)));
  395. FSection0.WriteWord(NToLE(Word(SizeOf(VersionStr)+1)));
  396. FSection0.Write(VersionStr, SizeOf(VersionStr));
  397. FSection0.WriteByte(0);
  398. // 4 A struct that is only needed to set if full text search is on.
  399. FSection0.WriteWord(NToLE(Word(4)));
  400. FSection0.WriteWord(NToLE(Word(36))); // size
  401. FSection0.WriteDWord(NToLE(DWord($0409)));
  402. FSection0.WriteDWord(1);
  403. FSection0.WriteDWord(NToLE(DWord(Ord(FFullTextSearch))));
  404. FSection0.WriteDWord(0);
  405. FSection0.WriteDWord(0);
  406. // two for a QWord
  407. FSection0.WriteDWord(0);
  408. FSection0.WriteDWord(0);
  409. FSection0.WriteDWord(0);
  410. FSection0.WriteDWord(0);
  411. ////////////////////////<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  412. // 2 default page to load
  413. if FDefaultPage <> '' then begin
  414. FSection0.WriteWord(NToLE(Word(2)));
  415. FSection0.WriteWord(NToLE(Word(Length(FDefaultPage)+1)));
  416. FSection0.Write(FDefaultPage[1], Length(FDefaultPage));
  417. FSection0.WriteByte(0);
  418. end;
  419. // 3 Title
  420. if FTitle <> '' then begin
  421. FSection0.WriteWord(NToLE(Word(3)));
  422. FSection0.WriteWord(NToLE(Word(Length(FTitle)+1)));
  423. FSection0.Write(FTitle[1], Length(FTitle));
  424. FSection0.WriteByte(0);
  425. end;
  426. // 16 Default Font
  427. if FDefaultFont <> '' then begin
  428. FSection0.WriteWord(NToLE(Word(16)));
  429. FSection0.WriteWord(NToLE(Word(Length(FDefaultFont)+1)));
  430. FSection0.Write(FDefaultFont[1], Length(FDefaultFont));
  431. FSection0.WriteByte(0);
  432. end;
  433. // 6
  434. // unneeded. if output file is : /somepath/OutFile.chm the value here is outfile(lowercase)
  435. {FSection0.WriteWord(6);
  436. FSection0.WriteWord(Length('test1')+1);
  437. Fsection0.Write('test1', 5);
  438. FSection0.WriteByte(0);}
  439. // 0 Table of contents filename
  440. if FHasTOC then begin
  441. TmpStr := 'default.hhc';
  442. FSection0.WriteWord(0);
  443. FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
  444. FSection0.Write(TmpStr[1], Length(TmpStr));
  445. FSection0.WriteByte(0);
  446. end;
  447. // 1
  448. // hhk Index
  449. if FHasIndex then begin
  450. TmpStr := 'default.hhk';
  451. FSection0.WriteWord(NToLE(Word(1)));
  452. FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
  453. FSection0.Write(TmpStr[1], Length(TmpStr));
  454. FSection0.WriteByte(0);
  455. end;
  456. // 5 Default Window.
  457. // Not likely needed
  458. // }
  459. Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
  460. FInternalFiles.AddEntry(Entry);
  461. end;
  462. procedure TChmWriter.WriteITBITS;
  463. var
  464. Entry: TFileEntryRec;
  465. begin
  466. // This is an empty and useless file
  467. Entry.Name := '#ITBITS';
  468. Entry.Path := '/';
  469. Entry.Compressed := False;
  470. Entry.DecompressedOffset :=0;// FSection0.Position;
  471. Entry.DecompressedSize := 0;
  472. FInternalFiles.AddEntry(Entry);
  473. end;
  474. procedure TChmWriter.WriteSTRINGS;
  475. begin
  476. if FStringsStream.Size = 0 then;
  477. FStringsStream.WriteByte(0);
  478. FStringsStream.Position := 0;
  479. PostAddStreamToArchive('#STRINGS', '/', FStringsStream);
  480. end;
  481. procedure TChmWriter.WriteTOPICS;
  482. var
  483. AWord: TIndexedWord;
  484. FHits: Integer;
  485. i: Integer;
  486. begin
  487. if FTopicsStream.Size = 0 then
  488. Exit;
  489. FTopicsStream.Position := 0;
  490. PostAddStreamToArchive('#TOPICS', '/', FTopicsStream);
  491. AWord := FIndexedFiles.FirstWord;
  492. while AWord <> nil do
  493. begin
  494. FHits := 0;
  495. for i := 0 to AWord.DocumentCount-1 do
  496. begin
  497. Inc(FHits, Length(AWord.GetLogicalDocument(i).WordIndex));
  498. //if AWord.IsTitle then
  499. end;
  500. //WriteLn(AWord.TheWord,' documents = ', AWord.DocumentCount, ' hits = ', FHits, ' is title = ', AWord.IsTitle);
  501. AWord := AWord.NextWord;
  502. end;
  503. end;
  504. procedure TChmWriter.WriteIVB;
  505. begin
  506. if FContextStream = nil then exit;
  507. FContextStream.Position := 0;
  508. // the size of all the entries
  509. FContextStream.WriteDWord(NToLE(DWord(FContextStream.Size-SizeOf(dword))));
  510. FContextStream.Position := 0;
  511. AddStreamToArchive('#IVB', '/', FContextStream);
  512. end;
  513. procedure TChmWriter.WriteURL_STR_TBL;
  514. begin
  515. if FURLSTRStream.Size <> 0 then begin
  516. FURLSTRStream.Position := 0;
  517. PostAddStreamToArchive('#URLSTR', '/', FURLSTRStream);
  518. end;
  519. if FURLTBLStream.Size <> 0 then begin
  520. FURLTBLStream.Position := 0;
  521. PostAddStreamToArchive('#URLTBL', '/', FURLTBLStream);
  522. end;
  523. end;
  524. procedure TChmWriter.WriteOBJINST;
  525. var
  526. i: Integer;
  527. ObjStream: TMemoryStream;
  528. //Flags: Word;
  529. begin
  530. ObjStream := TMemorystream.Create;
  531. // this file is needed to enable searches for the ms reader
  532. ObjStream.WriteDWord(NtoLE($04000000));
  533. ObjStream.WriteDWord(NtoLE(Dword(2))); // two entries
  534. ObjStream.WriteDWord(NtoLE(DWord(24))); // offset into file of entry
  535. ObjStream.WriteDWord(NtoLE(DWord(2691))); // size
  536. ObjStream.WriteDWord(NtoLE(DWord(2715))); // offset into file of entry
  537. ObjStream.WriteDWord(NtoLE(DWord(36))); // size
  538. // first entry
  539. // write guid 4662DAAF-D393-11D0-9A56-00C04FB68BF7
  540. ObjStream.WriteDWord(NtoLE($4662DAAF));
  541. ObjStream.WriteWord(NtoLE($D393));
  542. ObjStream.WriteWord(NtoLE($11D0));
  543. ObjStream.WriteWord(NtoLE($569A));
  544. ObjStream.WriteByte($00);
  545. ObjStream.WriteByte($C0);
  546. ObjStream.WriteByte($4F);
  547. ObjStream.WriteByte($B6);
  548. ObjStream.WriteByte($8B);
  549. ObjStream.WriteByte($F7);
  550. ObjStream.WriteDWord(NtoLE($04000000));
  551. ObjStream.WriteDWord(NtoLE(11)); // bit flags
  552. ObjStream.WriteDWord(NtoLE(DWord(1252)));
  553. ObjStream.WriteDWord(NtoLE(DWord(1033)));
  554. ObjStream.WriteDWord(NtoLE($00000000));
  555. ObjStream.WriteDWord(NtoLE($00000000));
  556. ObjStream.WriteDWord(NtoLE($00145555));
  557. ObjStream.WriteDWord(NtoLE($00000A0F));
  558. ObjStream.WriteWord(NtoLE($0100));
  559. ObjStream.WriteDWord(NtoLE($00030005));
  560. for i := 0 to 5 do
  561. ObjStream.WriteDWord($00000000);
  562. ObjStream.WriteWord($0000);
  563. // okay now the fun stuff
  564. for i := 0 to $FF do
  565. ObjStream.Write(ObjInstEntries[i], SizeOF(TObjInstEntry));
  566. {begin
  567. if i = 1 then
  568. Flags := 7
  569. else
  570. Flags := 0;
  571. if (i >= $41) and (i <= $5A) then
  572. Flags := Flags or 2;
  573. if (i >= $61) and (i <= $7A) then
  574. Flags := Flags or 1;
  575. if i = $27 then
  576. Flags := Flags or 6;
  577. ObjStream.WriteWord(NtoLE(Flags));
  578. ObjStream.WriteWord(NtoLE(Word(i)));
  579. if (i >= $41) and (i <= $5A) then
  580. ObjStream.WriteByte(NtoLE(i+$20))
  581. else
  582. ObjStream.WriteByte(NtoLE(i));
  583. ObjStream.WriteByte(NtoLE(i));
  584. ObjStream.WriteByte(NtoLE(i));
  585. ObjStream.WriteByte(NtoLE(i));
  586. ObjStream.WriteWord(NtoLE($0000));
  587. end;}
  588. ObjStream.WriteDWord(NtoLE($E66561C6));
  589. ObjStream.WriteDWord(NtoLE($73DF6561));
  590. ObjStream.WriteDWord(NtoLE($656F8C73));
  591. ObjStream.WriteWord(NtoLE($6F9C));
  592. ObjStream.WriteByte(NtoLE($65));
  593. // third bit of second entry
  594. // write guid 8FA0D5A8-DEDF-11D0-9A61-00C04FB68BF7
  595. ObjStream.WriteDWord(NtoLE($8FA0D5A8));
  596. ObjStream.WriteWord(NtoLE($DEDF));
  597. ObjStream.WriteWord(NtoLE($11D0));
  598. ObjStream.WriteWord(NtoLE($619A));
  599. ObjStream.WriteByte($00);
  600. ObjStream.WriteByte($C0);
  601. ObjStream.WriteByte($4F);
  602. ObjStream.WriteByte($B6);
  603. ObjStream.WriteByte($8B);
  604. ObjStream.WriteByte($F7);
  605. ObjStream.WriteDWord(NtoLE($04000000));
  606. ObjStream.WriteDWord(NtoLE(DWord(1)));
  607. ObjStream.WriteDWord(NtoLE(DWord(1252)));
  608. ObjStream.WriteDWord(NtoLE(DWord(1033)));
  609. ObjStream.WriteDWord(NtoLE(DWord(0)));
  610. // second entry
  611. // write guid 4662DAB0-D393-11D0-9A56-00C04FB68B66
  612. ObjStream.WriteDWord(NtoLE($4662DAB0));
  613. ObjStream.WriteWord(NtoLE($D393));
  614. ObjStream.WriteWord(NtoLE($11D0));
  615. ObjStream.WriteWord(NtoLE($569A));
  616. ObjStream.WriteByte($00);
  617. ObjStream.WriteByte($C0);
  618. ObjStream.WriteByte($4F);
  619. ObjStream.WriteByte($B6);
  620. ObjStream.WriteByte($8B);
  621. ObjStream.WriteByte($66);
  622. ObjStream.WriteDWord(NtoLE(DWord(666))); // not kidding
  623. ObjStream.WriteDWord(NtoLE(DWord(1252)));
  624. ObjStream.WriteDWord(NtoLE(DWord(1033)));
  625. ObjStream.WriteDWord(NtoLE(DWord(10031)));
  626. ObjStream.WriteDWord(NtoLE(DWord(0)));
  627. ObjStream.Position := 0;
  628. AddStreamToArchive('$OBJINST', '/', ObjStream, True);
  629. ObjStream.Free;
  630. end;
  631. procedure TChmWriter.WriteFiftiMain;
  632. var
  633. SearchWriter: TChmSearchWriter;
  634. begin
  635. if FTopicsStream.Size = 0 then
  636. Exit;
  637. SearchWriter := TChmSearchWriter.Create(FFiftiMainStream, FIndexedFiles);
  638. SearchWriter.WriteToStream;
  639. SearchWriter.Free;
  640. if FFiftiMainStream.Size = 0 then
  641. Exit;
  642. FFiftiMainStream.Position := 0;
  643. PostAddStreamToArchive('$FIftiMain', '/', FFiftiMainStream);
  644. end;
  645. procedure TChmWriter.WriteREADMEFile;
  646. const DISCLAIMER_STR = 'This archive was not made by the MS HTML Help Workshop(r)(tm) program.';
  647. var
  648. Entry: TFileEntryRec;
  649. begin
  650. // This procedure puts a file in the archive that says it wasn't compiled with the MS compiler
  651. Entry.Compressed := False;
  652. Entry.DecompressedOffset := FSection0.Position;
  653. FSection0.Write(DISCLAIMER_STR, SizeOf(DISCLAIMER_STR));
  654. Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
  655. Entry.Path := '/';
  656. Entry.Name := '_#_README_#_'; //try to use a name that won't conflict with normal names
  657. FInternalFiles.AddEntry(Entry);
  658. end;
  659. procedure TChmWriter.WriteFinalCompressedFiles;
  660. begin
  661. WriteTOPICS;
  662. WriteURL_STR_TBL;
  663. WriteSTRINGS;
  664. WriteFiftiMain;
  665. end;
  666. procedure TChmWriter.WriteSection0;
  667. begin
  668. FSection0.Position := 0;
  669. FOutStream.CopyFrom(FSection0, FSection0.Size);
  670. end;
  671. procedure TChmWriter.WriteSection1;
  672. begin
  673. WriteContentToStream(FOutStream, FSection1);
  674. end;
  675. procedure TChmWriter.WriteDataSpaceFiles(const AStream: TStream);
  676. var
  677. Entry: TFileEntryRec;
  678. begin
  679. // This procedure will write all files starting with ::
  680. Entry.Compressed := False; // None of these files are compressed
  681. // ::DataSpace/NameList
  682. Entry.DecompressedOffset := FSection0.Position;
  683. Entry.DecompressedSize := WriteNameListToStream(FSection0, [snUnCompressed,snMSCompressed]);
  684. Entry.Path := '::DataSpace/';
  685. Entry.Name := 'NameList';
  686. FInternalFiles.AddEntry(Entry, False);
  687. // ::DataSpace/Storage/MSCompressed/ControlData
  688. Entry.DecompressedOffset := FSection0.Position;
  689. Entry.DecompressedSize := WriteControlDataToStream(FSection0, 2, 2, 1);
  690. Entry.Path := '::DataSpace/Storage/MSCompressed/';
  691. Entry.Name := 'ControlData';
  692. FInternalFiles.AddEntry(Entry, False);
  693. // ::DataSpace/Storage/MSCompressed/SpanInfo
  694. Entry.DecompressedOffset := FSection0.Position;
  695. Entry.DecompressedSize := WriteSpanInfoToStream(FSection0, FReadCompressedSize);
  696. Entry.Path := '::DataSpace/Storage/MSCompressed/';
  697. Entry.Name := 'SpanInfo';
  698. FInternalFiles.AddEntry(Entry, False);
  699. // ::DataSpace/Storage/MSCompressed/Transform/List
  700. Entry.DecompressedOffset := FSection0.Position;
  701. Entry.DecompressedSize := WriteTransformListToStream(FSection0);
  702. Entry.Path := '::DataSpace/Storage/MSCompressed/Transform/';
  703. Entry.Name := 'List';
  704. FInternalFiles.AddEntry(Entry, False);
  705. // ::DataSpace/Storage/MSCompressed/Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/
  706. // ::DataSpace/Storage/MSCompressed/Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/ResetTable
  707. Entry.DecompressedOffset := FSection0.Position;
  708. Entry.DecompressedSize := WriteResetTableToStream(FSection0, FSection1ResetTable);
  709. Entry.Path := '::DataSpace/Storage/MSCompressed/Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/';
  710. Entry.Name := 'ResetTable';
  711. FInternalFiles.AddEntry(Entry, True);
  712. // ::DataSpace/Storage/MSCompressed/Content do this last
  713. Entry.DecompressedOffset := FSection0.Position;
  714. Entry.DecompressedSize := FSection1Size; // we will write it directly to FOutStream later
  715. Entry.Path := '::DataSpace/Storage/MSCompressed/';
  716. Entry.Name := 'Content';
  717. FInternalFiles.AddEntry(Entry, False);
  718. end;
  719. function TChmWriter.AddString(AString: String): LongWord;
  720. begin
  721. // #STRINGS starts with a null char
  722. if FStringsStream.Size = 0 then FStringsStream.WriteByte(0);
  723. // each entry is a null terminated string
  724. Result := FStringsStream.Position;
  725. FStringsStream.WriteBuffer(AString[1], Length(AString));
  726. FStringsStream.WriteByte(0);
  727. end;
  728. function TChmWriter.AddURL ( AURL: String; TopicsIndex: DWord ) : LongWord;
  729. procedure CheckURLStrBlockCanHold(AString: String);
  730. var
  731. Rem: LongWord;
  732. Len: LongWord;
  733. begin
  734. Rem := $4000 - (FURLSTRStream.Size mod $4000);
  735. Len := 9 + Length(AString); // 2 dwords the string and NT
  736. if Rem < Len then
  737. while Rem > 0 do
  738. begin
  739. FURLSTRStream.WriteByte(0);
  740. Dec(Rem);
  741. end;
  742. end;
  743. function AddURLString(AString: String): DWord;
  744. begin
  745. CheckURLStrBlockCanHold(AString);
  746. if FURLSTRStream.Size mod $4000 = 0 then
  747. FURLSTRStream.WriteByte(0);
  748. Result := FURLSTRStream.Position;
  749. FURLSTRStream.WriteDWord(NToLE(DWord(0))); // URL Offset for topic after the the "Local" value
  750. FURLSTRStream.WriteDWord(NToLE(DWord(0))); // Offset of FrameName??
  751. FURLSTRStream.Write(AString[1], Length(AString));
  752. FURLSTRStream.WriteByte(0); //NT
  753. end;
  754. begin
  755. if AURL[1] = '/' then Delete(AURL,1,1);
  756. //if $1000 - (FURLTBLStream.Size mod $1000) = 4 then // we are at 4092
  757. if FURLTBLStream.Size and $FFC = $FFC then // faster :)
  758. FURLTBLStream.WriteDWord(0);
  759. Result := FURLTBLStream.Position;
  760. FURLTBLStream.WriteDWord(0);//($231e9f5c); //unknown
  761. FURLTBLStream.WriteDWord(NtoLE(TopicsIndex)); // Index of topic in #TOPICS
  762. FURLTBLStream.WriteDWord(NtoLE(AddURLString(AURL)));
  763. end;
  764. function _AtEndOfData(arg: pointer): LongBool; cdecl;
  765. begin
  766. Result := TChmWriter(arg).AtEndOfData;
  767. end;
  768. function TChmWriter.AtEndOfData: LongBool;
  769. begin
  770. Result := ForceExit or (FCurrentIndex >= FFileNames.Count-1);
  771. if Result then
  772. Result := Integer(FCurrentStream.Position) >= Integer(FCurrentStream.Size)-1;
  773. end;
  774. function _GetData(arg: pointer; Count: LongInt; Buffer: Pointer): LongInt; cdecl;
  775. begin
  776. Result := TChmWriter(arg).GetData(Count, PByte(Buffer));
  777. end;
  778. function TChmWriter.GetData(Count: LongInt; Buffer: PByte): LongInt;
  779. var
  780. FileEntry: TFileEntryRec;
  781. begin
  782. Result := 0;
  783. while (Result < Count) and (not AtEndOfData) do begin
  784. Inc(Result, FCurrentStream.Read(Buffer[Result], Count-Result));
  785. if (Result < Count) and (not AtEndOfData)
  786. then begin
  787. // the current file has been read. move to the next file in the list
  788. FCurrentStream.Position := 0;
  789. Inc(FCurrentIndex);
  790. ForceExit := OnGetFileData(FFileNames[FCurrentIndex], FileEntry.Path, FileEntry.Name, FCurrentStream);
  791. FileEntry.DecompressedSize := FCurrentStream.Size;
  792. FileEntry.DecompressedOffset := FReadCompressedSize; //269047723;//to test writing really large numbers
  793. FileEntry.Compressed := True;
  794. if FullTextSearch then
  795. CheckFileMakeSearchable(FCurrentStream, FileEntry);
  796. FInternalFiles.AddEntry(FileEntry);
  797. // So the next file knows it's offset
  798. Inc(FReadCompressedSize, FileEntry.DecompressedSize);
  799. FCurrentStream.Position := 0;
  800. end;
  801. // this is intended for programs to add perhaps a file
  802. // after all the other files have been added.
  803. if (AtEndOfData)
  804. and (FCurrentStream <> FPostStream) then
  805. begin
  806. if Assigned(FOnLastFile) then
  807. FOnLastFile(Self);
  808. FCurrentStream.Free;
  809. WriteFinalCompressedFiles;
  810. FCurrentStream := FPostStream;
  811. FCurrentStream.Position := 0;
  812. Inc(FReadCompressedSize, FCurrentStream.Size);
  813. end;
  814. end;
  815. end;
  816. function _WriteCompressedData(arg: pointer; Count: LongInt; Buffer: Pointer): LongInt; cdecl;
  817. begin
  818. Result := TChmWriter(arg).WriteCompressedData(Count, Buffer);
  819. end;
  820. function TChmWriter.WriteCompressedData(Count: Longint; Buffer: Pointer): LongInt;
  821. begin
  822. // we allocate a MB at a time to limit memory reallocation since this
  823. // writes usually 2 bytes at a time
  824. if (FSection1 is TMemoryStream) and (FSection1.Position >= FSection1.Size-1) then begin
  825. FSection1.Size := FSection1.Size+$100000;
  826. end;
  827. Result := FSection1.Write(Buffer^, Count);
  828. Inc(FSection1Size, Result);
  829. end;
  830. procedure _MarkFrame(arg: pointer; UncompressedTotal, CompressedTotal: LongWord); cdecl;
  831. begin
  832. TChmWriter(arg).MarkFrame(UncompressedTotal, CompressedTotal);
  833. end;
  834. procedure TChmWriter.MarkFrame(UnCompressedTotal, CompressedTotal: LongWord);
  835. procedure WriteQWord(Value: QWord);
  836. begin
  837. FSection1ResetTable.Write(NToLE(Value), 8);
  838. end;
  839. procedure IncEntryCount;
  840. var
  841. OldPos: QWord;
  842. Value: DWord;
  843. begin
  844. OldPos := FSection1ResetTable.Position;
  845. FSection1ResetTable.Position := $4;
  846. Value := LeToN(FSection1ResetTable.ReadDWord)+1;
  847. FSection1ResetTable.Position := $4;
  848. FSection1ResetTable.WriteDWord(NToLE(Value));
  849. FSection1ResetTable.Position := OldPos;
  850. end;
  851. procedure UpdateTotalSizes;
  852. var
  853. OldPos: QWord;
  854. begin
  855. OldPos := FSection1ResetTable.Position;
  856. FSection1ResetTable.Position := $10;
  857. WriteQWord(FReadCompressedSize); // size of read data that has been compressed
  858. WriteQWord(CompressedTotal);
  859. FSection1ResetTable.Position := OldPos;
  860. end;
  861. begin
  862. if FSection1ResetTable.Size = 0 then begin
  863. // Write the header
  864. FSection1ResetTable.WriteDWord(NtoLE(DWord(2)));
  865. FSection1ResetTable.WriteDWord(0); // number of entries. we will correct this with IncEntryCount
  866. FSection1ResetTable.WriteDWord(NtoLE(DWord(8))); // Size of Entries (qword)
  867. FSection1ResetTable.WriteDWord(NtoLE(DWord($28))); // Size of this header
  868. WriteQWord(0); // Total Uncompressed Size
  869. WriteQWord(0); // Total Compressed Size
  870. WriteQWord(NtoLE($8000)); // Block Size
  871. WriteQWord(0); // First Block start
  872. end;
  873. IncEntryCount;
  874. UpdateTotalSizes;
  875. WriteQWord(CompressedTotal); // Next Block Start
  876. // We have to trim the last entry off when we are done because there is no next block in that case
  877. end;
  878. procedure TChmWriter.CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec);
  879. type
  880. TTopicEntry = record
  881. TocOffset,
  882. StringsOffset,
  883. URLTableOffset: DWord;
  884. InContents: Word;// 2 = in contents 6 = not in contents
  885. Unknown: Word; // 0,2,4,8,10,12,16,32
  886. end;
  887. function GetNewTopicsIndex: Integer;
  888. begin
  889. Result := FTopicsStream.Size div 16;
  890. end;
  891. var
  892. TopicEntry: TTopicEntry;
  893. ATitle: String;
  894. begin
  895. if Pos('.ht', AFileEntry.Name) > 0 then
  896. begin
  897. ATitle := FIndexedFiles.IndexFile(AStream, GetNewTopicsIndex, FSearchTitlesOnly);
  898. if ATitle <> '' then
  899. TopicEntry.StringsOffset := AddString(ATitle)
  900. else
  901. TopicEntry.StringsOffset := $FFFFFFFF;
  902. TopicEntry.URLTableOffset := AddURL(AFileEntry.Path+AFileEntry.Name, GetNewTopicsIndex);
  903. TopicEntry.InContents := 2;
  904. TopicEntry.Unknown := 0;
  905. TopicEntry.TocOffset := 0;
  906. FTopicsStream.WriteDWord(LEtoN(TopicEntry.TocOffset));
  907. FTopicsStream.WriteDWord(LEtoN(TopicEntry.StringsOffset));
  908. FTopicsStream.WriteDWord(LEtoN(TopicEntry.URLTableOffset));
  909. FTopicsStream.WriteWord(LEtoN(TopicEntry.InContents));
  910. FTopicsStream.WriteWord(LEtoN(TopicEntry.Unknown));
  911. end;
  912. end;
  913. constructor TChmWriter.Create(OutStream: TStream; FreeStreamOnDestroy: Boolean);
  914. begin
  915. if OutStream = nil then Raise Exception.Create('TChmWriter.OutStream Cannot be nil!');
  916. FCurrentStream := TMemoryStream.Create;
  917. FCurrentIndex := -1;
  918. FOutStream := OutStream;
  919. FInternalFiles := TFileEntryList.Create;
  920. FStringsStream := TmemoryStream.Create;
  921. FTopicsStream := TMemoryStream.Create;
  922. FURLSTRStream := TMemoryStream.Create;
  923. FURLTBLStream := TMemoryStream.Create;
  924. FFiftiMainStream := TMemoryStream.Create;
  925. FSection0 := TMemoryStream.Create;
  926. FSection1 := TMemoryStream.Create;
  927. FSection1ResetTable := TMemoryStream.Create;
  928. FDirectoryListings := TMemoryStream.Create;
  929. FPostStream := TMemoryStream.Create;;
  930. FDestroyStream := FreeStreamOnDestroy;
  931. FFileNames := TStringList.Create;
  932. FIndexedFiles := TIndexedWordList.Create;
  933. end;
  934. destructor TChmWriter.Destroy;
  935. begin
  936. if FDestroyStream then FOutStream.Free;
  937. if Assigned(FContextStream) then FContextStream.Free;
  938. FInternalFiles.Free;
  939. FCurrentStream.Free;
  940. FStringsStream.Free;
  941. FTopicsStream.Free;
  942. FURLSTRStream.Free;
  943. FURLTBLStream.Free;
  944. FFiftiMainStream.Free;
  945. FSection0.Free;
  946. FSection1.Free;
  947. FSection1ResetTable.Free;
  948. FDirectoryListings.Free;
  949. FFileNames.Free;
  950. FIndexedFiles.Free;
  951. inherited Destroy;
  952. end;
  953. procedure TChmWriter.Execute;
  954. begin
  955. InitITSFHeader;
  956. FOutStream.Position := 0;
  957. FSection1Size := 0;
  958. // write any internal files to FCurrentStream that we want in the compressed section
  959. WriteIVB;
  960. // written to Section0 (uncompressed)
  961. WriteREADMEFile;
  962. WriteOBJINST;
  963. // move back to zero so that we can start reading from zero :)
  964. FReadCompressedSize := FCurrentStream.Size;
  965. FCurrentStream.Position := 0; // when compressing happens, first the FCurrentStream is read
  966. // before loading user files. So we can fill FCurrentStream with
  967. // internal files first.
  968. // this gathers ALL files that should be in section1 (the compressed section)
  969. StartCompressingStream;
  970. FSection1.Size := FSection1Size;
  971. // This creates and writes the #ITBITS (empty) file to section0
  972. WriteITBITS;
  973. // This creates and writes the #SYSTEM file to section0
  974. WriteSystem;
  975. //this creates all special files in the archive that start with ::DataSpace
  976. WriteDataSpaceFiles(FSection0);
  977. // creates all directory listings including header
  978. CreateDirectoryListings;
  979. // do this after we have compressed everything so that we know the values that must be written
  980. InitHeaderSectionTable;
  981. // Now we can write everything to FOutStream
  982. WriteHeader(FOutStream);
  983. WriteDirectoryListings(FOutStream);
  984. WriteSection0; //does NOT include section 1 even though section0.content IS section1
  985. WriteSection1; // writes section 1 to FOutStream
  986. end;
  987. procedure TChmWriter.AppendTOC(AStream: TStream);
  988. begin
  989. FHasTOC := True;
  990. PostAddStreamToArchive('default.hhc', '/', AStream, True);
  991. end;
  992. procedure TChmWriter.AppendIndex(AStream: TStream);
  993. begin
  994. FHasIndex := True;
  995. PostAddStreamToArchive('default.hhk', '/', AStream, True);
  996. end;
  997. procedure TChmWriter.AppendSearchDB(AName: String; AStream: TStream);
  998. begin
  999. PostAddStreamToArchive(AName, '/', AStream);
  1000. end;
  1001. // this procedure is used to manually add files to compress to an internal stream that is
  1002. // processed before FileToCompress is called. Files added this way should not be
  1003. // duplicated in the FilesToCompress property.
  1004. procedure TChmWriter.AddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
  1005. var
  1006. TargetStream: TStream;
  1007. Entry: TFileEntryRec;
  1008. begin
  1009. if AStream = nil then Exit;
  1010. if Compress then
  1011. TargetStream := FCurrentStream
  1012. else
  1013. TargetStream := FSection0;
  1014. Entry.Name := AFileName;
  1015. Entry.Path := APath;
  1016. Entry.Compressed := Compress;
  1017. Entry.DecompressedOffset := TargetStream.Position;
  1018. Entry.DecompressedSize := AStream.Size;
  1019. if FullTextSearch then
  1020. CheckFileMakeSearchable(AStream, Entry); // Must check before we add it to the list so we know if the name needs to be added to #STRINGS
  1021. FInternalFiles.AddEntry(Entry);
  1022. AStream.Position := 0;
  1023. TargetStream.CopyFrom(AStream, AStream.Size);
  1024. end;
  1025. procedure TChmWriter.PostAddStreamToArchive(AFileName, APath: String;
  1026. AStream: TStream; Compress: Boolean);
  1027. var
  1028. TargetStream: TStream;
  1029. Entry: TFileEntryRec;
  1030. begin
  1031. if AStream = nil then Exit;
  1032. if Compress then
  1033. TargetStream := FPostStream
  1034. else
  1035. TargetStream := FSection0;
  1036. Entry.Name := AFileName;
  1037. Entry.Path := APath;
  1038. Entry.Compressed := Compress;
  1039. if not Compress then
  1040. Entry.DecompressedOffset := TargetStream.Position
  1041. else
  1042. Entry.DecompressedOffset := FReadCompressedSize + TargetStream.Position;
  1043. Entry.DecompressedSize := AStream.Size;
  1044. FInternalFiles.AddEntry(Entry);
  1045. AStream.Position := 0;
  1046. TargetStream.CopyFrom(AStream, AStream.Size);
  1047. if FullTextSearch then
  1048. CheckFileMakeSearchable(AStream, Entry);
  1049. end;
  1050. procedure TChmWriter.AddContext(AContext: DWord; ATopic: String);
  1051. var
  1052. Offset: DWord;
  1053. begin
  1054. if FContextStream = nil then begin
  1055. // #IVB starts with a dword which is the size of the stream - sizeof(dword)
  1056. FContextStream.WriteDWord(0);
  1057. // we will update this when we write the file to the final stream
  1058. end;
  1059. // an entry is a context id and then the offset of the name of the topic in the strings file
  1060. FContextStream.WriteDWord(NToLE(AContext));
  1061. Offset := NToLE(AddString(ATopic));
  1062. FContextStream.WriteDWord(Offset);
  1063. end;
  1064. procedure TChmWriter.StartCompressingStream;
  1065. var
  1066. LZXdata: Plzx_data;
  1067. WSize: LongInt;
  1068. begin
  1069. lzx_init(@LZXdata, LZX_WINDOW_SIZE, @_GetData, Self, @_AtEndOfData,
  1070. @_WriteCompressedData, Self, @_MarkFrame, Self);
  1071. WSize := 1 shl LZX_WINDOW_SIZE;
  1072. while not AtEndOfData do begin
  1073. lzx_reset(LZXdata);
  1074. lzx_compress_block(LZXdata, WSize, True);
  1075. end;
  1076. //we have to mark the last frame manually
  1077. MarkFrame(LZXdata^.len_uncompressed_input, LZXdata^.len_compressed_output);
  1078. lzx_finish(LZXdata, nil);
  1079. end;
  1080. end.