source: branches/2.19_branch/NewView/HelpFile.pas@ 360

Last change on this file since 360 was 329, checked in by RBRi, 17 years ago

incorporate small fixes already done in head

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