source: branches/2.19.1/NewView/HelpFile.pas@ 265

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

more refactoring

  • Property svn:eol-style set to native
File size: 27.0 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 raise EHelpFileException.Create( ErrorCorruptHelpFile );
335end;
336
337// -------------------------------------------------------------------------
338
339procedure THelpFile.ReadHeader;
340begin
341 LogEvent(LogParse, 'Read header');
342
343 ReadFileBlock( _pHeader,
344 0,
345 sizeof( _pHeader^ ) );
346
347 if _pHeader^.ID <> INF_HEADER_ID then
348 begin
349 // not an OS/2 help file.
350 if _pHeader^.ID = $5f3f then
351 raise EWindowsHelpFormatException.Create( 'Win16' );
352
353 raise EHelpFileException.Create( FileErrorInvalidHeader );
354 end;
355
356 _Title := StrPas( _pHeader^.Title );
357
358 if _pHeader^.extstart > 0 then
359 begin
360 // read extended header
361 ReadFileBlock( _pExtendedHeader,
362 _pHeader^.extstart,
363 sizeof( _pExtendedHeader^ ) );
364 end;
365end;
366
367procedure THelpFile.ReadContents;
368var
369 Topic: TTopic;
370 EntryIndex: longint;
371 pEntry: pTTOCEntryStart;
372 pEnd: pTTOCEntryStart;
373begin
374 LogEvent(LogParse, 'Read contents');
375
376 if _pHeader^.ntoc = 0 then
377 exit; // explicit check required since ntoc is unsigned
378
379 // Presize the topics list to save reallocation time
380 _Topics.Capacity := _pHeader^.ntoc;
381
382 // read slots first so that Topics can refer to it.
383 ReadFileBlock( _pSlotOffsets,
384 _pHeader^.slotsstart,
385 _pHeader^.nslots * sizeof( uint32 ) );
386
387 ReadFileBlock( _pContentsData,
388 _pHeader^.tocstart,
389 _pHeader^.toclen );
390
391 pEntry := _pContentsData;
392 pEnd := _pContentsData + _pHeader^.toclen;
393
394 for EntryIndex := 0 to _pHeader^.ntoc - 1 do
395 begin
396 if pEntry >= pEnd then
397 // runs off end of data!
398 raise EHelpFileException.Create( ErrorCorruptHelpFile );
399
400 Topic := TTopic.Create( _Handle,
401 _pSlotOffsets,
402 _Dictionary,
403 pEntry,
404 _FontTable,
405 _ReferencedFiles );
406
407 Topic.HelpFile := Self;
408 Topic.Index := EntryIndex;
409
410 _Topics.Add( Topic );
411
412 inc( pEntry, pEntry ^. Length );
413 end;
414end;
415
416procedure THelpFile.ReadDictionary;
417var
418 i: longint;
419 Len: uint8;
420 p: pbyte;
421 pEnd: pbyte;
422begin
423 LogEvent(LogParse, 'Read dictionary');
424
425 if _pHeader^.ndict = 0 then
426 exit; // explicit check required since ndict is unsigned
427
428 ReadFileBlock( _pDictionaryData,
429 _pHeader^.dictstart,
430 _pHeader^.dictlen );
431
432 P := _pDictionaryData;
433 pEnd := _pDictionaryData + _pHeader^.dictlen;
434
435 // Presize the dictionary to save reallocation
436 _Dictionary.Capacity := _pHeader^.ndict;
437 for i := 0 to _pHeader^.ndict - 1 do
438 begin
439 // adjust length so we can use as a Pascal string
440 // (file uses length including length byte,
441 // Pascal string have length excluding length byte)
442 if p >= pEnd then
443 // ran off end of data
444 raise EHelpFileException.Create( ErrorCorruptHelpFile );
445
446 Len := p^ - 1;
447 p^ := Len;
448 _Dictionary.Add( P );
449 inc( P, Len + 1 );
450 end;
451end;
452
453function THelpFile.GetIndex: TStringList;
454begin
455 if _Index = nil then
456 ReadIndex;
457 Result := _Index;
458end;
459
460type
461 TIndexEntryHeader = record
462 TextLength: uint8;
463 Flags: uint8;
464 NumberOfRoots: uint8;
465 TOCIndex: uint16;
466 end;
467
468procedure THelpFile.ReadIndex;
469var
470 IndexIndex: longint; // I can't resist :-)
471 pEntryHeader: ^TIndexEntryHeader;
472 EntryText: string;
473 IndexTitleLen: longint;
474 p: pointer;
475 pEnd: pointer;
476 pIndexData: pointer;
477begin
478 LogEvent(LogParse, 'Read index');
479
480 _Index := TStringList.Create;
481
482 if _pHeader^.nindex = 0 then
483 exit; // explicit check required since ndict is unsigned
484
485 pIndexData := nil;
486 ReadFileBlock( pIndexData,
487 _pHeader^.indexstart,
488 _pHeader^.indexlen );
489
490 P := pIndexData;
491 pEnd := pIndexData + _pHeader^.indexlen;
492
493 for IndexIndex := 0 to _pHeader^.nindex - 1 do
494 begin
495 if p >= pEnd then
496 // ran off end of data
497 raise EHelpFileException.Create( ErrorCorruptHelpFile );
498
499 pEntryHeader := p;
500 IndexTitleLen := pEntryHeader^.TextLength;
501 inc( p, sizeof( TIndexEntryHeader ) );
502
503 GetMemString( p, EntryText, IndexTitleLen );
504 if ( pEntryHeader^.flags and 2 ) > 0 then
505 EntryText := '- ' + EntryText;
506 if pEntryHeader^.TOCIndex < _Topics.Count then
507 _Index.AddObject( EntryText, _Topics[ pEntryHeader^.TOCIndex ] )
508 else
509// raise EHelpFileException.Create( 'Error reading help file index - out of range topic reference' );
510 ; // pass! something special
511
512 inc( p, IndexTitleLen
513 + pEntryHeader^.NumberOfRoots
514 * sizeof( uint32 ) ); // skip 'roots' for index search
515 end;
516
517 DeallocateMemory( pIndexData );
518end;
519
520function THelpFile.GetSearchTable: TSearchTable;
521begin
522 if _SearchTable = nil then
523 ReadSearchTable;
524 Result := _SearchTable;
525end;
526
527procedure THelpFile.ReadSearchTable;
528var
529 SearchTableOffset: longint;
530 SearchTableRecordLengthIs16Bit: boolean;
531begin
532 LogEvent(LogParse, 'Read search table');
533
534 if _pHeader^.SearchLen = 0 then
535 begin
536 LogEvent(LogParse, 'Read search table (len = 0');
537 exit;
538 end;
539
540 SearchTableOffset := _pHeader^.SearchStart and $7fffffff;
541 SearchTableRecordLengthIs16Bit := _pHeader^.SearchStart and $80000000 > 0;
542 ReadFileBlock( _pSearchData,
543 SearchTableOffset,
544 _pHeader^.SearchLen );
545
546 _SearchTable := TSearchTable.Create( _pSearchData,
547 SearchTableRecordLengthIs16Bit,
548 _Dictionary.Count,
549 _Topics.Count );
550end;
551
552function THelpFile.GetHighlightWords: UInt32ArrayPointer;
553begin
554 if _pHighlightWords = nil then
555 _pHighlightWords := AllocateMemory( _Dictionary.Count * sizeof( UInt32 ) );
556 Result := _pHighlightWords;
557end;
558
559function THelpFile.FindTopicByResourceID( ID: uint16 ): TTopic;
560var
561 i: longint;
562 pResourceIDs: UInt16ArrayPointer;
563 pTopicIndices: UInt16ArrayPointer;
564 FileResourceID: uint16;
565 TopicIndex: uint16;
566begin
567 Result := nil;
568
569 if _pHeader^.nres = 0 then
570 // since nres is unsigned
571 exit;
572
573 if _pResourceData = nil then
574 ReadFileBlock( _pResourceData,
575 _pHeader^.resstart,
576 _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics
577
578 pResourceIDs := _pResourceData;
579 pTopicIndices := _pResourceData
580 + _pHeader^.nres * sizeof( uint16 );
581
582 for i := 0 to _pHeader^.nres - 1 do
583 begin
584 FileResourceID := pResourceIDs^[ i ];
585 if FileResourceID = ID then
586 begin
587 // found
588 TopicIndex := pTopicIndices^[ i ];
589 Result := _Topics[ TopicIndex ];
590 exit;
591 end;
592 end;
593end;
594
595// Look up a local "panel name" and return associated topic, if any.
596function THelpFile.FindTopicByLocalName( const Name: string ): TTopic;
597begin
598 Result := FindTopicByName( Name,
599 _pTopicNameData,
600 _pHeader^.nname,
601 _pHeader^.namestart );
602end;
603
604function THelpFile.FindTopicByGlobalName( const Name: string ): TTopic;
605begin
606 Result := nil;
607
608 if _pExtendedHeader = nil then
609 // no extended header - no global list to lookup
610 exit;
611
612 Result := FindTopicByName( Name,
613 _pTopicGlobalNamesData,
614 _pExtendedHeader ^. EntryInGNameTable,
615 _pExtendedHeader ^. HelpPanelGNameTblOffset );
616
617end;
618
619// The text of the names are stored in the (global) dictionary
620// with a table referencing them.
621// We could use a binary search here... but whatever...
622function THelpFile.FindTopicByName( const Name: string;
623 Var pData: pointer;
624 Count: longint;
625 Offset: longint ): TTopic;
626var
627 i: longint;
628 pNameTable: UInt16ArrayPointer;
629 pTopicIndices: UInt16ArrayPointer;
630 TopicIndex: uint16;
631
632 TopicNameWordIndex: uint16;
633 pTopicName: pstring;
634begin
635 Result := nil;
636
637 if Count = 0 then
638 // since it's unsigned
639 exit;
640
641 if pData = nil then
642 ReadFileBlock( pData,
643 Offset,
644 Count * sizeof( uint16 ) * 2 ); // list of name words, list of topics
645
646 // get pointers to the two parts of the table
647 pNameTable := pData;
648 pTopicIndices := pData
649 + Count * sizeof( uint16 );
650
651 for i := 0 to Count - 1 do
652 begin
653 TopicNameWordIndex := pNameTable[ i ];
654 pTopicName := DictionaryWordPtrs[ TopicNameWordIndex ];
655
656 if CompareText( pTopicName^, Name ) = 0 then
657 begin
658 // found
659 TopicIndex := pTopicIndices^[ i ];
660 Result := _Topics[ TopicIndex ];
661 exit;
662 end;
663 end;
664end;
665
666function THelpFile.FindTopicByIndexStartsWith( const SearchText: string ): TTopic;
667var
668 i: longint;
669begin
670 result := nil;
671 GetIndex; // make sure it's read
672 for i := 0 to _Index.Count - 1 do
673 begin
674 if StrStartsWithIgnoringCase( SearchText, _Index.ValuePtrs[ i ] ^ ) then
675 begin
676 // found
677 result := TTopic( Index.Objects[ i ] );
678 exit;
679 end;
680 end;
681end;
682
683function THelpFile.FindTopicByIndexContains( const SearchText: string ): TTopic;
684var
685 i: longint;
686begin
687 result := nil;
688 GetIndex; // make sure it's read
689 for i := 0 to _Index.Count - 1 do
690 begin
691 if CaseInsensitivePos( SearchText, _Index.ValuePtrs[ i ] ^ ) > 0 then
692 begin
693 // found
694 result := TTopic( Index.Objects[ i ] );
695 exit;
696 end;
697 end;
698end;
699
700function THelpFile.FindTopicByTitleStartsWith( const SearchText: string ): TTopic;
701var
702 i: longint;
703 tmpTopic: TTopic;
704 tmpLevel : integer;
705 tmpMore : boolean;
706begin
707 result := nil;
708
709 tmpLevel := 0;
710 repeat
711 tmpMore := false;
712 inc(tmpLevel);
713 for i := 0 to _Topics.Count - 1 do
714 begin
715 tmpTopic := _Topics[i];
716 if tmpLevel = tmpTopic.ContentsLevel then
717 begin
718 if StrStartsWithIgnoringCase( SearchText, tmpTopic.TitlePtr ^ ) then
719 begin
720 result := tmpTopic;
721 exit;
722 end;
723 end;
724 if tmpLevel < tmpTopic.ContentsLevel then
725 begin
726 tmpMore := True;
727 end;
728 end;
729 until NOT tmpMore;
730end;
731
732function THelpFile.FindTopicByTitleContains( const SearchText: string ): TTopic;
733var
734 i: longint;
735 tmpTopic: TTopic;
736 tmpLevel : integer;
737 tmpMore : boolean;
738begin
739 result := nil;
740
741 tmpLevel := 0;
742 repeat
743 tmpMore := false;
744 inc(tmpLevel);
745 for i := 0 to _Topics.Count - 1 do
746 begin
747 tmpTopic := _Topics[i];
748 if tmpLevel = tmpTopic.ContentsLevel then
749 begin
750 if CaseInsensitivePos( SearchText, tmpTopic.TitlePtr ^ ) > 0 then
751 begin
752 result := tmpTopic;
753 exit;
754 end;
755 end;
756 if tmpLevel < tmpTopic.ContentsLevel then
757 begin
758 tmpMore := True;
759 end;
760 end;
761 until NOT tmpMore;
762end;
763
764procedure THelpFile.FindResourceIDsForTopic( Topic: TTopic;
765 ResourceIDs: TList );
766var
767 i: longint;
768 pResourceIDs: UInt16ArrayPointer;
769 pTopicIndices: UInt16ArrayPointer;
770begin
771 ResourceIDs.Clear;
772
773 if _pHeader^.nres = 0 then
774 // since nres is unsigned
775 exit;
776
777 if _pResourceData = nil then
778 ReadFileBlock( _pResourceData,
779 _pHeader^.resstart,
780 _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics
781
782 pResourceIDs := _pResourceData;
783 pTopicIndices := _pResourceData
784 + _pHeader^.nres * sizeof( uint16 );
785
786 for i := 0 to _pHeader^.nres - 1 do
787 begin
788 if pTopicIndices^[ i ] = Topic.Index then
789 begin
790 // found
791 ResourceIDs.Add( pointer( pResourceIDs^[ i ] ) );
792 end;
793 end;
794end;
795
796procedure THelpFile.ReadReferencedFilesTable;
797var
798 i: longint;
799 p: pointer;
800 pData: pointer;
801 DatabaseName: string;
802 pLength: pByte;
803begin
804 if _pExtendedHeader = nil then
805 // no extended header -> no referenced files table
806 exit;
807
808 if _pExtendedHeader ^.Numdatabase = 0 then
809 exit;
810
811 pData := nil; // please allocate...
812 ReadFileBlock( pData,
813 _pExtendedHeader^.DatabaseOffset,
814 _pExtendedHeader^.DatabaseSize );
815
816 p := pData;
817 for i := 0 to _pExtendedHeader^.Numdatabase - 1 do
818 begin
819 pLength := p; // length byte, including itself
820 GetMemString( p + 1, DatabaseName, ( pLength ^ ) - 1 );
821 _ReferencedFiles.Add( DatabaseName );
822 inc( p, pLength ^ ); // skip to next entry
823 end;
824 DeallocateMemory( pData );
825end;
826
827procedure THelpFile.ReadFontTableData;
828begin
829 if _pExtendedHeader = nil then
830 // no extended header -> no font table
831 exit;
832
833 if _pExtendedHeader^.NumFontEntry = 0 then
834 exit;
835
836 ReadFileBlock( _pFontTableData,
837 _pExtendedHeader^.FontTableOffset,
838 _pExtendedHeader^.NumFontEntry * sizeof( THelpFontSpec ) );
839end;
840
841procedure THelpFile.ParseFontTable;
842var
843 i: longint;
844 p: pointer;
845 pFontSpec: pTHelpFontSpec;
846begin
847 _FontTable.Clear;
848
849 p := _pFontTableData;
850 if p = nil then
851 exit; // no data
852
853 for i := 0 to _pExtendedHeader^.NumFontEntry - 1 do
854 begin
855 pFontSpec := p + i * sizeof( THelpFontSpec );
856 _FontTable.Add( pFontSpec );
857 end;
858end;
859
860procedure THelpFile.GetImages( ImageOffsets: TList;
861 Images: TImageList );
862var
863 ListIndex: longint;
864 ImageOffset: longint;
865 Bitmap: THelpBitmap;
866begin
867 Images.Clear;
868
869 for ListIndex := 0 to ImageOffsets.Count - 1 do
870 begin
871 ImageOffset := longint( ImageOffsets[ ListIndex ] );
872 try
873 Bitmap := THelpBitmap.CreateFromHelpFile( _Handle,
874 _pHeader^.imgstart
875 + ImageOffset );
876 except
877 on e: EHelpBitmapException do
878{ raise EHelpFileException.Create( 'Error loading help bitmap at'
879 + IntToStr( ImageOffset )
880 + ': '
881 + e.Message );}
882 begin
883 Bitmap := THelpBitmap.Create;
884 Bitmap.LoadFromResourceName( 'MissingBitmap' );
885 end;
886 end;
887
888 Images.Add( Bitmap, nil );
889 Bitmap.Destroy;
890
891 end;
892end;
893
894function THelpFile.GetImage( ImageOffset: longint ): THelpBitmap;
895begin
896 try
897 Result := THelpBitmap.CreateFromHelpFile( _Handle,
898 _pHeader^.imgstart
899 + ImageOffset );
900 except
901 on e: EHelpBitmapException do
902{ raise EHelpFileException.Create( 'Error loading help bitmap at'
903 + IntToStr( ImageOffset )
904 + ': '
905 + e.Message );}
906 begin
907 result := nil;
908 end;
909 end;
910end;
911
912function THelpFile.GetTopic( Index: longint ): TTopic;
913begin
914 if ( Index < 0 )
915 or ( Index > _Topics.Count - 1 ) then
916 Result := nil
917 else
918 Result := _Topics[ Index ];
919end;
920
921function THelpFile.GetTopicCount: longint;
922begin
923 Result := _Topics.Count;
924end;
925
926function THelpFile.IndexOfTopic( Topic: TTopic ): longint;
927begin
928 Result := _Topics.IndexOf( Topic );
929end;
930
931function THelpFile.GetDictionaryCount: longint;
932begin
933 Result := _Dictionary.Count;
934end;
935
936function THelpFile.GetDictionaryWord( Index: longint ): string;
937begin
938 Result := pstring( _Dictionary[ Index ] )^;
939end;
940
941function THelpFile.GetDictionaryWordPtr( Index: longint ): pstring;
942begin
943 Result := pstring( _Dictionary[ Index ] );
944end;
945
946function THelpFile.GetIndexEntryPtr( Index: longint ): pstring;
947begin
948 if _Index = nil then
949 ReadIndex;
950 Result := _Index.ValuePtrs[ Index ];
951end;
952
953
954// Looks for fonts that should be substitued to the
955// users selected fixed font
956// doesn't make a lot of sense for this to be here...
957procedure THelpFile.SetupFontSubstitutes( Substitutions: string );
958var
959 Item: string;
960 FontName: string;
961 SpacePos: longint;
962 W: longint;
963 H: longint;
964 i: longint;
965 pFontSpec: pTHelpFontSpec;
966 tmpSubstitutionItems : TStringList;
967 tmpCounter : integer;
968 tmpDimensionParts : TStringList;
969begin
970 ParseFontTable; // (re)load table from raw data
971
972 tmpSubstitutionItems := TStringList.Create;
973 StrExtractStrings(tmpSubstitutionItems, Substitutions, [';'], #0);
974
975 for tmpCounter := 0 to tmpSubstitutionItems.Count - 1 do
976 begin
977 Item := tmpSubstitutionItems[tmpCounter];
978 try
979 if Item <> '' then
980 begin
981 // Look for space in xxxx WxH
982
983 SpacePos := LastPosOfChar(' ', Item);
984 if SpacePos > 0 then
985 begin
986 // fontname comes before
987 FontName := StrLeft( Item, SpacePos - 1 );
988 Delete( Item, 1, SpacePos );
989
990 // width and height after, with an X between
991 tmpDimensionParts := TStringList.Create;
992 StrExtractStrings(tmpDimensionParts, Item, ['x'], #0);
993 W := StrToInt(tmpDimensionParts[0]);
994 H := StrToInt(tmpDimensionParts[1]);
995 tmpDimensionParts.Destroy;
996 if ( W > 0 ) and ( H > 0 ) then
997 begin
998 // Now look through the font table for matches
999 for i := 0 to _FontTable.Count - 1 do
1000 begin
1001 pFontSpec := _FontTable[ i ];
1002 if StrPasWithLength( pFontSpec^.FaceName, sizeof( pFontSpec^.FaceName ) ) = FontName then
1003 begin
1004 // same face name...
1005 if ( W = pFontSpec ^. Height ) and ( H = pFontSpec ^. Width ) then
1006 begin
1007 // match
1008 _FontTable[ i ] := SubstituteFixedFont;
1009 end;
1010 end;
1011 end;
1012 end;
1013 end;
1014 end;
1015 except
1016 end;
1017 end;
1018
1019 tmpSubstitutionItems.Destroy;
1020end;
1021
1022
1023// -------------------------------------------------------------
1024// Get the title only from specific help file (if possible)
1025
1026function GetHelpFileTitle( const Filename: string ): string;
1027var
1028 OpenAction: ULong;
1029 rc: APIRET;
1030 szName: Cstring;
1031
1032 Header: THelpFileHeader;
1033 Handle: HFILE;
1034 Ext: string;
1035begin
1036 Ext := ExtractFileExt( Filename );
1037 Result := '';
1038
1039 if StrEqualIgnoringCase( Ext, '.inf' )
1040 or StrEqualIgnoringCase( Ext, '.hlp' ) then
1041 begin
1042 szName := Filename;
1043 rc := DosOpen( szName,
1044 Handle,
1045 OpenAction,
1046 0, // file size - irrelevant, not creating,
1047 0, // attributes - ''
1048 OPEN_ACTION_OPEN_IF_EXISTS,
1049 OPEN_SHARE_DENYNONE + OPEN_ACCESS_READONLY,
1050 nil ); // no extended attributes
1051 if rc = 0 then
1052 begin
1053 FillChar( Header, sizeof( Header ), 0 );
1054 if MyRead( Handle, Addr( Header ), sizeof( Header ) ) then
1055 if Header.ID = INF_HEADER_ID then
1056 Result := StrPas( Header.Title );
1057 DosClose( Handle );
1058 end;
1059 end;
1060end;
1061
1062Initialization
1063 RegisterProcForLanguages( OnLanguageEvent );
1064End.
1065
Note: See TracBrowser for help on using the repository browser.