source: trunk/NewView/HelpFile.pas@ 74

Last change on this file since 74 was 74, checked in by RBRi, 19 years ago

improved TopicByTitleSearch #6 fixed

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