1 { Copyright (C) <2005> <Andrew Haines> chmreader.pas
2
3 This library is free software; you can redistribute it and/or modify it
4 under the terms of the GNU Library General Public License as published by
5 the Free Software Foundation; either version 2 of the License, or (at your
6 option) any later version.
7
8 This program is distributed in the hope that it will be useful, but WITHOUT
9 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
10 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
11 for more details.
12
13 You should have received a copy of the GNU Library General Public License
14 along with this library; if not, write to the Free Software Foundation,
15 Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
16 }
17 {
18 See the file COPYING.modifiedLGPL, included in this distribution,
19 for details about the copyright.
20 }
21 unit chmreader;
22
23 {$mode delphi}
24
25 //{$DEFINE CHM_DEBUG}
26 { $DEFINE CHM_DEBUG_CHUNKS}
27 {define binindex}
28 {define nonumber}
29 interface
30
31 uses
32 Generics.Collections, Classes, SysUtils, Contnrs,
33 chmbase, paslzx, chmFIftiMain, chmsitemap;
34
35 type
36
37 TLZXResetTableArr = array of QWord;
38
39 PContextItem = ^TContextItem;
40 TContextItem = record
41 Context: THelpContext;
42 Url: String;
43 end;
44
45 TContextList = class(TList)
46 public
47 procedure AddContext(Context: THelpContext; Url: String);
GetURLnull48 function GetURL(Context: THelpContext): String;
49 procedure Clear; override;
50 end;
51 { TITSFReader }
52
53 TFileEntryForEach = procedure(Name: String; Offset, UncompressedSize, Section: Integer) of object;
54
55 TITSFReader = class(TObject)
56 protected
57 fStream: TStream;
58 fFreeStreamOnDestroy: Boolean;
59 fITSFHeader: TITSFHeader;
60 fHeaderSuffix: TITSFHeaderSuffix;
61 fDirectoryHeader: TITSPHeader;
62 fDirectoryHeaderPos: QWord;
63 fDirectoryHeaderLength: QWord;
64 fDirectoryEntriesStartPos: QWord;
65 fCachedEntry: TPMGListChunkEntry; //contains the last entry found by ObjectExists
66 fDirectoryEntriesCount: LongWord;
67 procedure ReadHeader; virtual;
68 procedure ReadHeaderEntries; virtual;
GetChunkTypenull69 function GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TDirChunkType;
70 procedure GetSections(out Sections: TStringList);
71 private
GetDirectoryChunknull72 function GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer;
ReadPMGLchunkEntryFromStreamnull73 function ReadPMGLchunkEntryFromStream(Stream: TMemoryStream; var PMGLEntry: TPMGListChunkEntry): Boolean;
ReadPMGIchunkEntryFromStreamnull74 function ReadPMGIchunkEntryFromStream(Stream: TMemoryStream; var PMGIEntry: TPMGIIndexChunkEntry): Boolean;
75 procedure LookupPMGLchunk(Stream: TMemoryStream; out PMGLChunk: TPMGListChunk);
76 procedure LookupPMGIchunk(Stream: TMemoryStream; out PMGIChunk: TPMGIIndexChunk);
77
78
GetBlockFromSectionnull79 function GetBlockFromSection(SectionPrefix: String; StartPos: QWord; BlockLength: QWord): TMemoryStream;
FindBlocksFromUnCompressedAddrnull80 function FindBlocksFromUnCompressedAddr(var ResetTableEntry: TPMGListChunkEntry;
81 out CompressedSize: QWord; out UnCompressedSize: QWord; out LZXResetTable: TLZXResetTableArr): QWord; // Returns the blocksize
82 public
83 constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); virtual;
84 destructor Destroy; override;
85 public
86 ChmLastError: LongInt;
IsValidFilenull87 function IsValidFile: Boolean;
88 procedure GetCompleteFileList(ForEach: TFileEntryForEach; AIncludeInternalFiles: Boolean = True); virtual;
ObjectExistsnull89 function ObjectExists(Name: String): QWord; virtual; // zero if no. otherwise it is the size of the object
90 // NOTE directories will return zero size even if they exist
GetObjectnull91 function GetObject(Name: String): TMemoryStream; virtual; // YOU must Free the stream
92 property CachedEntry: TPMGListChunkEntry read fCachedEntry;
93 end;
94
95 { TChmReader }
96
97 TChmReader = class(TITSFReader)
98 protected
99 fDefaultPage: String;
100 fIndexFile: String;
101 fTOCFile: String;
102 fTitle: String;
103 fPreferedFont: String;
104 fContextList: TContextList;
105 fTOPICSStream,
106 fURLSTRStream,
107 fURLTBLStream,
108 fStringsStream: TMemoryStream;
109 fLocaleID: DWord;
110 fWindowsList : TObjectList;
111 fDefaultWindow: String;
112 private
113 FSearchReader: TChmSearchReader;
114 public
115 procedure ReadCommonData;
ReadStringsEntrynull116 function ReadStringsEntry(APosition: DWord): String;
ReadStringsEntryFromStreamnull117 function ReadStringsEntryFromStream ( strm:TStream ) : String;
118 { Return LocalUrl string from #URLSTR }
ReadURLSTRnull119 function ReadURLSTR(APosition: DWord): String;
CheckCommonStreamsnull120 function CheckCommonStreams: Boolean;
121 procedure ReadWindows(mem:TMemoryStream);
122 constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); override;
123 destructor Destroy; override;
GetContextUrlnull124 function GetContextUrl(Context: THelpContext): String;
LookupTopicByIDnull125 function LookupTopicByID(ATopicID: Integer; out ATitle: String): String; // returns a url
GetTOCSitemapnull126 function GetTOCSitemap(ForceXML:boolean=false): TChmSiteMap;
GetIndexSitemapnull127 function GetIndexSitemap(ForceXML:boolean=false): TChmSiteMap;
HasContextListnull128 function HasContextList: Boolean;
129 property DefaultPage: String read fDefaultPage;
130 property IndexFile: String read fIndexFile;
131 property TOCFile: String read fTOCFile;
132 property Title: String read fTitle write fTitle;
133 property PreferedFont: String read fPreferedFont;
134 property LocaleID: dword read fLocaleID;
135 property SearchReader: TChmSearchReader read FSearchReader write FSearchReader;
136 property contextlist : tcontextlist read fcontextlist;
137 property Windows : TObjectlist read fWindowsList;
138 property DefaultWindow : string read fdefaultwindow;
139 end;
140
141 { TChmFileList }
142 TChmFileList = class;
143 TChmFileOpenEvent = procedure(ChmFileList: TChmFileList; Index: Integer) of object;
144 TChmFileList = class(TStringList)
145 protected
146 fLastChm: TChmReader;
147 fUnNotifiedFiles: TList;
148 fOnOpenNewFile: TChmFileOpenEvent;
149 procedure Delete(Index: Integer); override;
GetChmnull150 function GetChm(AIndex: Integer): TChmReader;
GetFileNamenull151 function GetFileName(AIndex: Integer): String;
152 procedure OpenNewFile(AFileName: String);
CheckOpenFilenull153 function CheckOpenFile(AFileName: String): Boolean;
MetaObjectExistsnull154 function MetaObjectExists(var Name: String): QWord;
MetaGetObjectnull155 function MetaGetObject(Name: String): TMemoryStream;
156 procedure SetOnOpenNewFile(AValue: TChmFileOpenEvent);
157 public
158 constructor Create(PrimaryFileName: String);
159 destructor Destroy; override;
GetObjectnull160 function GetObject(Name: String): TMemoryStream;
IsAnOpenFilenull161 function IsAnOpenFile(AFileName: String): Boolean;
ObjectExistsnull162 function ObjectExists(Name: String; var fChm: TChmReader): QWord;
163 //properties
164 property Chm[Index: Integer]: TChmReader read GetChm;
165 property FileName[Index: Integer]: String read GetFileName;
166 property OnOpenNewFile: TChmFileOpenEvent read fOnOpenNewFile write SetOnOpenNewFile;
167 end;
168
169 //ErrorCodes
170 const
171 ERR_NO_ERR = 0;
172 ERR_STREAM_NOT_ASSIGNED = 1;
173 ERR_NOT_SUPPORTED_VERSION = 2;
174 ERR_NOT_VALID_FILE = 3;
175 ERR_UNKNOWN_ERROR = 10;
176
ChmErrorToStrnull177 function ChmErrorToStr(Error: Integer): String;
178
179 implementation
180 uses ChmTypes;
181
ChmErrorToStrnull182 function ChmErrorToStr(Error: Integer): String;
183 begin
184 Result := '';
185 case Error of
186 ERR_STREAM_NOT_ASSIGNED : Result := 'ERR_STREAM_NOT_ASSIGNED';
187 ERR_NOT_SUPPORTED_VERSION : Result := 'ERR_NOT_SUPPORTED_VERSION';
188 ERR_NOT_VALID_FILE : Result := 'ERR_NOT_VALID_FILE';
189 ERR_UNKNOWN_ERROR : Result := 'ERR_UNKNOWN_ERROR';
190 end;
191 end;
192
ChunkTypenull193 function ChunkType(Stream: TMemoryStream): TDirChunkType;
194 var
195 ChunkID: array[0..3] of char;
196 begin
197 Result := ctUnknown;
198 if Stream.Size< 4 then exit;
199 Move(Stream.Memory^, ChunkId[0], 4);
200 if ChunkID = 'PMGL' then Result := ctPMGL
201 else if ChunkID = 'PMGI' then Result := ctPMGI
202 else if ChunkID = 'AOLL' then Result := ctAOLL
203 else if ChunkID = 'AOLI' then Result := ctAOLI;
204 end;
205
206 { TITSFReader }
207
208 procedure TITSFReader.ReadHeader;
209 begin
210 fStream.Read(fITSFHeader,SizeOf(fITSFHeader));
211
212 // Fix endian issues
213 {$IFDEF ENDIAN_BIG}
214 fITSFHeader.Version := LEtoN(fITSFHeader.Version);
215 fITSFHeader.HeaderLength := LEtoN(fITSFHeader.HeaderLength);
216 //Unknown_1
217 fITSFHeader.TimeStamp := BEtoN(fITSFHeader.TimeStamp);//bigendian
218 fITSFHeader.LanguageID := LEtoN(fITSFHeader.LanguageID);
219 {$ENDIF}
220
221 if fITSFHeader.Version < 4 then
222 fStream.Seek(SizeOf(TGuid)*2, soCurrent);
223
224 if not IsValidFile then Exit;
225
226 ReadHeaderEntries;
227 end;
228
229 procedure TITSFReader.ReadHeaderEntries;
230 var
231 fHeaderEntries: array [0..1] of TITSFHeaderEntry;
232 begin
233 // Copy EntryData into memory
234 fStream.Read(fHeaderEntries[0], SizeOf(fHeaderEntries));
235
236 if fITSFHeader.Version = 3 then
237 fStream.Read(fHeaderSuffix.Offset, SizeOf(QWord));
238 fHeaderSuffix.Offset := LEtoN(fHeaderSuffix.Offset);
239 // otherwise this is set in fill directory entries
240
241 fStream.Position := LEtoN(fHeaderEntries[1].PosFromZero);
242 fDirectoryHeaderPos := LEtoN(fHeaderEntries[1].PosFromZero);
243 fStream.Read(fDirectoryHeader, SizeOf(fDirectoryHeader));
244 {$IFDEF ENDIAN_BIG}
245 with fDirectoryHeader do begin
246 Version := LEtoN(Version);
247 DirHeaderLength := LEtoN(DirHeaderLength);
248 //Unknown1
249 ChunkSize := LEtoN(ChunkSize);
250 Density := LEtoN(Density);
251 IndexTreeDepth := LEtoN(IndexTreeDepth);
252 IndexOfRootChunk := LEtoN(IndexOfRootChunk);
253 FirstPMGLChunkIndex := LEtoN(FirstPMGLChunkIndex);
254 LastPMGLChunkIndex := LEtoN(LastPMGLChunkIndex);
255 //Unknown2
256 DirectoryChunkCount := LEtoN(DirectoryChunkCount);
257 LanguageID := LEtoN(LanguageID);
258 //GUID: TGuid;
259 LengthAgain := LEtoN(LengthAgain);
260 end;
261 {$ENDIF}
262 {$IFDEF CHM_DEBUG}
263 WriteLn('PMGI depth = ', fDirectoryHeader.IndexTreeDepth);
264 WriteLn('PMGI Root = ', fDirectoryHeader.IndexOfRootChunk);
265 Writeln('DirCount = ', fDirectoryHeader.DirectoryChunkCount);
266 {$ENDIF}
267 fDirectoryEntriesStartPos := fStream.Position;
268 fDirectoryHeaderLength := LEtoN(fHeaderEntries[1].Length);
269 end;
270
271 procedure TChmReader.ReadCommonData;
272 // A little helper proc to make reading a null terminated string easier
ReadStringnull273 function ReadString(const Stream: TStream; StartPos: DWord; FixURL: Boolean): String;
274 var
275 buf: array[0..49] of char;
276 begin
277 Result := '';
278 Stream.Position := StartPos;
279 repeat
280 Stream.Read(buf, 50);
281 Result := Result + buf;
282 until IndexByte(buf, 50, 0) <> -1;
283 if FixURL then
284 Result := StringReplace(Result, '\', '/', [rfReplaceAll]);
285 end;
286 procedure ReadFromSystem;
287 var
288 //Version: DWord;
289 EntryType: Word;
290 EntryLength: Word;
291 Data: array[0..511] of char;
292 fSystem: TMemoryStream;
293 Tmp: String;
294 begin
295 fSystem := TMemoryStream(GetObject('/#SYSTEM'));
296 if fSystem = nil then begin
297 exit;
298 end;
299 fSystem.Position := 0;
300 if fSystem.Size < SizeOf(DWord) then begin
301 fSystem.Free;
302 Exit;
303 end;
304 {Version := }LEtoN(fSystem.ReadDWord);
305 while fSystem.Position < fSystem.Size do begin
306 EntryType := LEtoN(fSystem.ReadWord);
307 EntryLength := LEtoN(fSystem.ReadWord);
308 case EntryType of
309 0: // Table of contents
310 begin
311 if EntryLength > 511 then EntryLength := 511;
312 fSystem.Read(Data[0], EntryLength);
313 Data[EntryLength] := #0;
314 fTOCFile := '/'+Data;
315 end;
316 1: // Index File
317 begin
318 if EntryLength > 511 then EntryLength := 511;
319 fSystem.Read(Data[0], EntryLength);
320 Data[EntryLength] := #0;
321 fIndexFile := '/'+Data;
322 end;
323 2: // DefaultPage
324 begin
325 if EntryLength > 511 then EntryLength := 511;
326 fSystem.Read(Data[0], EntryLength);
327 Data[EntryLength] := #0;
328 fDefaultPage := '/'+Data;
329 end;
330 3: // Title of chm
331 begin
332 if EntryLength > 511 then EntryLength := 511;
333 fSystem.Read(Data[0], EntryLength);
334 Data[EntryLength] := #0;
335 fTitle := Data;
336 end;
337 4: // Locale ID
338 begin
339 fLocaleID := LEtoN(fSystem.ReadDWord);
340 fSystem.Position := (fSystem.Position + EntryLength) - SizeOf(DWord);
341 end;
342 6: // chm file name. use this to get the index and toc name
343 begin
344 if EntryLength > 511 then EntryLength := 511;
345 fSystem.Read(Data[0], EntryLength);
346 Data[EntryLength] := #0;
347 if (fIndexFile = '') then begin
348 Tmp := '/'+Data+'.hhk';
349 if (ObjectExists(Tmp) > 0) then begin
350 fIndexFile := Tmp;
351 end
352 end;
353 if (fTOCFile = '') then begin
354 Tmp := '/'+Data+'.hhc';
355 if (ObjectExists(Tmp) > 0) then begin
356 fTOCFile := Tmp;
357 end;
358 end;
359 end;
360 16: // Prefered font
361 begin
362 if EntryLength > 511 then EntryLength := 511;
363 fSystem.Read(Data[0], EntryLength);
364 Data[EntryLength] := #0;
365 fPreferedFont := Data;
366 end;
367 else
368 // Skip entries we are not interested in
369 fSystem.Position := fSystem.Position + EntryLength;
370 end;
371 end;
372 fSystem.Free;
373 end;
374 procedure ReadFromWindows;
375 var
376 fWindows,
377 fStrings: TMemoryStream;
378 EntryCount,
379 EntrySize: DWord;
380 EntryStart: QWord;
381 X: Integer;
382 OffSet: QWord;
383 begin
384 fWindows := TMemoryStream(GetObject('/#WINDOWS'));
385 if fWindows = nil then begin
386 exit;
387 end;
388 fStrings := TMemoryStream(GetObject('/#STRINGS'));
389 if fStrings = nil then begin
390 if fWindows <> nil then fWindows.Free;
391 Exit;
392 end;
393 fWindows.Position := 0;
394 if (fWindows.Size = 0) or (fStrings.Size = 0) then begin
395 fWindows.Free;
396 fStrings.Free;
397 Exit;
398 end;
399 EntryCount := LEtoN(fWindows.ReadDWord);
400 EntrySize := LEtoN(fWindows.ReadDWord);
401 OffSet := fWindows.Position;
402 for X := 0 to EntryCount -1 do begin
403 EntryStart := OffSet + (X*EntrySize);
404 if fTitle = '' then begin
405 fWindows.Position := EntryStart + $14;
406 fTitle := '/'+ReadString(fStrings, LEtoN(fWindows.ReadDWord), False);
407 end;
408 if fTOCFile = '' then begin
409 fWindows.Position := EntryStart + $60;
410 fTOCFile := '/'+ReadString(fStrings, LEtoN(fWindows.ReadDWord), True);
411 end;
412 if fIndexFile = '' then begin
413 fWindows.Position := EntryStart + $64;
414 fIndexFile := '/'+ReadString(fStrings, LEtoN(fWindows.ReadDWord), True);
415 end;
416 if fDefaultPage = '' then begin
417 fWindows.Position := EntryStart + $68;
418 fDefaultPage := '/'+ReadString(fStrings, LEtoN(fWindows.ReadDWord), True);
419 end;
420 end;
421 ReadWindows(FWindows);
422 fWindows.Free;
423 fStrings.Free;
424 end;
425 procedure ReadContextIds;
426 var
427 fIVB,
428 fStrings: TStream;
429 Str: String;
430 Value: DWord;
431 OffSet: DWord;
432 //TotalSize: DWord;
433 begin
434 fIVB := GetObject('/#IVB');
435 if fIVB = nil then Exit;
436 fStrings := GetObject('/#STRINGS');
437 if fStrings = nil then begin
438 fIVB.Free;
439 Exit;
440 end;
441 fIVB.Position := 0;
442 {TotalSize := }LEtoN(fIVB.ReadDWord);
443 while fIVB.Position < fIVB.Size do begin
444 Value := LEtoN(fIVB.ReadDWord);
445 OffSet := LEtoN(fIVB.ReadDWord);
446 Str := '/'+ ReadString(fStrings, Offset, True);
447 fContextList.AddContext(Value, Str);
448 end;
449 fIVB.Free;
450 fStrings.Free;
451 end;
452 begin
453 ReadFromSystem;
454 ReadFromWindows;
455 ReadContextIds;
456 {$IFDEF CHM_DEBUG}
457 WriteLn('TOC=',fTocfile);
458 WriteLn('DefaultPage=',fDefaultPage);
459 {$ENDIF}
460 end;
461
TChmReader.ReadStringsEntrynull462 function TChmReader.ReadStringsEntry ( APosition: DWord ) : String;
463 begin
464 Result := '';
465 if fStringsStream = nil then
466 fStringsStream := GetObject('/#STRINGS');
467 if fStringsStream = nil then
468 Exit;
469 if APosition < fStringsStream.Size-1 then
470 begin
471 Result := PChar(fStringsStream.Memory+APosition);
472 end;
473 end;
474
ReadStringsEntryFromStreamnull475 function TChmReader.ReadStringsEntryFromStream ( strm:TStream ) : String;
476 var APosition : DWord;
477 begin
478 APosition:=LEtoN(strm.ReadDWord);
479 result:=ReadStringsEntry(APosition);
480 end;
481
ReadURLSTRnull482 function TChmReader.ReadURLSTR ( APosition: DWord ) : String;
483 begin
484 result:='';
485 if not CheckCommonStreams then
486 Exit;
487
488 fURLTBLStream.Position := APosition;
489 fURLTBLStream.ReadDWord; // unknown
490 fURLTBLStream.ReadDWord; // TOPIC index #
491 fURLSTRStream.Position := LEtoN(fURLTBLStream.ReadDWord);
492 fURLSTRStream.ReadDWord; // URL
493 fURLSTRStream.ReadDWord; // FrameName
494 if fURLSTRStream.Position < fURLSTRStream.Size-1 then
495 Result := PChar(fURLSTRStream.Memory+fURLSTRStream.Position);
496 end;
497
TChmReader.CheckCommonStreamsnull498 function TChmReader.CheckCommonStreams: Boolean;
499 begin
500 if fTOPICSStream = nil then
501 fTOPICSStream := GetObject('/#TOPICS');
502 if fURLSTRStream = nil then
503 fURLSTRStream := GetObject('/#URLSTR');
504 if fURLTBLStream = nil then
505 fURLTBLStream := GetObject('/#URLTBL');
506
507 Result := (fTOPICSStream <> nil)
508 and (fURLSTRStream <> nil)
509 and (fURLTBLStream <> nil);
510 end;
511
512 procedure TChmReader.ReadWindows(mem:TMemoryStream);
513
514 var
515 i,cnt,
516 version : integer;
517 x : TChmWindow;
518 begin
519 if not assigned(fwindowslist) then
520 fWindowsList.Clear;
521 mem.Position:=0;
522 cnt := LEtoN(mem.ReadDWord);
523 version := LEtoN(mem.ReadDWord);
524 while (cnt>0) do
525 begin
526 x:=TChmWindow.Create;
527 version := LEtoN(mem.ReadDWord); // 0 size of entry.
528 mem.readDWord; // 4 unknown (bool Unicodestrings?)
529 x.window_type :=ReadStringsEntryFromStream(mem); // 8 Arg 0, name of window
530 x.flags := TValidWindowFields(LEtoN(mem.ReadDWord)); // C valid fields
531 x.nav_style := LEtoN(mem.ReadDWord); // 10 arg 10 navigation pane style
532 x.title_bar_text :=ReadStringsEntryFromStream(mem); // 14 Arg 1, title bar text
533 x.styleflags := LEtoN(mem.ReadDWord); // 18 Arg 14, style flags
534 x.xtdstyleflags := LEtoN(mem.ReadDWord); // 1C Arg 15, xtd style flags
535 x.left := LEtoN(mem.ReadDWord); // 20 Arg 13, rect.left
536 x.right := LEtoN(mem.ReadDWord); // 24 Arg 13, rect.top
537 x.top := LEtoN(mem.ReadDWord); // 28 Arg 13, rect.right
538 x.bottom := LEtoN(mem.ReadDWord); // 2C Arg 13, rect.bottom
539 x.window_show_state:= LEtoN(mem.ReadDWord); // 30 Arg 16, window show state
540 mem.readdword; // 34 - , HWND hwndhelp OUT: window handle"
541 mem.readdword; // 38 - , HWND hwndcaller OUT: who called this window"
542 mem.readdword; // 3C - , HH_INFO_TYPE paINFO_TYPES IN: Pointer to an array of Information Types"
543 mem.readdword; // 40 - , HWND hwndtoolbar OUT: toolbar window in tri-pane window"
544 mem.readdword; // 44 - , HWND hwndnavigation OUT: navigation window in tri-pane window"
545 mem.readdword; // 48 - , HWND hwndhtml OUT: window displaying HTML in tri-pane window"
546 x.navpanewidth := LEtoN(mem.ReadDWord); // 4C Arg 11, width of nav pane
547 mem.readdword; // 50 - , rect.left, OUT:Specifies the coordinates of the Topic pane
548 mem.readdword; // 54 - , rect.top , OUT:Specifies the coordinates of the Topic pane
549 mem.readdword; // 58 - , rect.right, OUT:Specifies the coordinates of the Topic pane
550 mem.readdword; // 5C - , rect.bottom, OUT:Specifies the coordinates of the Topic pane
551 x.toc_file :=ReadStringsEntryFromStream(mem); // 60 Arg 2, toc file
552 x.index_file :=ReadStringsEntryFromStream(mem); // 64 Arg 3, index file
553 x.default_file :=ReadStringsEntryFromStream(mem); // 68 Arg 4, default file
554 x.home_button_file :=ReadStringsEntryFromStream(mem); // 6c Arg 5, home button file.
555 x.buttons := LEtoN(mem.ReadDWord); // 70 arg 12,
556 x.navpane_initially_closed := LEtoN(mem.ReadDWord); // 74 arg 17
557 x.navpane_default := LEtoN(mem.ReadDWord); // 78 arg 18,
558 x.navpane_location := LEtoN(mem.ReadDWord); // 7C arg 19,
559 x.wm_notify_id := LEtoN(mem.ReadDWord); // 80 arg 20,
560 for i:=0 to 4 do
561 mem.ReadDWord; // 84 - byte[20] unknown - "BYTE tabOrder[HH_MAX_TABS + 1]; // IN/OUT: tab order: Contents, Index, Search, History, Favorites, Reserved 1-5, Custom tabs"
562 mem.ReadDWord; // 94 - int cHistory; // IN/OUT: number of history items to keep (default is 30)
563 x.jumpbutton_1_text:=ReadStringsEntryFromStream(mem); // 9C Arg 7, The text of the Jump 1 button.
564 x.jumpbutton_2_text:=ReadStringsEntryFromStream(mem); // A0 Arg 9, The text of the Jump 2 button.
565 x.jumpbutton_1_file:=ReadStringsEntryFromStream(mem); // A4 Arg 6, The file shown for Jump 1 button.
566 x.jumpbutton_2_file:=ReadStringsEntryFromStream(mem); // A8 Arg 8, The file shown for Jump 1 button.
567 for i:=0 to 3 do
568 mem.ReadDWord;
569 dec(version,188); // 1.1 specific onesf
570 while (version>=4) do
571 begin
572 mem.readdword;
573 dec(version,4);
574 end;
575
576 fWindowslist.Add(x);
577 dec(cnt);
578 end;
579 end;
580
581 constructor TChmReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
582 begin
583 fContextList := TContextList.Create;
584 fWindowslist := TObjectlist.Create(True);
585 fDefaultWindow:='';
586
587 inherited Create(AStream, FreeStreamOnDestroy);
588 if not IsValidFile then exit;
589
590 ReadCommonData;
591 end;
592
593 destructor TChmReader.Destroy;
594 begin
595 FreeAndNil(fContextList);
596 FreeAndNil(FWindowslist);
597 FreeAndNil(FSearchReader);
598 FreeAndNil(fTOPICSStream);
599 FreeAndNil(fURLSTRStream);
600 FreeAndNil(fURLTBLStream);
601 FreeAndNil(fStringsStream);
602 inherited Destroy;
603 end;
604
GetChunkTypenull605 function TITSFReader.GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TDirChunkType;
606 var
607 Sig: array[0..3] of char;
608 begin
609 Result := ctUnknown;
610 Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
611
612 Stream.Read(Sig, 4);
613 if Sig = 'PMGL' then Result := ctPMGL
614 else if Sig = 'PMGI' then Result := ctPMGI
615 else if Sig = 'AOLL' then Result := ctAOLL
616 else if Sig = 'AOLI' then Result := ctAOLI;
617 end;
618
GetDirectoryChunknull619 function TITSFReader.GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer;
620 begin
621 Result := Index;
622 fStream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * Index);
623 OutStream.Position := 0;
624 OutStream.Size := fDirectoryHeader.ChunkSize;
625 OutStream.CopyFrom(fStream, fDirectoryHeader.ChunkSize);
626 OutStream.Position := 0;
627 end;
628
629 procedure TITSFReader.LookupPMGLchunk(Stream: TMemoryStream; out PMGLChunk: TPMGListChunk);
630 begin
631 //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
632 Stream.Read(PMGLChunk, SizeOf(PMGLChunk));
633 {$IFDEF ENDIAN_BIG}
634 with PMGLChunk do begin
635 UnusedSpace := LEtoN(UnusedSpace);
636 //Unknown1
637 PreviousChunkIndex := LEtoN(PreviousChunkIndex);
638 NextChunkIndex := LEtoN(NextChunkIndex);
639 end;
640 {$ENDIF}
641 end;
642
ReadPMGLchunkEntryFromStreamnull643 function TITSFReader.ReadPMGLchunkEntryFromStream(Stream: TMemoryStream; var PMGLEntry: TPMGListChunkEntry): Boolean;
644 var
645 Buf: array [0..1023] of char;
646 NameLength: LongInt;
647 begin
648 Result := False;
649 //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
650 NameLength := LongInt(GetCompressedInteger(Stream));
651
652 if NameLength > 1022 then NameLength := 1022;
653 Stream.Read(buf[0], NameLength);
654 buf[NameLength] := #0;
655 PMGLEntry.Name := buf;
656 PMGLEntry.ContentSection := LongWord(GetCompressedInteger(Stream));
657 PMGLEntry.ContentOffset := GetCompressedInteger(Stream);
658 PMGLEntry.DecompressedLength := GetCompressedInteger(Stream);
659 if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check
660 Result := True;
661 end;
662
663 procedure TITSFReader.LookupPMGIchunk(Stream: TMemoryStream; out PMGIChunk: TPMGIIndexChunk);
664 begin
665 //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
666 Stream.Read(PMGIChunk, SizeOf(PMGIChunk));
667 {$IFDEF ENDIAN_BIG}
668 with PMGIChunk do begin
669 UnusedSpace := LEtoN(UnusedSpace);
670 end;
671 {$ENDIF}
672 end;
673
ReadPMGIchunkEntryFromStreamnull674 function TITSFReader.ReadPMGIchunkEntryFromStream(Stream: TMemoryStream;
675 var PMGIEntry: TPMGIIndexChunkEntry): Boolean;
676 var
677 Buf: array [0..1023] of char;
678 NameLength: LongInt;
679 begin
680 Result := False;
681 //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
682 NameLength := LongInt(GetCompressedInteger(Stream));
683 if NameLength > 1023 then NameLength := 1023;
684 Stream.Read(buf, NameLength);
685
686 buf[NameLength] := #0;
687 PMGIEntry.Name := buf;
688
689 PMGIEntry.ListingChunk := GetCompressedInteger(Stream);
690 if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check
691 Result := True;
692 end;
693
694 constructor TITSFReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
695 begin
696 fStream := AStream;
697 fStream.Position := 0;
698 fFreeStreamOnDestroy := FreeStreamOnDestroy;
699 ReadHeader;
700 if not IsValidFile then Exit;
701 end;
702
703 destructor TITSFReader.Destroy;
704 begin
705 if fFreeStreamOnDestroy then FreeAndNil(fStream);
706
707 inherited Destroy;
708 end;
709
IsValidFilenull710 function TITSFReader.IsValidFile: Boolean;
711 begin
712 if (fStream = nil) then ChmLastError := ERR_STREAM_NOT_ASSIGNED
713 else if (fITSFHeader.ITSFsig <> 'ITSF') then ChmLastError := ERR_NOT_VALID_FILE
714 //else if (fITSFHeader.Version <> 2) and (fITSFHeader.Version <> 3)
715 else if not (fITSFHeader.Version in [2..4])
716 then
717 ChmLastError := ERR_NOT_SUPPORTED_VERSION;
718 Result := ChmLastError = ERR_NO_ERR;
719 end;
720
721 procedure TITSFReader.GetCompleteFileList(ForEach: TFileEntryForEach; AIncludeInternalFiles: Boolean = True);
722 var
723 ChunkStream: TMemoryStream;
724 I : Integer;
725 Entry: TPMGListChunkEntry;
726 PMGLChunk: TPMGListChunk;
727 CutOffPoint: Integer;
728 NameLength: Integer;
729 {$IFDEF CHM_DEBUG_CHUNKS}
730 PMGIChunk: TPMGIIndexChunk;
731 PMGIndex: Integer;
732 {$ENDIF}
733 begin
734 if not assigned(ForEach) then Exit;
735 ChunkStream := TMemoryStream.Create;
736 {$IFDEF CHM_DEBUG_CHUNKS}
737 WriteLn('ChunkCount = ',fDirectoryHeader.DirectoryChunkCount);
738 {$ENDIF}
739 for I := 0 to fDirectoryHeader.DirectoryChunkCount-1 do begin
740 GetDirectoryChunk(I, ChunkStream);
741 case ChunkType(ChunkStream) of
742 ctPMGL:
743 begin
744 LookupPMGLchunk(ChunkStream, PMGLChunk);
745 {$IFDEF CHM_DEBUG_CHUNKS}
746 WriteLn('PMGL: ', I, ' Prev PMGL: ', PMGLChunk.PreviousChunkIndex, ' Next PMGL: ', PMGLChunk.NextChunkIndex);
747 {$ENDIF}
748 CutOffPoint := ChunkStream.Size - PMGLChunk.UnusedSpace;
749 while ChunkStream.Position < CutOffPoint do begin
750 NameLength := GetCompressedInteger(ChunkStream);
751 if (ChunkStream.Position > CutOffPoint) then Continue; // we have entered the quickref section
752 SetLength(Entry.Name, NameLength);
753 ChunkStream.ReadBuffer(Entry.Name[1], NameLength);
754 if (Entry.Name = '') or (ChunkStream.Position > CutOffPoint) then Break; // we have entered the quickref section
755 Entry.ContentSection := GetCompressedInteger(ChunkStream);
756 if ChunkStream.Position > CutOffPoint then Break; // we have entered the quickref section
757 Entry.ContentOffset := GetCompressedInteger(ChunkStream);
758 if ChunkStream.Position > CutOffPoint then Break; // we have entered the quickref section
759 Entry.DecompressedLength := GetCompressedInteger(ChunkStream);
760 if ChunkStream.Position > CutOffPoint then Break; // we have entered the quickref section
761 fCachedEntry := Entry; // if the caller trys to get this data we already know where it is :)
762 if (Length(Entry.Name) = 1)
763 or (AIncludeInternalFiles
764 or
765 ((Length(Entry.Name) > 1) and (not(Entry.Name[2] in ['#','$',':']))))
766 then
767 ForEach(Entry.Name, Entry.ContentOffset, Entry.DecompressedLength, Entry.ContentSection);
768 end;
769 end;
770 {$IFDEF CHM_DEBUG_CHUNKS}
771 ctPMGI:
772 begin
773 WriteLn('PMGI: ', I);
774 LookupPMGIchunk(ChunkStream, PMGIChunk);
775 CutOffPoint := ChunkStream.Size - PMGIChunk.UnusedSpace - 10;
776 while ChunkStream.Position < CutOffPoint do begin
777 NameLength := GetCompressedInteger(ChunkStream);
778 SetLength(Entry.Name, NameLength);
779 ChunkStream.ReadBuffer(Entry.Name[1], NameLength);
780 PMGIndex := GetCompressedInteger(ChunkStream);
781 WriteLn(Entry.Name, ' ', PMGIndex);
782 end;
783 end;
784 ctUnknown: WriteLn('UNKNOWN CHUNKTYPE!' , I);
785 {$ENDIF}
786 end;
787 end;
788 end;
789
ObjectExistsnull790 function TITSFReader.ObjectExists(Name: String): QWord;
791 var
792 ChunkStream: TMemoryStream;
793 QuickRefCount: Word;
794 QuickRefIndex: array of Word;
795 ItemCount: Integer;
796 procedure ReadQuickRefSection;
797 var
798 OldPosn: QWord;
799 Posn: Integer;
800 I: Integer;
801 begin
802 OldPosn := ChunkStream.Position;
803 Posn := ChunkStream.Size-SizeOf(Word);
804 ChunkStream.Position := Posn;
805
806 ItemCount := LEToN(ChunkStream.ReadWord);
807 //WriteLn('Max ITems for next block = ', ItemCount-1);
808 QuickRefCount := ItemCount div (1 + (1 shl fDirectoryHeader.Density));
809 //WriteLn('QuickRefCount = ' , QuickRefCount);
810 SetLength(QuickRefIndex, QuickRefCount+1);
811 for I := 1 to QuickRefCount do begin
812 Dec(Posn, SizeOf(Word));
813 ChunkStream.Position := Posn;
814 QuickRefIndex[I] := LEToN(ChunkStream.ReadWord);
815 end;
816 Inc(QuickRefCount);
817 ChunkStream.Position := OldPosn;
818 end;
ReadStringnull819 function ReadString(StreamPosition: Integer = -1): String;
820 var
821 NameLength: Integer;
822 begin
823 if StreamPosition > -1 then ChunkStream.Position := StreamPosition;
824
825 NameLength := GetCompressedInteger(ChunkStream);
826 SetLength(Result, NameLength);
827 if NameLength>0 then
828 ChunkStream.Read(Result[1], NameLength);
829 end;
830 var
831 PMGLChunk: TPMGListChunk;
832 PMGIChunk: TPMGIIndexChunk;
833 //ChunkStream: TMemoryStream; declared above
834 Entry: TPMGListChunkEntry;
835 NextIndex: Integer;
836 EntryName: String;
837 CRes: Integer;
838 I: Integer;
839 begin
840 Result := 0;
841 //WriteLn('Looking for URL : ', Name);
842 if Name = '' then Exit;
843 if fDirectoryHeader.DirectoryChunkCount = 0 then exit;
844
845 //WriteLn('Looking for ', Name);
846 if Name = fCachedEntry.Name then
847 Exit(fCachedEntry.DecompressedLength); // we've already looked it up
848
849 ChunkStream := TMemoryStream.Create;
850
851 try
852
853 NextIndex := fDirectoryHeader.IndexOfRootChunk;
854 if NextIndex < 0 then NextIndex := 0; // no PMGI chunks
855
856 while NextIndex > -1 do begin
857 GetDirectoryChunk(NextIndex, ChunkStream);
858 NextIndex := -1;
859 ReadQuickRefSection;
860 {$IFDEF CHM_DEBUG}
861 WriteLn('In Block ', NextIndex);
862 {$endif}
863 case ChunkType(ChunkStream) of
864 ctUnknown: // something is wrong
865 begin
866 {$IFDEF CHM_DEBUG}WriteLn(NextIndex, ' << Unknown BlockType!');{$ENDIF}
867 Break;
868 end;
869 ctPMGI: // we must follow the PMGI tree until we reach a PMGL block
870 begin
871 LookupPMGIchunk(ChunkStream, PMGIChunk);
872
873 //QuickRefIndex[0] := ChunkStream.Position;
874
875 I := 0;
876 while ChunkStream.Position <= ChunkStream.Size - PMGIChunk.UnusedSpace do begin;
877 EntryName := ReadString;
878 if EntryName = '' then break;
879 if ChunkStream.Position >= ChunkStream.Size - PMGIChunk.UnusedSpace then break;
880 CRes := ChmCompareText(Name, EntryName);
881 if CRes = 0 then begin
882 // no more need of this block. onto the next!
883 NextIndex := GetCompressedInteger(ChunkStream);
884 Break;
885 end;
886 if CRes < 0 then begin
887 if I = 0 then Break; // File doesn't exist
888 // file is in previous entry
889 Break;
890 end;
891 NextIndex := GetCompressedInteger(ChunkStream);
892 Inc(I);
893 end;
894 end;
895 ctPMGL:
896 begin
897 LookupPMGLchunk(ChunkStream, PMGLChunk);
898 QuickRefIndex[0] := ChunkStream.Position;
899 I := 0;
900 while ChunkStream.Position <= ChunkStream.Size - PMGLChunk.UnusedSpace do begin
901 // we consume the entry by reading it
902 Entry.Name := ReadString;
903 if Entry.Name = '' then break;
904 if ChunkStream.Position >= ChunkStream.Size - PMGLChunk.UnusedSpace then break;
905
906 Entry.ContentSection := GetCompressedInteger(ChunkStream);
907 Entry.ContentOffset := GetCompressedInteger(ChunkStream);
908 Entry.DecompressedLength := GetCompressedInteger(ChunkStream);
909
910 CRes := ChmCompareText(Name, Entry.Name);
911 if CRes = 0 then begin
912 fCachedEntry := Entry;
913 Result := Entry.DecompressedLength;
914 Break;
915 end;
916 Inc(I);
917 end;
918 end; // case
919 end;
920 end;
921 finally
922 ChunkStream.Free;
923 end;
924 end;
925
TITSFReader.GetObjectnull926 function TITSFReader.GetObject(Name: String): TMemoryStream;
927 var
928 SectionNames: TStringList;
929 Entry: TPMGListChunkEntry;
930 SectionName: String;
931 begin
932 Result := nil;
933 if ObjectExists(Name) = 0 then begin
934 //WriteLn('Object ', name,' Doesn''t exist or is zero sized.');
935 Exit;
936 end;
937
938 Entry := fCachedEntry;
939 if Entry.ContentSection = 0 then begin
940 Result := TMemoryStream.Create;
941 fStream.Position := fHeaderSuffix.Offset+ Entry.ContentOffset;
942 Result.CopyFrom(fStream, fCachedEntry.DecompressedLength);
943 end
944 else begin // we have to get it from ::DataSpace/Storage/[MSCompressed,Uncompressed]/ControlData
945 GetSections(SectionNames);
946 FmtStr(SectionName, '::DataSpace/Storage/%s/',[SectionNames[Entry.ContentSection]]);
947 Result := GetBlockFromSection(SectionName, Entry.ContentOffset, Entry.DecompressedLength);
948 SectionNames.Free;
949 end;
950 if Result <> nil then Result.Position := 0;
951 end;
952
GetContextUrlnull953 function TChmReader.GetContextUrl(Context: THelpContext): String;
954 begin
955 // will get '' if context not found
956 Result := fContextList.GetURL(Context);
957 end;
958
TChmReader.LookupTopicByIDnull959 function TChmReader.LookupTopicByID ( ATopicID: Integer; out ATitle: String) : String;
960 var
961 TopicURLTBLOffset: DWord;
962 TopicTitleOffset: DWord;
963 begin
964 Result := '';
965 ATitle := '';
966 //WriteLn('Getting topic# ',ATopicID);
967 if not CheckCommonStreams then
968 Exit;
969 fTOPICSStream.Position := ATopicID * 16;
970 if fTOPICSStream.Position = ATopicID * 16 then
971 begin
972 fTOPICSStream.ReadDWord;
973 TopicTitleOffset := LEtoN(fTOPICSStream.ReadDWord);
974 TopicURLTBLOffset := LEtoN(fTOPICSStream.ReadDWord);
975 {$ifdef binindex}
976 {$ifndef nonumber}
977 writeln('titleid:',TopicTitleOffset);
978 writeln('urlid :',TopicURLTBLOffset);
979 {$endif}
980 {$endif}
981 if TopicTitleOffset <> $FFFFFFFF then
982 ATitle := ReadStringsEntry(TopicTitleOffset);
983 //WriteLn('Got a title: ', ATitle);
984 Result := ReadURLSTR(TopicURLTBLOffset);
985 end;
986 end;
987
988 const DefBlockSize = 2048;
989
LoadBtreeHeadernull990 function LoadBtreeHeader(m:TMemoryStream;var btreehdr:TBtreeHeader):boolean;
991
992 begin
993 if m.size<sizeof(TBtreeHeader) Then
994 Exit(False);
995 result:=true;
996 m.read(btreeHdr,sizeof(TBtreeHeader));
997 {$IFDEF ENDIAN_BIG}
998 btreehdr.flags :=LEToN(btreehdr.flags);
999 btreehdr.blocksize :=LEToN(btreehdr.blocksize);
1000 btreehdr.lastlstblock :=LEToN(btreehdr.lastlstblock);
1001 btreehdr.indexrootblock:=LEToN(btreehdr.indexrootblock);
1002 btreehdr.nrblock :=LEToN(btreehdr.nrblock);
1003 btreehdr.treedepth :=LEToN(btreehdr.treedepth);
1004 btreehdr.nrkeywords :=LEToN(btreehdr.nrkeywords);
1005 btreehdr.codepage :=LEToN(btreehdr.codepage);
1006 btreehdr.lcid :=LEToN(btreehdr.lcid);
1007 btreehdr.ischm :=LEToN(btreehdr.ischm);
1008 {$endif}
1009 end;
1010
readwcharstringnull1011 function readwcharstring(var head:pbyte;tail:pbyte;var readv : ansistring):boolean;
1012
1013 var pw : PWord;
1014 oldhead : PByte;
1015 ws : WideString;
1016 n : Integer;
1017 begin
1018 oldhead:=head;
1019 pw:=pword(head);
1020 while (pw<pword(tail)) and (pw^<>word(0)) do
1021 inc(pw);
1022 inc(pw); // skip #0#0.
1023 head:=pbyte(pw);
1024 result:=head<tail;
1025
1026 n:=head-oldhead;
1027
1028 pw:=pword(@oldhead[n]);
1029 if (n>1) and (pw[-1]=0) then
1030 dec(n,2); // remove trailing #0
1031 setlength(ws,n div sizeof(widechar));
1032 move(oldhead^,ws[1],n);
1033 for n:=1 to length(ws) do
1034 word(ws[n]):=LEToN(word(ws[n]));
1035 readv:=ws; // force conversion for now, and hope it doesn't require cwstring
1036 end;
1037
1038
1039 Type TLookupRec = record
1040 item : TChmSiteMapItems;
1041 depth : integer;
1042 end;
1043 TLookupDict = TDictionary<string,TLookupRec>;
GetIndexSitemapnull1044 function TChmReader.GetIndexSitemap(ForceXML:boolean=false): TChmSiteMap;
1045 var Index : TMemoryStream;
1046
1047
1048 function AbortAndTryTextual:tchmsitemap;
1049
1050 begin
1051 if Assigned(Index) Then Index.Free;
1052 // Second Try text Index
1053 Index := GetObject(IndexFile);
1054 if Index <> nil then
1055 begin
1056 Result := TChmSiteMap.Create(stIndex);
1057 Result.LoadFromStream(Index);
1058 Index.Free;
1059 end
1060 else
1061 result:=nil;
1062 end;
1063
1064 var
1065 parentitem:TChmSiteMapItems;
1066 itemstack :TObjectList;
1067 lookup : TLookupDict;
1068 curitemdepth : integer;
1069 sitemap : TChmSiteMap;
1070
1071 function getitem(anentrydepth:integer):Tchmsitemapitems;
1072 begin
1073 if anentrydepth<itemstack.count then
1074 result:=tchmsitemapitems(itemstack[anentrydepth])
1075 else
1076 begin
1077 {$ifdef binindex}
1078 writeln('pop from emptystack at ',anentrydepth,' ',itemstack.count);
1079 {$endif}
1080 result:=tchmsitemapitems(itemstack[itemstack.Count-1]);
1081 end;
1082 end;
1083
1084 procedure pushitem(anentrydepth:integer;anitem:tchmsitemapitem);
1085 begin
1086
1087 if anentrydepth<itemstack.count then
1088 itemstack[anentrydepth]:=anitem.children
1089 else
1090 if anentrydepth=itemstack.count then
1091 itemstack.add(anitem.Children)
1092 else
1093 begin
1094 {$ifdef binindex}
1095 writeln('push more than 1 larger ' ,anentrydepth,' ',itemstack.count);
1096 {$endif}
1097 itemstack.add(anitem.Children)
1098 end;
1099 end;
1100 procedure parselistingblock(p:pbyte);
1101 var
1102
1103 Item : TChmSiteMapItem;
1104
1105 hdr:PBTreeBlockHeader;
1106 head,tail : pbyte;
1107 isseealso,
1108 entrydepth,
1109 nrpairs : Integer;
1110 i : integer;
1111 PE : PBtreeBlockEntry;
1112 title : string;
1113 CharIndex,
1114 ind:integer;
1115 seealsostr,
1116 s,
1117 Name : AnsiString;
1118 path,
1119 shortname : AnsiString;
1120 anitem:TChmSiteMapItems;
1121 litem : TChmSiteMapItem;
1122 lookupitem : TLookupRec;
1123
1124 function readvalue:string;
1125 begin
1126 result:='';
1127 title:='';
1128 if head<tail Then
1129 begin
1130 ind:=LEToN(plongint(head)^);
1131
1132 result:=lookuptopicbyid(ind,title);
1133 {$ifdef binindex}
1134 writeln(i:3,' topic: ' {$ifndef nonumber},' (',ind,')' {$endif});
1135 writeln(' title: ',title);
1136 writeln(' result: ',result);
1137 {$endif}
1138 inc(head,4);
1139 end;
1140 end;
1141
1142 procedure dumpstack;
1143 var fp : TChmSiteMapItems;
1144 ix : Integer;
1145 begin
1146 for ix:=0 to itemstack.Count-1 do
1147 begin
1148 fp :=TChmSiteMapItems(itemstack[ix]);
1149 writeln(ix:3,' ',fp.parentname);
1150 end;
1151 end;
1152
1153 begin
1154 //setlength (curitem,10);
1155 hdr:=PBTreeBlockHeader(p);
1156 hdr^.Length :=LEToN(hdr^.Length);
1157 hdr^.NumberOfEntries :=LEToN(hdr^.NumberOfEntries);
1158 hdr^.IndexOfPrevBlock:=LEToN(hdr^.IndexOfPrevBlock);
1159 hdr^.IndexOfNextBlock:=LEToN(hdr^.IndexOfNextBlock);
1160
1161 {$ifdef binindex}
1162 writeln('hdr:',hdr^.length);
1163 {$endif}
1164 tail:=p+(2048-hdr^.length);
1165 head:=p+sizeof(TBtreeBlockHeader);
1166
1167 {$ifdef binindex}
1168 {$ifndef nonumber}
1169 writeln('previndex : ',hdr^.IndexOfPrevBlock);
1170 writeln('nextindex : ',hdr^.IndexOfNextBlock);
1171 {$endif}
1172 {$endif}
1173 while head<tail do
1174 begin
1175 //writeln(tail-head);
1176 if not ReadWCharString(Head,Tail,Name) Then
1177 Break;
1178 {$ifdef binindex}
1179 Writeln('name : ',name);
1180 {$endif}
1181 if (head+sizeof(TBtreeBlockEntry))>=tail then
1182 break;
1183 PE :=PBtreeBlockEntry(head);
1184 NrPairs :=LEToN(PE^.nrpairs);
1185 IsSeealso:=LEToN(PE^.isseealso);
1186 EntryDepth:=LEToN(PE^.entrydepth);
1187 CharIndex:=LEToN(PE^.CharIndex);
1188 Path:='';
1189
1190 if charindex<>0 then
1191 begin
1192 Path:=Trim(Copy(Name,1,charindex-2));
1193 Shortname:=trim(copy(Name,charindex,Length(Name)-Charindex+1));
1194 end
1195 else
1196 shortname:=name;
1197 {$ifdef binindex}
1198 writeln('depth:', curitemdepth, ' ' ,entrydepth);
1199 {$endif}
1200 if curitemdepth=entrydepth then // same level, so of same parent
1201 begin
1202 item:=parentitem.newitem;
1203 pushitem(entrydepth+1,item);
1204 end
1205 else
1206 if curitemdepth=entrydepth-1 then // new child, one lower.
1207 begin
1208 parentitem:=getitem(entrydepth);
1209 item:=parentitem.newitem;
1210 pushitem(entrydepth+1,item);
1211 end
1212 else
1213 if entrydepth<curitemdepth then
1214 begin
1215 parentitem:=getitem(entrydepth);
1216 {$ifdef binindex}
1217 writeln('bingo!', parentitem.parentname);
1218 dumpstack;
1219 {$endif}
1220 item:=parentitem.newitem;
1221 pushitem(entrydepth+1,item);
1222 end;
1223
1224 curitemdepth:=entrydepth;
1225 {$ifdef binindex}
1226 writeln('lookup:', Name, ' = ', path,' = ',shortname);
1227 {$endif}
1228
1229 (* if lookup.trygetvalue(path,lookupitem) then
1230 begin
1231 // if lookupitem.item<>parentitem then
1232 // writeln('mismatch: ',lookupitem.item.item[0].name,' ',name);
1233 { if curitemdepth<entrydepth then
1234 begin
1235 writeln('lookup ok!',curitemdepth,' ' ,entrydepth);
1236 curitemdepth:=entrydepth;
1237 end
1238 else
1239 begin
1240 writeln('lookup odd!',curitemdepth,' ' ,entrydepth);
1241 end;
1242 curitemdepth:=lookupitem.depth+1;
1243 parentitem:=lookupitem.item;}
1244 end
1245 else
1246 begin
1247 // parentitem:=sitemap.Items;
1248 if not curitemdepth=entrydepth then
1249 writeln('no lookup odd!',curitemdepth,' ' ,entrydepth);
1250 end; *)
1251 { item:=parentitem.newitem;}
1252 lookupitem.item:=item.children;
1253 lookupitem.depth:=entrydepth;
1254 lookup.addorsetvalue(name,lookupitem);
1255 item.AddName(Shortname);
1256
1257 {$ifdef binindex}
1258 Writeln('seealso : ',IsSeeAlso);
1259 Writeln('entrydepth: ',EntryDepth);
1260 Writeln('charindex : ',charindex );
1261 Writeln('Nrpairs : ',NrPairs);
1262 Writeln('CharIndex : ',charindex);
1263 {$endif}
1264
1265 inc(head,sizeof(TBtreeBlockEntry));
1266 if isseealso>0 then
1267 begin
1268 if not ReadWCharString(Head,Tail,SeeAlsoStr) Then
1269 Break;
1270 // have to figure out first what to do with it.
1271 // is See Also really mutually exclusive with pairs?
1272 // or is the number of pairs equal to the number of seealso
1273 // strings?
1274 {$ifdef binindex}
1275 writeln('seealso: ',seealsostr);
1276 {$endif}
1277 item.AddSeeAlso(seealsostr);
1278 end
1279 else
1280 begin
1281 if NrPairs>0 Then
1282 begin
1283 {$ifdef binindex}
1284 writeln('Pairs : ');
1285 {$endif}
1286
1287 for i:=0 to nrpairs-1 do
1288 begin
1289 s:=readvalue;
1290 // if not ((i=0) and (title=shortname)) then
1291 item.addname(title);
1292 item.addlocal(s);
1293 end;
1294 end;
1295 end;
1296 inc(head,4); // always 1
1297 {$ifdef binindex}
1298 if head<tail then
1299 writeln('Zero based index (13 higher than last) :',plongint(head)^);
1300 {$endif}
1301 inc(head,4); // zero based index (13 higher than last
1302 end;
1303 end;
1304
1305 var TryTextual : boolean;
1306 BHdr : TBTreeHeader;
1307 block : Array[0..2047] of Byte;
1308 i : Integer;
1309
1310 begin
1311 Result := nil; SiteMap:=Nil;
1312 // First Try Binary
1313 Index := GetObject('/$WWKeywordLinks/BTree');
1314 if (Index = nil) or ForceXML then
1315 begin
1316 Result:=AbortAndTryTextual; // frees index if needed
1317 Exit;
1318 end;
1319 if not CheckCommonStreams then
1320 begin
1321 index.free;
1322 Result:=AbortAndTryTextual; // frees index if needed
1323 Exit;
1324 end;
1325
1326 lookup:=TDictionary<string,TLookupRec>.create;
1327 SiteMap:=TChmSitemap.Create(StIndex);
1328 itemstack :=TObjectList.create(false);
1329 //Item :=Nil; // cached last created item, in case we need to make
1330 // a child.
1331 parentitem:=sitemap.Items;
1332 itemstack.add(parentitem); // level 0
1333 curitemdepth:=0;
1334 TryTextual:=True;
1335 BHdr.LastLstBlock:=0;
1336 if LoadBtreeHeader(index,BHdr) and (BHdr.LastLstBlock>=0) Then
1337 begin
1338 if BHdr.BlockSize=defblocksize then
1339 begin
1340 for i:=0 to BHdr.lastlstblock do
1341 begin
1342 if (index.size-index.position)>=defblocksize then // skips last incomplete block?
1343 begin
1344 Index.read(block,defblocksize);
1345 parselistingblock(@block)
1346 end;
1347 end;
1348 trytextual:=false;
1349 result:=sitemap;
1350 end;
1351 end;
1352 if trytextual then
1353 begin
1354 sitemap.free;
1355 Result:=AbortAndTryTextual; // frees index if needed
1356 end
1357 else Index.Free;
1358 itemstack.free;
1359 lookup.free;
1360 end;
1361
GetTOCSitemapnull1362 function TChmReader.GetTOCSitemap(ForceXML:boolean=false): TChmSiteMap;
1363 function AddTOCItem(TOC: TStream; AItemOffset: DWord; SiteMapITems: TChmSiteMapItems): DWord;
1364 var
1365 Props: DWord;
1366 Item: TChmSiteMapItem;
1367 NextEntry: DWord;
1368 TopicsIndex: DWord;
1369 Title, Local : String;
1370 begin
1371 Toc.Position:= AItemOffset + 4;
1372 Item := SiteMapITems.NewItem;
1373 Props := LEtoN(TOC.ReadDWord);
1374 if (Props and TOC_ENTRY_HAS_LOCAL) = 0 then
1375 Item.AddName(ReadStringsEntry(LEtoN(TOC.ReadDWord)))
1376 else
1377 begin
1378 TopicsIndex := LEtoN(TOC.ReadDWord);
1379 Local:=LookupTopicByID(TopicsIndex, Title);
1380 Item.AddName(Title);
1381 Item.AddLocal(Local);
1382 end;
1383 TOC.ReadDWord;
1384 Result := LEtoN(TOC.ReadDWord);
1385 if Props and TOC_ENTRY_HAS_CHILDREN > 0 then
1386 begin
1387 NextEntry := LEtoN(TOC.ReadDWord);
1388 repeat
1389 NextEntry := AddTOCItem(TOC, NextEntry, Item.Children);
1390 until NextEntry = 0;
1391 end;
1392
1393 end;
1394
1395 var
1396 TOC: TStream;
1397 TOPICSOffset: DWord;
1398 EntriesOffset: DWord;
1399 EntryCount: DWord;
1400 EntryInfoOffset: DWord;
1401 NextItem: DWord;
1402 begin
1403 Result := nil;
1404 // First Try Binary
1405 TOC := GetObject('/#TOCIDX');
1406 if (TOC = nil) or ForceXML then
1407 begin
1408 if Assigned(TOC) Then Toc.Free;
1409 // Second Try text toc
1410 TOC := GetObject(TOCFile);
1411 if TOC <> nil then
1412 begin
1413 Result := TChmSiteMap.Create(stTOC);
1414 Result.LoadFromStream(TOC);
1415 Toc.Free;
1416 end;
1417 Exit;
1418 end;
1419
1420 // TOPICS URLSTR URLTBL must all exist to read binary toc
1421 // if they don't then try text file
1422 if not CheckCommonStreams then
1423 begin
1424 TOC.Free;
1425 TOC := GetObject(TOCFile);
1426 if TOC <> nil then
1427 begin
1428 Result := TChmSiteMap.Create(stTOC);
1429 Result.LoadFromStream(TOC);
1430 Toc.Free;
1431 end;
1432 Exit;
1433 end;
1434
1435 // Binary Toc Exists
1436 Result := TChmSiteMap.Create(stTOC);
1437
1438 EntryInfoOffset := NtoLE(TOC.ReadDWord);
1439 EntriesOffset := NtoLE(TOC.ReadDWord);
1440 EntryCount := NtoLE(TOC.ReadDWord);
1441 TOPICSOffset := NtoLE(TOC.ReadDWord);
1442
1443 if EntryCount = 0 then
1444 begin
1445 Toc.Free;
1446 Exit;
1447 end;
1448
1449 NextItem := EntryInfoOffset;
1450 repeat
1451 NextItem := AddTOCItem(Toc, NextItem, Result.Items);
1452 until NextItem = 0;
1453 TOC.Free;
1454 end;
1455
TChmReader.HasContextListnull1456 function TChmReader.HasContextList: Boolean;
1457 begin
1458 Result := fContextList.Count > 0;
1459 end;
1460
1461 procedure TITSFReader.GetSections(out Sections: TStringList);
1462 var
1463 Stream: TStream;
1464 EntryCount: Word;
1465 X: Integer;
1466 {$IFDEF ENDIAN_BIG}
1467 I: Integer;
1468 {$ENDIF}
1469 WString: array [0..31] of WideChar;
1470 StrLength: Word;
1471 begin
1472 Sections := TStringList.Create;
1473 //WriteLn('::DataSpace/NameList Size = ', ObjectExists('::DataSpace/NameList'));
1474 Stream := GetObject('::DataSpace/NameList');
1475
1476 if Stream = nil then begin
1477 //WriteLn('Failed to get ::DataSpace/NameList!');
1478 exit;
1479 end;
1480
1481 Stream.Position := 2;
1482 EntryCount := LEtoN(Stream.ReadWord);
1483 for X := 0 to EntryCount -1 do begin
1484 StrLength := LEtoN(Stream.ReadWord);
1485 if StrLength > 31 then StrLength := 31;
1486 Stream.Read(WString, SizeOf(WideChar)*(StrLength+1)); // the strings are stored null terminated
1487 {$IFDEF ENDIAN_BIG}
1488 for I := 0 to StrLength-1 do
1489 WString[I] := WideChar(LEtoN(Ord(WString[I])));
1490 {$ENDIF}
1491 Sections.Add(WString);
1492 end;
1493 Stream.Free;
1494 end;
1495
TITSFReader.GetBlockFromSectionnull1496 function TITSFReader.GetBlockFromSection(SectionPrefix: String; StartPos: QWord;
1497 BlockLength: QWord): TMemoryStream;
1498 var
1499 Compressed: Boolean;
1500 Sig: Array [0..3] of char;
1501 CompressionVersion: LongWord;
1502 CompressedSize: QWord;
1503 UnCompressedSize: QWord;
1504 //LZXResetInterval: LongWord;
1505 //LZXWindowSize: LongWord;
1506 //LZXCacheSize: LongWord;
1507 ResetTableEntry: TPMGListChunkEntry;
1508 ResetTable: TLZXResetTableArr;
1509 WriteCount: QWord;
1510 BlockWriteLength: QWord;
1511 WriteStart: LongWord;
1512 ReadCount:LongInt;
1513 LZXState: PLZXState;
1514 InBuf: array of Byte;
1515 OutBuf: PByte;
1516 BlockSize: QWord;
1517 X: Integer;
1518 FirstBlock, LastBlock: LongInt;
1519 ResultCode: LongInt;
1520 procedure ReadBlock;
1521 begin
1522 if ReadCount > Length(InBuf) then
1523 SetLength(InBuf, ReadCount);
1524 fStream.Read(InBuf[0], ReadCount);
1525 end;
1526 begin
1527 // okay now the fun stuff ;)
1528 Result := nil;
1529 Compressed := ObjectExists(SectionPrefix+'Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/ResetTable')>0;
1530 // the easy method
1531 if Not(Compressed) then begin
1532 if ObjectExists(SectionPrefix+'Content') > 0 then begin
1533 Result := TMemoryStream.Create;
1534 fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + StartPos;
1535 Result.CopyFrom(fStream, BlockLength);
1536 end;
1537 Exit;
1538 end
1539 else
1540 ResetTableEntry := fCachedEntry;
1541
1542 // First make sure that it is a compression we can read
1543 if ObjectExists(SectionPrefix+'ControlData') > 0 then begin
1544 fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + 4;
1545 fStream.Read(Sig, 4);
1546 if Sig <> 'LZXC' then Exit;
1547 CompressionVersion := LEtoN(fStream.ReadDWord);
1548 if CompressionVersion > 2 then exit;
1549 {LZXResetInterval := }LEtoN(fStream.ReadDWord);
1550 {LZXWindowSize := }LEtoN(fStream.ReadDWord);
1551 {LZXCacheSize := }LEtoN(fStream.ReadDWord);
1552
1553
1554 BlockSize := FindBlocksFromUnCompressedAddr(ResetTableEntry, CompressedSize, UnCompressedSize, ResetTable);
1555 if UncompressedSize > 0 then ; // to avoid a compiler note
1556 if StartPos > 0 then
1557 FirstBlock := StartPos div BlockSize
1558 else
1559 FirstBlock := 0;
1560 LastBlock := (StartPos+BlockLength) div BlockSize;
1561
1562 if ObjectExists(SectionPrefix+'Content') = 0 then exit;
1563 //WriteLn('Compressed Data start''s at: ', fHeaderSuffix.Offset + fCachedEntry.ContentOffset,' Size is: ', fCachedEntry.DecompressedLength);
1564 Result := TMemoryStream.Create;
1565 Result.Size := BlockLength;
1566 SetLength(InBuf,BlockSize);
1567 OutBuf := GetMem(BlockSize);
1568 // First Init a PLZXState
1569 LZXState := LZXinit(16);
1570 if LZXState = nil then begin
1571 Exit;
1572 end;
1573 // if FirstBlock is odd (1,3,5,7 etc) we have to read the even block before it first.
1574 if FirstBlock and 1 = 1 then begin
1575 fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + (ResetTable[FirstBLock-1]);
1576 ReadCount := ResetTable[FirstBlock] - ResetTable[FirstBlock-1];
1577 BlockWriteLength:=BlockSize;
1578 ReadBlock;
1579 ResultCode := LZXdecompress(LZXState, @InBuf[0], OutBuf, ReadCount, LongInt(BlockWriteLength));
1580 end;
1581 // now start the actual decompression loop
1582 for X := FirstBlock to LastBlock do begin
1583 fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + (ResetTable[X]);
1584
1585 if X = FirstBLock then
1586 WriteStart := StartPos - (X*BlockSize)
1587 else
1588 WriteStart := 0;
1589
1590 if X = High(ResetTable) then
1591 ReadCount := CompressedSize - ResetTable[X]
1592 else
1593 ReadCount := ResetTable[X+1] - ResetTable[X];
1594
1595 BlockWriteLength := BlockSize;
1596
1597 if FirstBlock = LastBlock then begin
1598 WriteCount := BlockLength;
1599 end
1600 else if X = LastBlock then
1601 WriteCount := (StartPos+BlockLength) - (X*BlockSize)
1602 else WriteCount := BlockSize - WriteStart;
1603
1604 ReadBlock;
1605 ResultCode := LZXdecompress(LZXState, @InBuf[0], OutBuf, ReadCount, LongInt(BlockWriteLength));
1606
1607 //now write the decompressed data to the stream
1608 if ResultCode = DECR_OK then begin
1609 Result.Write(OutBuf[WriteStart], QWord(WriteCount));
1610 end
1611 else begin
1612 {$IFDEF CHM_DEBUG} // windows gui program will cause an exception with writeln's
1613 WriteLn('Decompress FAILED with error code: ', ResultCode);
1614 {$ENDIF}
1615 Result.Free;
1616 Result := Nil;
1617 FreeMem(OutBuf);
1618 SetLength(ResetTable,0);
1619 LZXteardown(LZXState);
1620 Exit;
1621 end;
1622
1623 // if the next block is an even numbered block we have to reset the decompressor state
1624 if (X < LastBlock) and (X and 1 = 1) then LZXreset(LZXState);
1625
1626 end;
1627 FreeMem(OutBuf);
1628 SetLength(ResetTable,0);
1629 LZXteardown(LZXState);
1630 end;
1631 end;
1632
FindBlocksFromUnCompressedAddrnull1633 function TITSFReader.FindBlocksFromUnCompressedAddr(var ResetTableEntry: TPMGListChunkEntry;
1634 out CompressedSize: QWord; out UnCompressedSize: QWord; out LZXResetTable: TLZXResetTableArr): QWord;
1635 var
1636 BlockCount: LongWord;
1637 {$IFDEF ENDIAN_BIG}
1638 I: Integer;
1639 {$ENDIF}
1640 begin
1641 Result := 0;
1642 fStream.Position := fHeaderSuffix.Offset + ResetTableEntry.ContentOffset;
1643 fStream.ReadDWord;
1644 BlockCount := LEtoN(fStream.ReadDWord);
1645 fStream.ReadDWord;
1646 fStream.ReadDWord; // TableHeaderSize;
1647 fStream.Read(UnCompressedSize, SizeOf(QWord));
1648 UnCompressedSize := LEtoN(UnCompressedSize);
1649 fStream.Read(CompressedSize, SizeOf(QWord));
1650 CompressedSize := LEtoN(CompressedSize);
1651 fStream.Read(Result, SizeOf(QWord)); // block size
1652 Result := LEtoN(Result);
1653
1654 // now we are located at the first block index
1655
1656 SetLength(LZXResetTable, BlockCount);
1657 fStream.Read(LZXResetTable[0], SizeOf(QWord)*BlockCount);
1658 {$IFDEF ENDIAN_BIG}
1659 for I := 0 to High(LZXResetTable) do
1660 LZXResetTable[I] := LEtoN(LZXResetTable[I]);
1661 {$ENDIF}
1662 end;
1663
1664 { TContextList }
1665
1666 procedure TContextList.AddContext(Context: THelpContext; Url: String);
1667 var
1668 ContextItem: PContextItem;
1669 begin
1670 New(ContextItem);
1671 Add(ContextItem);
1672 ContextItem^.Context := Context;
1673 ContextItem^.Url := Url;
1674 end;
1675
GetURLnull1676 function TContextList.GetURL(Context: THelpContext): String;
1677 var
1678 X: Integer;
1679 begin
1680 Result := '';
1681 for X := 0 to Count-1 do begin
1682 if PContextItem(Get(X))^.Context = Context then begin
1683 Result := PContextItem(Get(X))^.Url;
1684 Exit;
1685 end;
1686 end;
1687 end;
1688
1689 procedure TContextList.Clear;
1690 var
1691 X: Integer;
1692 begin
1693 for X := Count-1 downto 0 do begin
1694 Dispose(PContextItem(Get(X)));
1695 Delete(X);
1696 end;
1697 end;
1698
1699
1700 { TChmFileList }
1701
1702 procedure TChmFileList.Delete(Index: Integer);
1703 begin
1704 Chm[Index].Free;
1705 inherited Delete(Index);
1706 end;
1707
GetChmnull1708 function TChmFileList.GetChm(AIndex: Integer): TChmReader;
1709 begin
1710 if AIndex = -1 then
1711 Result := fLastChm
1712 else
1713 Result := TChmReader(Objects[AIndex]);
1714 end;
1715
GetFileNamenull1716 function TChmFileList.GetFileName(AIndex: Integer): String;
1717 begin
1718 if AIndex = -1 then
1719 AIndex := IndexOfObject(fLastChm);
1720
1721 Result := Strings[AIndex];
1722 end;
1723
1724 procedure TChmFileList.OpenNewFile(AFileName: String);
1725 var
1726 AStream: TFileStream;
1727 AChm: TChmReader;
1728 AIndex: Integer;
1729 begin
1730 if not FileExists(AFileName) then exit;
1731 AStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
1732 AChm := TChmReader.Create(AStream, True);
1733 AIndex := AddObject(AFileName, AChm);
1734 fLastChm := AChm;
1735 if Assigned(fOnOpenNewFile) then fOnOpenNewFile(Self, AIndex)
1736 else fUnNotifiedFiles.Add(AChm);
1737 end;
1738
CheckOpenFilenull1739 function TChmFileList.CheckOpenFile(AFileName: String): Boolean;
1740 var
1741 X: Integer;
1742
1743 begin
1744 Result := False;
1745 for X := 0 to Count-1 do begin
1746 if ExtractFileName(FileName[X]) = AFileName then begin
1747 fLastChm := Chm[X];
1748 Result := True;
1749 Exit;
1750 end;
1751 end;
1752 if not Result then begin
1753 AFileName := ExtractFilePath(FileName[0])+AFileName;
1754 if FileExists(AFileName) and (LowerCase(ExtractFileExt(AFileName)) = '.chm') then OpenNewFile(AFileName);
1755 Result := True;
1756 end;
1757 end;
1758
MetaObjectExistsnull1759 function TChmFileList.MetaObjectExists(var Name: String): QWord;
1760 var
1761 AFileName: String;
1762 URL: String;
1763 fStart, fEnd: Integer;
1764 Found: Boolean;
1765 begin
1766 Found := False;
1767 Result := 0;
1768 //Known META file link types
1769 // ms-its:name.chm::/topic.htm
1770 //mk:@MSITStore:name.chm::/topic.htm
1771 if Pos('ms-its:', Name) > 0 then begin
1772 fStart := Pos('ms-its:', Name)+Length('ms-its:');
1773 fEnd := Pos('::', Name)-fStart;
1774 AFileName := Copy(Name, fStart, fEnd);
1775 fStart := fEnd+fStart+2;
1776 fEnd := Length(Name) - (fStart-1);
1777 URL := Copy(Name, fStart, fEnd);
1778 Found := True;
1779 end
1780 else if Pos('mk:@MSITStore:', Name) > 0 then begin
1781 fStart := Pos('mk:@MSITStore:', Name)+Length('mk:@MSITStore:');
1782 fEnd := Pos('::', Name)-fStart;
1783 AFileName := Copy(Name, fStart, fEnd);
1784 fStart := fEnd+fStart+2;
1785 fEnd := Length(Name) - (fStart-1);
1786 URL := Copy(Name, fStart, fEnd);
1787 Found := True;
1788 end;
1789 if not Found then exit;
1790 //WriteLn('Looking for URL ', URL, ' in ', AFileName);
1791 if CheckOpenFile(AFileName) then
1792 Result := fLastChm.ObjectExists(URL);
1793 if Result > 0 then NAme := Url;
1794 end;
1795
MetaGetObjectnull1796 function TChmFileList.MetaGetObject(Name: String): TMemoryStream;
1797 begin
1798 Result := nil;
1799 if MetaObjectExists(Name) > 0 then Result := fLastChm.GetObject(Name);
1800 end;
1801
1802 constructor TChmFileList.Create(PrimaryFileName: String);
1803 begin
1804 inherited Create;
1805 fUnNotifiedFiles := TList.Create;
1806 OpenNewFile(PrimaryFileName);
1807 end;
1808
1809 destructor TChmFileList.Destroy;
1810 begin
1811 fUnNotifiedFiles.Free;
1812 inherited Destroy;
1813 end;
1814
1815 procedure TChmFileList.SetOnOpenNewFile(AValue: TChmFileOpenEvent);
1816 var
1817 X: Integer;
1818 begin
1819 fOnOpenNewFile := AValue;
1820 if not assigned(AValue) then exit;
1821 for X := 0 to fUnNotifiedFiles.Count-1 do
1822 AValue(Self, X);
1823 fUnNotifiedFiles.Clear;
1824 end;
1825
ObjectExistsnull1826 function TChmFileList.ObjectExists(Name: String; var fChm: TChmReader): QWord;
1827 begin
1828 Result := 0;
1829 if Count = 0 then exit;
1830 if fChm <> nil then fLastChm := fChm;
1831 Result := fLastChm.ObjectExists(Name);
1832 if Result = 0 then begin
1833 Result := Chm[0].ObjectExists(Name);
1834 if Result > 0 then fLastChm := Chm[0];
1835 end;
1836 if Result = 0 then begin
1837 Result := MetaObjectExists(Name);
1838 end;
1839 if (Result <> 0) and (fChm = nil) then
1840 fChm := fLastChm;
1841 end;
1842
GetObjectnull1843 function TChmFileList.GetObject(Name: String): TMemoryStream;
1844 begin
1845 Result := nil;
1846 if Count = 0 then exit;
1847 Result := fLastChm.GetObject(Name);
1848 if Result = nil then Result := MetaGetObject(Name);
1849 end;
1850
IsAnOpenFilenull1851 function TChmFileList.IsAnOpenFile(AFileName: String): Boolean;
1852 var
1853 X: Integer;
1854 begin
1855 Result := False;
1856 for X := 0 to Count-1 do begin
1857 if AFileName = FileName[X] then Exit(True);
1858 end;
1859 end;
1860
1861 end.
1862
1863