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

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

#37 fixed

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