source: trunk/NewView/HelpFile.pas@ 228

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

refactoring for language handling

  • Property svn:eol-style set to native
File size: 27.1 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;
671begin
672 result := nil;
673 GetIndex; // make sure it's read
674 for i := 0 to _Index.Count - 1 do
675 begin
676 if StrStartsWithIgnoringCase( SearchText, _Index.ValuePtrs[ i ] ^ ) then
677 begin
678 // found
679 result := TTopic( Index.Objects[ i ] );
680 exit;
681 end;
682 end;
683end;
684
685function THelpFile.FindTopicByIndexContains( const SearchText: string ): TTopic;
686var
687 i: longint;
688begin
689 result := nil;
690 GetIndex; // make sure it's read
691 for i := 0 to _Index.Count - 1 do
692 begin
693 if CaseInsensitivePos( SearchText, _Index.ValuePtrs[ i ] ^ ) > 0 then
694 begin
695 // found
696 result := TTopic( Index.Objects[ i ] );
697 exit;
698 end;
699 end;
700end;
701
702function THelpFile.FindTopicByTitleStartsWith( const SearchText: string ): TTopic;
703var
704 i: longint;
705 tmpTopic: TTopic;
706 tmpLevel : integer;
707 tmpMore : boolean;
708begin
709 result := nil;
710
711 tmpLevel := 0;
712 repeat
713 tmpMore := false;
714 inc(tmpLevel);
715 for i := 0 to _Topics.Count - 1 do
716 begin
717 tmpTopic := _Topics[i];
718 if tmpLevel = tmpTopic.ContentsLevel then
719 begin
720 if StrStartsWithIgnoringCase( SearchText, tmpTopic.TitlePtr ^ ) then
721 begin
722 result := tmpTopic;
723 exit;
724 end;
725 end;
726 if tmpLevel < tmpTopic.ContentsLevel then
727 begin
728 tmpMore := True;
729 end;
730 end;
731 until NOT tmpMore;
732end;
733
734function THelpFile.FindTopicByTitleContains( const SearchText: string ): TTopic;
735var
736 i: longint;
737 tmpTopic: TTopic;
738 tmpLevel : integer;
739 tmpMore : boolean;
740begin
741 result := nil;
742
743 tmpLevel := 0;
744 repeat
745 tmpMore := false;
746 inc(tmpLevel);
747 for i := 0 to _Topics.Count - 1 do
748 begin
749 tmpTopic := _Topics[i];
750 if tmpLevel = tmpTopic.ContentsLevel then
751 begin
752 if CaseInsensitivePos( SearchText, tmpTopic.TitlePtr ^ ) > 0 then
753 begin
754 result := tmpTopic;
755 exit;
756 end;
757 end;
758 if tmpLevel < tmpTopic.ContentsLevel then
759 begin
760 tmpMore := True;
761 end;
762 end;
763 until NOT tmpMore;
764end;
765
766procedure THelpFile.FindResourceIDsForTopic( Topic: TTopic;
767 ResourceIDs: TList );
768var
769 i: longint;
770 pResourceIDs: UInt16ArrayPointer;
771 pTopicIndices: UInt16ArrayPointer;
772begin
773 ResourceIDs.Clear;
774
775 if _pHeader^.nres = 0 then
776 // since nres is unsigned
777 exit;
778
779 if _pResourceData = nil then
780 ReadFileBlock( _pResourceData,
781 _pHeader^.resstart,
782 _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics
783
784 pResourceIDs := _pResourceData;
785 pTopicIndices := _pResourceData
786 + _pHeader^.nres * sizeof( uint16 );
787
788 for i := 0 to _pHeader^.nres - 1 do
789 begin
790 if pTopicIndices^[ i ] = Topic.Index then
791 begin
792 // found
793 ResourceIDs.Add( pointer( pResourceIDs^[ i ] ) );
794 end;
795 end;
796end;
797
798procedure THelpFile.ReadReferencedFilesTable;
799var
800 i: longint;
801 p: pointer;
802 pData: pointer;
803 DatabaseName: string;
804 pLength: pByte;
805begin
806 if _pExtendedHeader = nil then
807 // no extended header -> no referenced files table
808 exit;
809
810 if _pExtendedHeader ^.Numdatabase = 0 then
811 exit;
812
813 pData := nil; // please allocate...
814 ReadFileBlock( pData,
815 _pExtendedHeader^.DatabaseOffset,
816 _pExtendedHeader^.DatabaseSize );
817
818 p := pData;
819 for i := 0 to _pExtendedHeader^.Numdatabase - 1 do
820 begin
821 pLength := p; // length byte, including itself
822 GetMemString( p + 1, DatabaseName, ( pLength ^ ) - 1 );
823 _ReferencedFiles.Add( DatabaseName );
824 inc( p, pLength ^ ); // skip to next entry
825 end;
826 DeallocateMemory( pData );
827end;
828
829procedure THelpFile.ReadFontTableData;
830begin
831 if _pExtendedHeader = nil then
832 // no extended header -> no font table
833 exit;
834
835 if _pExtendedHeader^.NumFontEntry = 0 then
836 exit;
837
838 ReadFileBlock( _pFontTableData,
839 _pExtendedHeader^.FontTableOffset,
840 _pExtendedHeader^.NumFontEntry * sizeof( THelpFontSpec ) );
841end;
842
843procedure THelpFile.ParseFontTable;
844var
845 i: longint;
846 p: pointer;
847 pFontSpec: pTHelpFontSpec;
848begin
849 _FontTable.Clear;
850
851 p := _pFontTableData;
852 if p = nil then
853 exit; // no data
854
855 for i := 0 to _pExtendedHeader^.NumFontEntry - 1 do
856 begin
857 pFontSpec := p + i * sizeof( THelpFontSpec );
858 _FontTable.Add( pFontSpec );
859 end;
860end;
861
862procedure THelpFile.GetImages( ImageOffsets: TList;
863 Images: TImageList );
864var
865 ListIndex: longint;
866 ImageOffset: longint;
867 Bitmap: THelpBitmap;
868begin
869 Images.Clear;
870
871 for ListIndex := 0 to ImageOffsets.Count - 1 do
872 begin
873 ImageOffset := longint( ImageOffsets[ ListIndex ] );
874 try
875 Bitmap := THelpBitmap.CreateFromHelpFile( _Handle,
876 _pHeader^.imgstart
877 + ImageOffset );
878 except
879 on e: EHelpBitmapException do
880{ raise EHelpFileException.Create( 'Error loading help bitmap at'
881 + IntToStr( ImageOffset )
882 + ': '
883 + e.Message );}
884 begin
885 Bitmap := THelpBitmap.Create;
886 Bitmap.LoadFromResourceName( 'MissingBitmap' );
887 end;
888 end;
889
890 Images.Add( Bitmap, nil );
891 Bitmap.Destroy;
892
893 end;
894end;
895
896function THelpFile.GetImage( ImageOffset: longint ): THelpBitmap;
897begin
898 try
899 Result := THelpBitmap.CreateFromHelpFile( _Handle,
900 _pHeader^.imgstart
901 + ImageOffset );
902 except
903 on e: EHelpBitmapException do
904{ raise EHelpFileException.Create( 'Error loading help bitmap at'
905 + IntToStr( ImageOffset )
906 + ': '
907 + e.Message );}
908 begin
909 result := nil;
910 end;
911 end;
912end;
913
914function THelpFile.GetTopic( Index: longint ): TTopic;
915begin
916 if ( Index < 0 )
917 or ( Index > _Topics.Count - 1 ) then
918 Result := nil
919 else
920 Result := _Topics[ Index ];
921end;
922
923function THelpFile.GetTopicCount: longint;
924begin
925 Result := _Topics.Count;
926end;
927
928function THelpFile.IndexOfTopic( Topic: TTopic ): longint;
929begin
930 Result := _Topics.IndexOf( Topic );
931end;
932
933function THelpFile.GetDictionaryCount: longint;
934begin
935 Result := _Dictionary.Count;
936end;
937
938function THelpFile.GetDictionaryWord( Index: longint ): string;
939begin
940 Result := pstring( _Dictionary[ Index ] )^;
941end;
942
943function THelpFile.GetDictionaryWordPtr( Index: longint ): pstring;
944begin
945 Result := pstring( _Dictionary[ Index ] );
946end;
947
948function THelpFile.GetIndexEntryPtr( Index: longint ): pstring;
949begin
950 if _Index = nil then
951 ReadIndex;
952 Result := _Index.ValuePtrs[ Index ];
953end;
954
955
956// Looks for fonts that should be substitued to the
957// users selected fixed font
958// doesn't make a lot of sense for this to be here...
959procedure THelpFile.SetupFontSubstitutes( Substitutions: string );
960var
961 Item: string;
962 FontName: string;
963 SpacePos: longint;
964 W: longint;
965 H: longint;
966 i: longint;
967 pFontSpec: pTHelpFontSpec;
968 tmpSubstitutionItems : TStringList;
969 tmpCounter : integer;
970 tmpDimensionParts : TStringList;
971begin
972 ParseFontTable; // (re)load table from raw data
973
974 tmpSubstitutionItems := TStringList.Create;
975 StrExtractStrings(tmpSubstitutionItems, Substitutions, [';'], #0);
976
977 for tmpCounter := 0 to tmpSubstitutionItems.Count - 1 do
978 begin
979 Item := tmpSubstitutionItems[tmpCounter];
980 try
981 if Item <> '' then
982 begin
983 // Look for space in xxxx WxH
984
985 SpacePos := LastPosOfChar(' ', Item);
986 if SpacePos > 0 then
987 begin
988 // fontname comes before
989 FontName := StrLeft( Item, SpacePos - 1 );
990 Delete( Item, 1, SpacePos );
991
992 // width and height after, with an X between
993 tmpDimensionParts := TStringList.Create;
994 StrExtractStrings(tmpDimensionParts, Item, ['x'], #0);
995 W := StrToInt(tmpDimensionParts[0]);
996 H := StrToInt(tmpDimensionParts[1]);
997 tmpDimensionParts.Destroy;
998 if ( W > 0 ) and ( H > 0 ) then
999 begin
1000 // Now look through the font table for matches
1001 for i := 0 to _FontTable.Count - 1 do
1002 begin
1003 pFontSpec := _FontTable[ i ];
1004 if StrPasWithLength( pFontSpec^.FaceName, sizeof( pFontSpec^.FaceName ) ) = FontName then
1005 begin
1006 // same face name...
1007 if ( W = pFontSpec ^. Height ) and ( H = pFontSpec ^. Width ) then
1008 begin
1009 // match
1010 _FontTable[ i ] := SubstituteFixedFont;
1011 end;
1012 end;
1013 end;
1014 end;
1015 end;
1016 end;
1017 except
1018 end;
1019 end;
1020
1021 tmpSubstitutionItems.Destroy;
1022end;
1023
1024
1025// -------------------------------------------------------------
1026// Get the title only from specific help file (if possible)
1027
1028function GetHelpFileTitle( const Filename: string ): string;
1029var
1030 OpenAction: ULong;
1031 rc: APIRET;
1032 szName: Cstring;
1033
1034 Header: THelpFileHeader;
1035 Handle: HFILE;
1036 Ext: string;
1037begin
1038 Ext := ExtractFileExt( Filename );
1039 Result := '';
1040
1041 if StrEqualIgnoringCase( Ext, '.inf' )
1042 or StrEqualIgnoringCase( Ext, '.hlp' ) then
1043 begin
1044 szName := Filename;
1045 rc := DosOpen( szName,
1046 Handle,
1047 OpenAction,
1048 0, // file size - irrelevant, not creating,
1049 0, // attributes - ''
1050 OPEN_ACTION_OPEN_IF_EXISTS,
1051 OPEN_SHARE_DENYNONE + OPEN_ACCESS_READONLY,
1052 nil ); // no extended attributes
1053 if rc = 0 then
1054 begin
1055 FillChar( Header, sizeof( Header ), 0 );
1056 if MyRead( Handle, Addr( Header ), sizeof( Header ) ) then
1057 if Header.ID = INF_HEADER_ID then
1058 Result := StrPas( Header.Title );
1059 DosClose( Handle );
1060 end;
1061 end;
1062end;
1063
1064Initialization
1065 RegisterProcForLanguages( OnLanguageEvent );
1066End.
1067
Note: See TracBrowser for help on using the repository browser.