source: trunk/NewView/HelpFile.pas@ 252

Last change on this file since 252 was 252, checked in by RBRi, 18 years ago

fix for #33
fix usage of StrStartsWithIgnoringCase

  • Property svn:eol-style set to native
File size: 27.2 KB
Line 
1Unit HelpFile;
2
3// NewView - a new OS/2 Help Viewer
4// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com)
5// This software is released under the Gnu Public License - see readme.txt
6
7Interface
8
9// Encapsulates the basic reading of a help file's structure.
10
11uses
12 Classes,
13 BseDos,
14 Os2Def,
15 SysUtils,
16 Graphics,
17 IPFFileFormatUnit,
18 HelpTopic,
19 HelpBitmap,
20 ACLUtility,
21 SearchTable;
22
23type
24 THelpFile = class
25 protected
26 _Filename : string;
27 _FileSize : longint;
28 _Handle: HFILE;
29
30 _pSlotData: pUInt16;
31 _SlotDataSize: longint;
32
33 _Title: string;
34
35 _Topics: TList; // of TTopics
36
37 _Dictionary: TList; // pointers to strings.
38
39 _Index: TStringList;
40
41 _SearchTable: TSearchTable;
42
43 _ReferencedFiles: TStringList;
44
45 _FontTable: TList;
46
47 _pHeader: TPHelpFileHeader;
48 _pExtendedHeader: TPExtendedHelpFileHeader;
49 _pContentsData: pointer;
50 _pResourceData: pointer;
51 _pSearchData: pointer;
52 _pHighlightWords: UInt32ArrayPointer;
53 _pSlotOffsets: Uint32ArrayPointer;
54 _pDictionaryData: pointer;
55 _pFontTableData: pointer;
56 _pTopicNameData: pointer;
57 _pTopicGlobalNamesData: pointer;
58
59 procedure InitMembers;
60 procedure Open;
61 procedure Close;
62 procedure ReadFileBlock( Var Dest: pointer;
63 const StartPosition: ULONG;
64 const Length: ULONG );
65
66 procedure ReadHeader;
67 procedure ReadContents;
68 procedure ReadDictionary;
69 procedure ReadSearchTable;
70
71 procedure ReadIndex;
72
73 procedure ReadReferencedFilesTable;
74 procedure ReadFontTableData;
75 procedure ParseFontTable;
76
77 function GetTopic( Index: longint ): TTopic;
78 function GetTopicCount: longint;
79
80 function GetDictionaryCount: longint;
81 function GetDictionaryWord( Index: longint ): string;
82 function GetDictionaryWordPtr( Index: longint ): pstring;
83
84 function GetIndexEntryPtr( Index: longint ): pstring;
85 function GetHighlightWords: UInt32ArrayPointer;
86
87 function GetSearchTable: TSearchTable;
88
89 // Lookup global or local panel name list
90 function FindTopicByName( const Name: string;
91 Var pData: pointer;
92 Count: longint;
93 Offset: longint ): TTopic;
94
95 public
96 constructor Create( const FileName: string );
97
98 destructor Destroy; override;
99
100 function GetIndex: TStringList;
101
102 property Title: string read _Title;
103 property Topics[ Index: longint ]: TTopic read GetTopic;
104 property TopicList: TList read _Topics;
105 property TopicCount: longint read GetTopicCount;
106 property Index: TStringList read GetIndex;
107 property IndexEntryPtr[ index: longint ]: pstring read GetIndexEntryPtr;
108 property Filename: string read _FileName;
109
110 property ReferencedFiles: TStringList read _ReferencedFiles;
111
112 procedure GetImages( ImageOffsets: TList;
113 Images: TImageList );
114
115 function GetImage( ImageOffset: longint ): THelpBitmap;
116
117 property DictionaryCount: longint read GetDictionaryCount;
118 property DictionaryWords[ Index: longint ]: string read GetDictionaryWord;
119 property DictionaryWordPtrs[ Index: longint ]: pstring read GetDictionaryWordPtr;
120
121 function IndexOfTopic( Topic: TTopic ): longint;
122
123 property SearchTable: TSearchTable read GetSearchTable;
124
125 function FindTopicByResourceID( ID: uint16 ): TTopic;
126
127 function FindTopicByLocalName( const Name: string ): TTopic;
128 function FindTopicByGlobalName( const Name: string ): TTopic;
129
130 function FindTopicByTitleStartsWith( const SearchText: string ): TTopic;
131 function FindTopicByTitleContains( const SearchText: string ): TTopic;
132
133 function FindTopicByIndexStartsWith( const SearchText: string ): TTopic;
134 function FindTopicByIndexContains( const SearchText: string ): TTopic;
135
136 procedure FindResourceIDsForTopic( Topic: TTopic;
137 ResourceIDs: TList );
138
139 property HighlightWords: UInt32ArrayPointer read GetHighlightWords;
140
141 property FileSize: longint read _FileSize;
142
143 procedure SetupFontSubstitutes( Substitutions: string );
144 public
145 NotesLoaded: boolean; // used externally
146
147 end;
148
149// Returns helpfile that the given topic is within
150Function TopicFile( Topic: TTopic ): THelpFile;
151
152function GetHelpFileTitle( const Filename: string ): string;
153
154Implementation
155
156uses
157 BseErr,
158 StringUtilsUnit,
159 CharUtilsUnit,
160 DebugUnit,
161 ACLFileIOUtility,
162 ACLLanguageUnit;
163
164// Load "missing" bitmap
165{$R Images}
166
167var
168 FileErrorNotFound: string;
169 FileErrorAccessDenied: string;
170 FileErrorInUse: string;
171 FileErrorInvalidHeader: string;
172
173Procedure OnLanguageEvent( Language: TLanguageFile;
174 const Apply: boolean );
175var
176 tmpPrefix : String;
177begin
178 tmpPrefix := 'HelpFile' + LANGUAGE_LABEL_DELIMITER;
179
180 Language.LL( Apply, FileErrorNotFound, tmpPrefix + 'FileErrorNotFound', 'File not found' );
181 Language.LL( Apply, FileErrorAccessDenied, tmpPrefix + 'FileErrorAccessDenied', 'Access denied' );
182 Language.LL( Apply, FileErrorInUse, tmpPrefix + 'FileErrorInUse', 'File in use by another program' );
183 Language.LL( Apply,
184 FileErrorInvalidHeader,
185 tmpPrefix + 'FileErrorInvalidHeader',
186 'File doesn''t appear to be an OS/2 Help document (header ID not correct)' );
187 Language.LL( Apply,
188 ErrorCorruptHelpFile,
189 tmpPrefix + 'ErrorCorruptHelpFile',
190 'File is corrupt' );
191end;
192
193Function TopicFile( Topic: TTopic ): THelpFile;
194Begin
195 Result := Topic.HelpFile as THelpFile;
196end;
197
198procedure THelpFile.InitMembers;
199begin
200 _SlotDataSize := 0;
201
202 _pHeader := nil;
203 _pExtendedHeader := nil;
204 _pContentsData := nil;
205 _pSlotOffsets := nil;
206 _pResourceData := nil;
207 _pSearchData := nil;
208 _pDictionaryData := nil;
209// _pIndexData := nil;
210 _pFontTableData := nil;
211
212 _pHighlightWords := nil;
213
214 _Dictionary := TList.Create;
215 _Topics := TList.Create;
216// _Index := TStringList.Create;
217 _ReferencedFiles := TStringList.Create;
218 _FontTable := TList.Create;
219
220 NotesLoaded := false;
221end;
222
223constructor THelpFile.Create( const FileName: string );
224begin
225 LogEvent(LogParse, 'Helpfile Load: ' + FileName);
226
227 _FileName := FileName;
228
229 InitMembers;
230
231 Open;
232
233 // we always need these basics:
234 try
235 ReadHeader;
236 ReadContents;
237 // ReadIndex;
238 ReadDictionary;
239 ReadFontTableData;
240 ParseFontTable;
241 ReadReferencedFilesTable;
242 except
243 Close;
244 raise;
245 end;
246
247 // the rest is loaded on demand
248end;
249
250destructor THelpFile.Destroy;
251begin
252 DeallocateMemory( _pHeader );
253 DeallocateMemory( _pExtendedHeader );
254 DeallocateMemory( _pContentsData );
255 DeallocateMemory( _pSlotOffsets );
256 DeallocateMemory( _pResourceData );
257 DeallocateMemory( _pSearchData );
258 DeallocateMemory( _pDictionaryData );
259// DeallocateMemory( _pIndexData );
260 DeallocateMemory( _pFontTableData );
261
262 DeallocateMemory( _pHighlightWords );
263
264 if Assigned( _Topics ) then
265 DestroyListAndObjects( _Topics );
266
267 if Assigned( _Index ) then
268 _Index.Destroy;
269
270 _Dictionary.Free;
271 _SearchTable.Free;
272 _ReferencedFiles.Free;
273 _FontTable.Free;
274
275 DosClose( _Handle );
276end;
277
278procedure THelpFile.Open;
279var
280 OpenAction: ULong;
281 rc: APIRET;
282 szName: Cstring;
283 FileInfo: FILESTATUS3;
284begin
285 if not FileExists( _Filename ) then
286 raise EHelpFileException.Create( FileErrorNotFound );
287
288 szName := _FileName;
289 rc := DosOpen( szName,
290 _Handle,
291 OpenAction,
292 0, // file size - irrelevant, not creating,
293 0, // attributes - ''
294 OPEN_ACTION_OPEN_IF_EXISTS,
295 OPEN_SHARE_DENYNONE + OPEN_ACCESS_READONLY,
296 nil ); // no extended attributes
297 if rc<> 0 then
298 begin
299 case rc of
300 ERROR_FILE_NOT_FOUND: // crap, this doesn't actually occur!
301 raise EHelpFileException.Create( FileErrorNotFound );
302
303 ERROR_ACCESS_DENIED:
304 raise EHelpFileException.Create( FileErrorAccessDenied );
305
306 ERROR_SHARING_VIOLATION:
307 raise EHelpFileException.Create( FileErrorInUse );
308
309 else
310 raise EHelpFileException.Create( SysErrorMessage( rc ) );
311 end;
312 end;
313
314 DosQueryFileInfo( _Handle,
315 FIL_STANDARD,
316 FileInfo,
317 sizeof( FileInfo ) );
318 _FileSize := FileInfo.cbFile; // file size
319end;
320
321procedure THelpFile.Close;
322begin
323 if _Handle <> 0 then
324 DosClose( _Handle );
325 _Handle := 0;
326end;
327
328procedure THelpFile.ReadFileBlock( Var Dest: pointer;
329 const StartPosition: ULONG;
330 const Length: ULONG );
331begin
332 if not ACLFileIOUtility.ReadFileBlock( _Handle,
333 Dest,
334 StartPosition,
335 Length ) then
336 raise EHelpFileException.Create( ErrorCorruptHelpFile );
337end;
338
339// -------------------------------------------------------------------------
340
341procedure THelpFile.ReadHeader;
342begin
343 LogEvent(LogParse, 'Read header');
344
345 ReadFileBlock( _pHeader,
346 0,
347 sizeof( _pHeader^ ) );
348
349 if _pHeader^.ID <> INF_HEADER_ID then
350 begin
351 // not an OS/2 help file.
352 if _pHeader^.ID = $5f3f then
353 raise EWindowsHelpFormatException.Create( 'Win16' );
354
355 raise EHelpFileException.Create( FileErrorInvalidHeader );
356 end;
357
358 _Title := StrPas( _pHeader^.Title );
359
360 if _pHeader^.extstart > 0 then
361 begin
362 // read extended header
363 ReadFileBlock( _pExtendedHeader,
364 _pHeader^.extstart,
365 sizeof( _pExtendedHeader^ ) );
366 end;
367end;
368
369procedure THelpFile.ReadContents;
370var
371 Topic: TTopic;
372 EntryIndex: longint;
373 pEntry: pTTOCEntryStart;
374 pEnd: pTTOCEntryStart;
375begin
376 LogEvent(LogParse, 'Read contents');
377
378 if _pHeader^.ntoc = 0 then
379 exit; // explicit check required since ntoc is unsigned
380
381 // Presize the topics list to save reallocation time
382 _Topics.Capacity := _pHeader^.ntoc;
383
384 // read slots first so that Topics can refer to it.
385 ReadFileBlock( _pSlotOffsets,
386 _pHeader^.slotsstart,
387 _pHeader^.nslots * sizeof( uint32 ) );
388
389 ReadFileBlock( _pContentsData,
390 _pHeader^.tocstart,
391 _pHeader^.toclen );
392
393 pEntry := _pContentsData;
394 pEnd := _pContentsData + _pHeader^.toclen;
395
396 for EntryIndex := 0 to _pHeader^.ntoc - 1 do
397 begin
398 if pEntry >= pEnd then
399 // runs off end of data!
400 raise EHelpFileException.Create( ErrorCorruptHelpFile );
401
402 Topic := TTopic.Create( _Handle,
403 _pSlotOffsets,
404 _Dictionary,
405 pEntry,
406 _FontTable,
407 _ReferencedFiles );
408
409 Topic.HelpFile := Self;
410 Topic.Index := EntryIndex;
411
412 _Topics.Add( Topic );
413
414 inc( pEntry, pEntry ^. Length );
415 end;
416end;
417
418procedure THelpFile.ReadDictionary;
419var
420 i: longint;
421 Len: uint8;
422 p: pbyte;
423 pEnd: pbyte;
424begin
425 LogEvent(LogParse, 'Read dictionary');
426
427 if _pHeader^.ndict = 0 then
428 exit; // explicit check required since ndict is unsigned
429
430 ReadFileBlock( _pDictionaryData,
431 _pHeader^.dictstart,
432 _pHeader^.dictlen );
433
434 P := _pDictionaryData;
435 pEnd := _pDictionaryData + _pHeader^.dictlen;
436
437 // Presize the dictionary to save reallocation
438 _Dictionary.Capacity := _pHeader^.ndict;
439 for i := 0 to _pHeader^.ndict - 1 do
440 begin
441 // adjust length so we can use as a Pascal string
442 // (file uses length including length byte,
443 // Pascal string have length excluding length byte)
444 if p >= pEnd then
445 // ran off end of data
446 raise EHelpFileException.Create( ErrorCorruptHelpFile );
447
448 Len := p^ - 1;
449 p^ := Len;
450 _Dictionary.Add( P );
451 inc( P, Len + 1 );
452 end;
453end;
454
455function THelpFile.GetIndex: TStringList;
456begin
457 if _Index = nil then
458 ReadIndex;
459 Result := _Index;
460end;
461
462type
463 TIndexEntryHeader = record
464 TextLength: uint8;
465 Flags: uint8;
466 NumberOfRoots: uint8;
467 TOCIndex: uint16;
468 end;
469
470procedure THelpFile.ReadIndex;
471var
472 IndexIndex: longint; // I can't resist :-)
473 pEntryHeader: ^TIndexEntryHeader;
474 EntryText: string;
475 IndexTitleLen: longint;
476 p: pointer;
477 pEnd: pointer;
478 pIndexData: pointer;
479begin
480 LogEvent(LogParse, 'Read index');
481
482 _Index := TStringList.Create;
483
484 if _pHeader^.nindex = 0 then
485 exit; // explicit check required since ndict is unsigned
486
487 pIndexData := nil;
488 ReadFileBlock( pIndexData,
489 _pHeader^.indexstart,
490 _pHeader^.indexlen );
491
492 P := pIndexData;
493 pEnd := pIndexData + _pHeader^.indexlen;
494
495 for IndexIndex := 0 to _pHeader^.nindex - 1 do
496 begin
497 if p >= pEnd then
498 // ran off end of data
499 raise EHelpFileException.Create( ErrorCorruptHelpFile );
500
501 pEntryHeader := p;
502 IndexTitleLen := pEntryHeader^.TextLength;
503 inc( p, sizeof( TIndexEntryHeader ) );
504
505 GetMemString( p, EntryText, IndexTitleLen );
506 if ( pEntryHeader^.flags and 2 ) > 0 then
507 EntryText := '- ' + EntryText;
508 if pEntryHeader^.TOCIndex < _Topics.Count then
509 _Index.AddObject( EntryText, _Topics[ pEntryHeader^.TOCIndex ] )
510 else
511// raise EHelpFileException.Create( 'Error reading help file index - out of range topic reference' );
512 ; // pass! something special
513
514 inc( p, IndexTitleLen
515 + pEntryHeader^.NumberOfRoots
516 * sizeof( uint32 ) ); // skip 'roots' for index search
517 end;
518
519 DeallocateMemory( pIndexData );
520end;
521
522function THelpFile.GetSearchTable: TSearchTable;
523begin
524 if _SearchTable = nil then
525 ReadSearchTable;
526 Result := _SearchTable;
527end;
528
529procedure THelpFile.ReadSearchTable;
530var
531 SearchTableOffset: longint;
532 SearchTableRecordLengthIs16Bit: boolean;
533begin
534 LogEvent(LogParse, 'Read search table');
535
536 if _pHeader^.SearchLen = 0 then
537 begin
538 LogEvent(LogParse, 'Read search table (len = 0');
539 exit;
540 end;
541
542 SearchTableOffset := _pHeader^.SearchStart and $7fffffff;
543 SearchTableRecordLengthIs16Bit := _pHeader^.SearchStart and $80000000 > 0;
544 ReadFileBlock( _pSearchData,
545 SearchTableOffset,
546 _pHeader^.SearchLen );
547
548 _SearchTable := TSearchTable.Create( _pSearchData,
549 SearchTableRecordLengthIs16Bit,
550 _Dictionary.Count,
551 _Topics.Count );
552end;
553
554function THelpFile.GetHighlightWords: UInt32ArrayPointer;
555begin
556 if _pHighlightWords = nil then
557 _pHighlightWords := AllocateMemory( _Dictionary.Count * sizeof( UInt32 ) );
558 Result := _pHighlightWords;
559end;
560
561function THelpFile.FindTopicByResourceID( ID: uint16 ): TTopic;
562var
563 i: longint;
564 pResourceIDs: UInt16ArrayPointer;
565 pTopicIndices: UInt16ArrayPointer;
566 FileResourceID: uint16;
567 TopicIndex: uint16;
568begin
569 Result := nil;
570
571 if _pHeader^.nres = 0 then
572 // since nres is unsigned
573 exit;
574
575 if _pResourceData = nil then
576 ReadFileBlock( _pResourceData,
577 _pHeader^.resstart,
578 _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics
579
580 pResourceIDs := _pResourceData;
581 pTopicIndices := _pResourceData
582 + _pHeader^.nres * sizeof( uint16 );
583
584 for i := 0 to _pHeader^.nres - 1 do
585 begin
586 FileResourceID := pResourceIDs^[ i ];
587 if FileResourceID = ID then
588 begin
589 // found
590 TopicIndex := pTopicIndices^[ i ];
591 Result := _Topics[ TopicIndex ];
592 exit;
593 end;
594 end;
595end;
596
597// Look up a local "panel name" and return associated topic, if any.
598function THelpFile.FindTopicByLocalName( const Name: string ): TTopic;
599begin
600 Result := FindTopicByName( Name,
601 _pTopicNameData,
602 _pHeader^.nname,
603 _pHeader^.namestart );
604end;
605
606function THelpFile.FindTopicByGlobalName( const Name: string ): TTopic;
607begin
608 Result := nil;
609
610 if _pExtendedHeader = nil then
611 // no extended header - no global list to lookup
612 exit;
613
614 Result := FindTopicByName( Name,
615 _pTopicGlobalNamesData,
616 _pExtendedHeader ^. EntryInGNameTable,
617 _pExtendedHeader ^. HelpPanelGNameTblOffset );
618
619end;
620
621// The text of the names are stored in the (global) dictionary
622// with a table referencing them.
623// We could use a binary search here... but whatever...
624function THelpFile.FindTopicByName( const Name: string;
625 Var pData: pointer;
626 Count: longint;
627 Offset: longint ): TTopic;
628var
629 i: longint;
630 pNameTable: UInt16ArrayPointer;
631 pTopicIndices: UInt16ArrayPointer;
632 TopicIndex: uint16;
633
634 TopicNameWordIndex: uint16;
635 pTopicName: pstring;
636begin
637 Result := nil;
638
639 if Count = 0 then
640 // since it's unsigned
641 exit;
642
643 if pData = nil then
644 ReadFileBlock( pData,
645 Offset,
646 Count * sizeof( uint16 ) * 2 ); // list of name words, list of topics
647
648 // get pointers to the two parts of the table
649 pNameTable := pData;
650 pTopicIndices := pData
651 + Count * sizeof( uint16 );
652
653 for i := 0 to Count - 1 do
654 begin
655 TopicNameWordIndex := pNameTable[ i ];
656 pTopicName := DictionaryWordPtrs[ TopicNameWordIndex ];
657
658 if CompareText( pTopicName^, Name ) = 0 then
659 begin
660 // found
661 TopicIndex := pTopicIndices^[ i ];
662 Result := _Topics[ TopicIndex ];
663 exit;
664 end;
665 end;
666end;
667
668function THelpFile.FindTopicByIndexStartsWith( const SearchText: string ): TTopic;
669var
670 i: longint;
671 tmpIndex: String;
672begin
673 result := nil;
674 GetIndex; // make sure it's read
675 for i := 0 to _Index.Count - 1 do
676 begin
677 tmpIndex := _Index.ValuePtrs[i]^;
678 if StrStartsWithIgnoringCase(tmpIndex, SearchText) then
679 begin
680 // found
681 result := TTopic( Index.Objects[ i ] );
682 exit;
683 end;
684 end;
685end;
686
687function THelpFile.FindTopicByIndexContains( const SearchText: string ): TTopic;
688var
689 i: longint;
690begin
691 result := nil;
692 GetIndex; // make sure it's read
693 for i := 0 to _Index.Count - 1 do
694 begin
695 if CaseInsensitivePos( SearchText, _Index.ValuePtrs[ i ] ^ ) > 0 then
696 begin
697 // found
698 result := TTopic( Index.Objects[ i ] );
699 exit;
700 end;
701 end;
702end;
703
704function THelpFile.FindTopicByTitleStartsWith( const SearchText: string ): TTopic;
705var
706 i: longint;
707 tmpTopic: TTopic;
708 tmpLevel : integer;
709 tmpMore : boolean;
710begin
711 result := nil;
712
713 tmpLevel := 0;
714 repeat
715 tmpMore := false;
716 inc(tmpLevel);
717 for i := 0 to _Topics.Count - 1 do
718 begin
719 tmpTopic := _Topics[i];
720 if tmpLevel = tmpTopic.ContentsLevel then
721 begin
722 if StrStartsWithIgnoringCase(tmpTopic.TitlePtr^, SearchText) then
723 begin
724 result := tmpTopic;
725 exit;
726 end;
727 end;
728 if tmpLevel < tmpTopic.ContentsLevel then
729 begin
730 tmpMore := True;
731 end;
732 end;
733 until NOT tmpMore;
734end;
735
736function THelpFile.FindTopicByTitleContains( const SearchText: string ): TTopic;
737var
738 i: longint;
739 tmpTopic: TTopic;
740 tmpLevel : integer;
741 tmpMore : boolean;
742begin
743 result := nil;
744
745 tmpLevel := 0;
746 repeat
747 tmpMore := false;
748 inc(tmpLevel);
749 for i := 0 to _Topics.Count - 1 do
750 begin
751 tmpTopic := _Topics[i];
752 if tmpLevel = tmpTopic.ContentsLevel then
753 begin
754 if CaseInsensitivePos( SearchText, tmpTopic.TitlePtr ^ ) > 0 then
755 begin
756 result := tmpTopic;
757 exit;
758 end;
759 end;
760 if tmpLevel < tmpTopic.ContentsLevel then
761 begin
762 tmpMore := True;
763 end;
764 end;
765 until NOT tmpMore;
766end;
767
768procedure THelpFile.FindResourceIDsForTopic( Topic: TTopic;
769 ResourceIDs: TList );
770var
771 i: longint;
772 pResourceIDs: UInt16ArrayPointer;
773 pTopicIndices: UInt16ArrayPointer;
774begin
775 ResourceIDs.Clear;
776
777 if _pHeader^.nres = 0 then
778 // since nres is unsigned
779 exit;
780
781 if _pResourceData = nil then
782 ReadFileBlock( _pResourceData,
783 _pHeader^.resstart,
784 _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics
785
786 pResourceIDs := _pResourceData;
787 pTopicIndices := _pResourceData
788 + _pHeader^.nres * sizeof( uint16 );
789
790 for i := 0 to _pHeader^.nres - 1 do
791 begin
792 if pTopicIndices^[ i ] = Topic.Index then
793 begin
794 // found
795 ResourceIDs.Add( pointer( pResourceIDs^[ i ] ) );
796 end;
797 end;
798end;
799
800procedure THelpFile.ReadReferencedFilesTable;
801var
802 i: longint;
803 p: pointer;
804 pData: pointer;
805 DatabaseName: string;
806 pLength: pByte;
807begin
808 if _pExtendedHeader = nil then
809 // no extended header -> no referenced files table
810 exit;
811
812 if _pExtendedHeader ^.Numdatabase = 0 then
813 exit;
814
815 pData := nil; // please allocate...
816 ReadFileBlock( pData,
817 _pExtendedHeader^.DatabaseOffset,
818 _pExtendedHeader^.DatabaseSize );
819
820 p := pData;
821 for i := 0 to _pExtendedHeader^.Numdatabase - 1 do
822 begin
823 pLength := p; // length byte, including itself
824 GetMemString( p + 1, DatabaseName, ( pLength ^ ) - 1 );
825 _ReferencedFiles.Add( DatabaseName );
826 inc( p, pLength ^ ); // skip to next entry
827 end;
828 DeallocateMemory( pData );
829end;
830
831procedure THelpFile.ReadFontTableData;
832begin
833 if _pExtendedHeader = nil then
834 // no extended header -> no font table
835 exit;
836
837 if _pExtendedHeader^.NumFontEntry = 0 then
838 exit;
839
840 ReadFileBlock( _pFontTableData,
841 _pExtendedHeader^.FontTableOffset,
842 _pExtendedHeader^.NumFontEntry * sizeof( THelpFontSpec ) );
843end;
844
845procedure THelpFile.ParseFontTable;
846var
847 i: longint;
848 p: pointer;
849 pFontSpec: pTHelpFontSpec;
850begin
851 _FontTable.Clear;
852
853 p := _pFontTableData;
854 if p = nil then
855 exit; // no data
856
857 for i := 0 to _pExtendedHeader^.NumFontEntry - 1 do
858 begin
859 pFontSpec := p + i * sizeof( THelpFontSpec );
860 _FontTable.Add( pFontSpec );
861 end;
862end;
863
864procedure THelpFile.GetImages( ImageOffsets: TList;
865 Images: TImageList );
866var
867 ListIndex: longint;
868 ImageOffset: longint;
869 Bitmap: THelpBitmap;
870begin
871 Images.Clear;
872
873 for ListIndex := 0 to ImageOffsets.Count - 1 do
874 begin
875 ImageOffset := longint( ImageOffsets[ ListIndex ] );
876 try
877 Bitmap := THelpBitmap.CreateFromHelpFile( _Handle,
878 _pHeader^.imgstart
879 + ImageOffset );
880 except
881 on e: EHelpBitmapException do
882{ raise EHelpFileException.Create( 'Error loading help bitmap at'
883 + IntToStr( ImageOffset )
884 + ': '
885 + e.Message );}
886 begin
887 Bitmap := THelpBitmap.Create;
888 Bitmap.LoadFromResourceName( 'MissingBitmap' );
889 end;
890 end;
891
892 Images.Add( Bitmap, nil );
893 Bitmap.Destroy;
894
895 end;
896end;
897
898function THelpFile.GetImage( ImageOffset: longint ): THelpBitmap;
899begin
900 try
901 Result := THelpBitmap.CreateFromHelpFile( _Handle,
902 _pHeader^.imgstart
903 + ImageOffset );
904 except
905 on e: EHelpBitmapException do
906{ raise EHelpFileException.Create( 'Error loading help bitmap at'
907 + IntToStr( ImageOffset )
908 + ': '
909 + e.Message );}
910 begin
911 result := nil;
912 end;
913 end;
914end;
915
916function THelpFile.GetTopic( Index: longint ): TTopic;
917begin
918 if ( Index < 0 )
919 or ( Index > _Topics.Count - 1 ) then
920 Result := nil
921 else
922 Result := _Topics[ Index ];
923end;
924
925function THelpFile.GetTopicCount: longint;
926begin
927 Result := _Topics.Count;
928end;
929
930function THelpFile.IndexOfTopic( Topic: TTopic ): longint;
931begin
932 Result := _Topics.IndexOf( Topic );
933end;
934
935function THelpFile.GetDictionaryCount: longint;
936begin
937 Result := _Dictionary.Count;
938end;
939
940function THelpFile.GetDictionaryWord( Index: longint ): string;
941begin
942 Result := pstring( _Dictionary[ Index ] )^;
943end;
944
945function THelpFile.GetDictionaryWordPtr( Index: longint ): pstring;
946begin
947 Result := pstring( _Dictionary[ Index ] );
948end;
949
950function THelpFile.GetIndexEntryPtr( Index: longint ): pstring;
951begin
952 if _Index = nil then
953 ReadIndex;
954 Result := _Index.ValuePtrs[ Index ];
955end;
956
957
958// Looks for fonts that should be substitued to the
959// users selected fixed font
960// doesn't make a lot of sense for this to be here...
961procedure THelpFile.SetupFontSubstitutes( Substitutions: string );
962var
963 Item: string;
964 FontName: string;
965 SpacePos: longint;
966 W: longint;
967 H: longint;
968 i: longint;
969 pFontSpec: pTHelpFontSpec;
970 tmpSubstitutionItems : TStringList;
971 tmpCounter : integer;
972 tmpDimensionParts : TStringList;
973begin
974 ParseFontTable; // (re)load table from raw data
975
976 tmpSubstitutionItems := TStringList.Create;
977 StrExtractStrings(tmpSubstitutionItems, Substitutions, [';'], #0);
978
979 for tmpCounter := 0 to tmpSubstitutionItems.Count - 1 do
980 begin
981 Item := tmpSubstitutionItems[tmpCounter];
982 try
983 if Item <> '' then
984 begin
985 // Look for space in xxxx WxH
986
987 SpacePos := LastPosOfChar(' ', Item);
988 if SpacePos > 0 then
989 begin
990 // fontname comes before
991 FontName := StrLeft( Item, SpacePos - 1 );
992 Delete( Item, 1, SpacePos );
993
994 // width and height after, with an X between
995 tmpDimensionParts := TStringList.Create;
996 StrExtractStrings(tmpDimensionParts, Item, ['x'], #0);
997 W := StrToInt(tmpDimensionParts[0]);
998 H := StrToInt(tmpDimensionParts[1]);
999 tmpDimensionParts.Destroy;
1000 if ( W > 0 ) and ( H > 0 ) then
1001 begin
1002 // Now look through the font table for matches
1003 for i := 0 to _FontTable.Count - 1 do
1004 begin
1005 pFontSpec := _FontTable[ i ];
1006 if StrPasWithLength( pFontSpec^.FaceName, sizeof( pFontSpec^.FaceName ) ) = FontName then
1007 begin
1008 // same face name...
1009 if ( W = pFontSpec ^. Height ) and ( H = pFontSpec ^. Width ) then
1010 begin
1011 // match
1012 _FontTable[ i ] := SubstituteFixedFont;
1013 end;
1014 end;
1015 end;
1016 end;
1017 end;
1018 end;
1019 except
1020 end;
1021 end;
1022
1023 tmpSubstitutionItems.Destroy;
1024end;
1025
1026
1027// -------------------------------------------------------------
1028// Get the title only from specific help file (if possible)
1029
1030function GetHelpFileTitle( const Filename: string ): string;
1031var
1032 OpenAction: ULong;
1033 rc: APIRET;
1034 szName: Cstring;
1035
1036 Header: THelpFileHeader;
1037 Handle: HFILE;
1038 Ext: string;
1039begin
1040 Ext := ExtractFileExt( Filename );
1041 Result := '';
1042
1043 if StrEqualIgnoringCase( Ext, '.inf' )
1044 or StrEqualIgnoringCase( Ext, '.hlp' ) then
1045 begin
1046 szName := Filename;
1047 rc := DosOpen( szName,
1048 Handle,
1049 OpenAction,
1050 0, // file size - irrelevant, not creating,
1051 0, // attributes - ''
1052 OPEN_ACTION_OPEN_IF_EXISTS,
1053 OPEN_SHARE_DENYNONE + OPEN_ACCESS_READONLY,
1054 nil ); // no extended attributes
1055 if rc = 0 then
1056 begin
1057 FillChar( Header, sizeof( Header ), 0 );
1058 if MyRead( Handle, Addr( Header ), sizeof( Header ) ) then
1059 if Header.ID = INF_HEADER_ID then
1060 Result := StrPas( Header.Title );
1061 DosClose( Handle );
1062 end;
1063 end;
1064end;
1065
1066Initialization
1067 RegisterProcForLanguages( OnLanguageEvent );
1068End.
1069
Note: See TracBrowser for help on using the repository browser.