1 {
2 wThis file is part of the Free Pascal Integrated Development Environment
3 Copyright (c) 2000 by Berczi Gabor
4
5 Borland OA .HLP reader objects and routines
6
7 See the file COPYING.FPC, included in this distribution,
8 for details about the copyright.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************}
15 {$R-}
16 unit WOAHelp;
17
18 interface
19
20 uses Objects,WUtils,WHelp;
21
22 const
23 MinFormatVersion = $04; { was $34 }
24
25 TP55FormatVersion = $04;
26 TP70FormatVersion = $34;
27
28 Signature = '$*$* &&&&$*$'#0;
29 ncRawChar = $F;
30 ncRepChar = $E;
31
32 oa_rtFileHeader = Byte ($0);
33 oa_rtContext = Byte ($1);
34 oa_rtText = Byte ($2);
35 oa_rtKeyWord = Byte ($3);
36 oa_rtIndex = Byte ($4);
37 oa_rtCompression = Byte ($5);
38 oa_rtIndexTags = Byte ($6);
39
40 ctNone = $00;
41 ctNibble = $02;
42
43 type
44 FileStamp = array [0..32] of char; {+ null terminator + $1A }
45 FileSignature = array [0..12] of char; {+ null terminator }
46
47 THLPVersion = packed record
48 FormatVersion : byte;
49 TextVersion : byte;
50 end;
51
52 THLPRecordHeader = packed record
53 RecType : byte; {TPRecType}
54 RecLength : word;
55 end;
56
57 THLPContextPos = packed record
58 LoW: word;
59 HiB: byte;
60 end;
61
62 THLPContexts = packed record
63 ContextCount : word;
64 Contexts : array[0..0] of THLPContextPos;
65 end;
66
67 THLPFileHeader = packed record
68 Options : word;
69 MainIndexScreen : word;
70 MaxScreenSize : word;
71 Height : byte;
72 Width : byte;
73 LeftMargin : byte;
74 end;
75
76 THLPCompression = packed record
77 CompType : byte;
78 CharTable : array [0..13] of byte;
79 end;
80
81 THLPIndexDescriptor = packed record
82 LengthCode : byte;
83 UniqueChars : array [0..0] of byte;
84 Context : word;
85 end;
86
87 THLPIndexTable = packed record
88 IndexCount : word;
89 Entries : record end;
90 end;
91
92 THLPKeywordDescriptor = packed record
93 KwContext : word;
94 end;
95
96 THLPKeyWordRecord = packed record
97 UpContext : word;
98 DownContext : word;
99 KeyWordCount : word;
100 Keywords : array[0..0] of THLPKeywordDescriptor;
101 end;
102
103 THLPKeywordDescriptor55 = packed record
104 PosY : byte;
105 StartX : byte;
106 EndX : byte;
107 Dunno : array[0..1] of word;
108 KwContext : word;
109 end;
110
111 THLPKeyWordRecord55 = packed record
112 UpContext : word;
113 DownContext : word;
114 KeyWordCount : byte;
115 Keywords : array[0..0] of THLPKeywordDescriptor55;
116 end;
117
118 POAHelpFile = ^TOAHelpFile;
119 TOAHelpFile = object(THelpFile)
120 Version : THLPVersion;
121 Header : THLPFileHeader;
122 Compression : THLPCompression;
123 constructor Init(AFileName: string; AID: word);
124 destructor Done; virtual;
125 public
LoadIndexnull126 function LoadIndex: boolean; virtual;
ReadTopicnull127 function ReadTopic(T: PTopic): boolean; virtual;
128 public { protected }
129 F: PStream;
130 TopicsRead : boolean;
131 IndexTableRead : boolean;
132 CompressionRead: boolean;
133 IndexTagsRead : boolean;
134 IndexTagsPos : longint;
135 IndexTablePos : longint;
ReadHeadernull136 function ReadHeader: boolean;
ReadTopicsnull137 function ReadTopics: boolean;
ReadIndexTablenull138 function ReadIndexTable: boolean;
ReadCompressionnull139 function ReadCompression: boolean;
ReadIndexTagsnull140 function ReadIndexTags: boolean;
ReadRecordnull141 function ReadRecord(var R: TRecord; ReadData: boolean): boolean;
142 end;
143
144 procedure RegisterHelpType;
145
146 implementation
147
148
149 constructor TOAHelpFile.Init(AFileName: string; AID: word);
150 var OK: boolean;
151 FS,L: longint;
152 R: TRecord;
153 begin
154 if inherited Init(AID)=false then Fail;
155 F:=New(PFastBufStream, Init(AFileName, stOpenRead, HelpStreamBufSize));
156 OK:=F<>nil;
157 if OK then OK:=(F^.Status=stOK);
158 if OK then
159 begin
160 FS:=F^.GetSize;
161 OK:=ReadHeader;
162 end;
163 while OK do
164 begin
165 L:=F^.GetPos;
166 if (L>=FS) then Break;
167 OK:=ReadRecord(R,false);
168 if (OK=false) or (R.SClass=0) or (R.Size=0) then Break;
169 case R.SClass of
170 oa_rtContext : begin F^.Seek(L); OK:=ReadTopics; end;
171 oa_rtText : {Skip};
172 oa_rtKeyword : {Skip};
173 oa_rtIndex : begin IndexTablePos:=L; {OK:=ReadIndexTable; }end;
174 oa_rtCompression : begin F^.Seek(L); OK:=ReadCompression; end;
175 oa_rtIndexTags : begin IndexTagsPos:=L; {OK:=ReadIndexTags; }end;
176 else
177 begin
178 {$ifdef DEBUGMSG}
179 ClearFormatParams;
180 AddFormatParamInt(R.SClass);
181 AddFormatParamInt(L);
182 AddFormatParamInt(R.Size);
183 ErrorBox('Uknown help record tag %x encountered, '+
184 'offset %x, size %d',@FormatParams);
185 {$else}
186 {Skip};
187 {$endif}
188 end;
189 end;
190 if OK then
191 begin Inc(L, SizeOf(THLPRecordHeader)); Inc(L, R.Size); F^.Seek(L); OK:=(F^.Status=stOK); end
192 end;
193 OK:=OK and (TopicsRead=true);
194 if OK=false then
195 Begin
196 Done;
197 Fail;
198 End;
199 end;
200
LoadIndexnull201 function TOAHelpFile.LoadIndex: boolean;
202 begin
203 LoadIndex:=ReadIndexTable;
204 end;
205
ReadHeadernull206 function TOAHelpFile.ReadHeader: boolean;
207 var S: string;
208 P: longint;
209 R: TRecord;
210 OK: boolean;
211 begin
212 F^.Seek(0);
213 F^.Read(S[1],128); S[0]:=#255;
214 OK:=(F^.Status=stOK); P:=Pos(Signature,S);
215 OK:=OK and (P>0);
216 if OK then
217 begin
218 F^.Seek(P+length(Signature)-1);
219 F^.Read(Version,SizeOf(Version));
220 OK:=(F^.Status=stOK) and (Version.FormatVersion>=MinFormatVersion);
221 if OK then
222 begin
223 OK:=ReadRecord(R,true);
224 OK:=OK and (R.SClass=oa_rtFileHeader) and (R.Size=SizeOf(Header));
225 if OK then Move(R.Data^,Header,SizeOf(Header));
226 Header.Options :=LEToN(Header.Options);
227 Header.MainIndexScreen:=LEToN(Header.MainIndexScreen);
228 Header.MaxScreenSize :=LEToN(Header.MaxScreenSize );
229 DisposeRecord(R);
230 end;
231 end;
232 ReadHeader:=OK;
233 end;
234
ReadTopicsnull235 function TOAHelpFile.ReadTopics: boolean;
236 var OK: boolean;
237 R: TRecord;
238 L,I: longint;
GetCtxPosnull239 function GetCtxPos(C: THLPContextPos): longint;
240 begin
241 c.LoW:=LEToN(Word(C.LoW));
242 GetCtxPos:=longint(C.HiB) shl 16 + C.LoW;
243 end;
244 begin
245 OK:=ReadRecord(R, true);
246 if OK then
247 with THLPContexts(R.Data^) do
248 begin
249 ContextCount:=LEToN(ContextCount);
250 for I:=1 to longint(ContextCount)-1 do
251 begin
252 if Topics^.Count=MaxCollectionSize then Break;
253 L:=GetCtxPos(Contexts[I]);
254 if (L and $800000)<>0 then L:=not L;
255 if (L=-1) and (Header.MainIndexScreen>0) then
256 L:=GetCtxPos(Contexts[Header.MainIndexScreen]);
257 if (L>0) then
258 AddTopic(I,L,'',nil,0);
259 end;
260 end;
261 DisposeRecord(R);
262 TopicsRead:=OK;
263 ReadTopics:=OK;
264 end;
265
TOAHelpFile.ReadIndexTablenull266 function TOAHelpFile.ReadIndexTable: boolean;
267 var OK: boolean;
268 R: TRecord;
269 I: longint;
270 LastTag,S: string;
271 CurPtr: sw_word;
272 HelpCtx: THelpCtx;
273 LenCode,CopyCnt,AddLen: byte;
274 type pword = ^word;
275 begin
276 if IndexTableRead then OK:=true else
277 begin
278 FillChar(R, SizeOf(R), 0);
279 LastTag:=''; CurPtr:=0;
280 OK:=(IndexTablePos<>0);
281 if OK then begin F^.Seek(IndexTablePos); OK:=F^.Status=stOK; end;
282 if OK then OK:=ReadRecord(R, true);
283 if OK then
284 with THLPIndexTable(R.Data^) do
285 begin
286 IndexCount:=LEToN(IndexCount);
287 for I:=0 to IndexCount-1 do
288 begin
289 LenCode:=PByteArray(@Entries)^[CurPtr];
290 AddLen:=LenCode and $1f; CopyCnt:=LenCode shr 5;
291 S[0]:=chr(AddLen); Move(PByteArray(@Entries)^[CurPtr+1],S[1],AddLen);
292 LastTag:=copy(LastTag,1,CopyCnt)+S;
293 HelpCtx:=PWord(@PByteArray(@Entries)^[CurPtr+1+AddLen])^;
294 AddIndexEntry(LastTag,HelpCtx);
295 Inc(CurPtr,1+AddLen+2);
296 end;
297 end;
298 DisposeRecord(R);
299 IndexTableRead:=OK;
300 end;
301 ReadIndexTable:=OK;
302 end;
303
TOAHelpFile.ReadCompressionnull304 function TOAHelpFile.ReadCompression: boolean;
305 var OK: boolean;
306 R: TRecord;
307 begin
308 OK:=ReadRecord(R, true);
309 OK:=OK and (R.Size=SizeOf(THLPCompression));
310 if OK then Move(R.Data^,Compression,SizeOf(Compression));
311 DisposeRecord(R);
312 CompressionRead:=OK;
313 ReadCompression:=OK;
314 end;
315
ReadIndexTagsnull316 function TOAHelpFile.ReadIndexTags: boolean;
317 var OK: boolean;
318 begin
319 OK:={ReadRecord(R, true)}true;
320 IndexTagsRead:=OK;
321 ReadIndexTags:=OK;
322 end;
323
ReadRecordnull324 function TOAHelpFile.ReadRecord(var R: TRecord; ReadData: boolean): boolean;
325 var OK: boolean;
326 H: THLPRecordHeader;
327 begin
328 FillChar(R, SizeOf(R), 0);
329 F^.Read(H,SizeOf(H));
330 H.RecLength:=LEToN(H.RecLength);
331 OK:=F^.Status=stOK;
332 if OK then
333 begin
334 R.SClass:=H.RecType; R.Size:=H.RecLength;
335 if (R.Size>0) and ReadData then
336 begin
337 GetMem(R.Data,R.Size);
338 F^.Read(R.Data^,R.Size);
339 OK:=F^.Status=stOK;
340 end;
341 if OK=false then DisposeRecord(R);
342 end;
343 ReadRecord:=OK;
344 end;
345
ReadTopicnull346 function TOAHelpFile.ReadTopic(T: PTopic): boolean;
347 var SrcPtr,DestPtr,TopicSize: sw_word;
348 NewR: TRecord;
349 LinkPosCount: integer;
350 LinkPos: array[1..50] of TRect;
IsLinkPosStartnull351 function IsLinkPosStart(X,Y: integer): boolean;
352 var OK: boolean;
353 I: integer;
354 begin
355 OK:=false;
356 for I:=1 to LinkPosCount do
357 with LinkPos[I] do
358 if (A.X=X) and (A.Y=Y) then
359 begin
360 OK:=true;
361 Break;
362 end;
363 IsLinkPosStart:=OK;
364 end;
IsLinkPosEndnull365 function IsLinkPosEnd(X,Y: integer): boolean;
366 var OK: boolean;
367 I: integer;
368 begin
369 OK:=false;
370 for I:=1 to LinkPosCount do
371 with LinkPos[I] do
372 if (B.X=X) and (B.Y=Y) then
373 begin
374 OK:=true;
375 Break;
376 end;
377 IsLinkPosEnd:=OK;
378 end;
ExtractTextRecnull379 function ExtractTextRec(var R: TRecord): boolean;
GetNextNibblenull380 function GetNextNibble: byte;
381 var B,N: byte;
382 begin
383 B:=PByteArray(R.Data)^[SrcPtr div 2];
384 N:=( B and ($0f shl (4*(SrcPtr mod 2))) ) shr (4*(SrcPtr mod 2));
385 Inc(SrcPtr);
386 GetNextNibble:=N;
387 end;
388 procedure RealAddChar(C: char);
389 begin
390 if Assigned(NewR.Data) then
391 PByteArray(NewR.Data)^[DestPtr]:=ord(C);
392 Inc(DestPtr);
393 end;
394 var CurX,CurY: integer;
395 InLink: boolean;
396 procedure AddChar(C: char);
397 begin
398 if IsLinkPosStart(CurX+2,CurY) then
399 begin
400 RealAddChar(hscLink);
401 InLink:=true;
402 end
403 else
404 if (C=hscLineBreak) and (InLink) then
405 begin
406 RealAddChar(hscLink);
407 InLink:=false;
408 end;
409 RealAddChar(C);
410 if IsLinkPosEnd(CurX+2,CurY) then
411 begin
412 RealAddChar(hscLink);
413 InLink:=false;
414 end;
415 if C<>hscLineBreak then
416 Inc(CurX)
417 else
418 begin
419 CurX:=0;
420 Inc(CurY);
421 end;
422 end;
423 var OK: boolean;
424 C: char;
425 P: pointer;
GetNextCharnull426 function GetNextChar: char;
427 var C: char;
428 I,N,Cnt: byte;
429 begin
430 N:=GetNextNibble;
431 case N of
432 $00 : C:=#0;
433 $01..$0D : C:=chr(Compression.CharTable[N]);
434 ncRawChar : begin
435 I:=GetNextNibble;
436 C:=chr(I+GetNextNibble shl 4);
437 end;
438 ncRepChar : begin
439 Cnt:=2+GetNextNibble;
440 C:=GetNextChar();
441 for I:=1 to Cnt-1 do AddChar(C);
442 end;
443 end;
444 GetNextChar:=C;
445 end;
446 begin
447 OK:=Compression.CompType in[ctNone,ctNibble];
448 if OK then
449 case Compression.CompType of
450 ctNone : ;
451 ctNibble :
452 begin
453 CurX:=0; CurY:=0; InLink:=false;
454 NewR.SClass:=0;
455 NewR.Size:=0;
456 NewR.Data:=nil;
457 SrcPtr:=0; DestPtr:=0;
458 while SrcPtr<(R.Size*2) do
459 begin
460 C:=GetNextChar;
461 AddChar(C);
462 end;
463 if InLink then AddChar(hscLineBreak);
464 TopicSize:=DestPtr;
465
466 CurX:=0; CurY:=0; InLink:=false;
467 NewR.SClass:=R.SClass;
468 NewR.Size:=Min(MaxHelpTopicSize,TopicSize);
469 GetMem(NewR.Data, NewR.Size);
470 SrcPtr:=0; DestPtr:=0;
471 while SrcPtr<(R.Size*2) do
472 begin
473 C:=GetNextChar;
474 AddChar(C);
475 end;
476 if InLink then AddChar(hscLineBreak);
477 DisposeRecord(R); R:=NewR;
478 if (R.Size>DestPtr) then
479 begin
480 P:=R.Data; GetMem(R.Data,DestPtr);
481 Move(P^,R.Data^,DestPtr); FreeMem(P,R.Size); R.Size:=DestPtr;
482 end;
483 end;
484 else OK:=false;
485 end;
486 ExtractTextRec:=OK;
487 end;
488 var OK: boolean;
489 TextR,KeyWR: TRecord;
490 I: sw_word;
491 begin
492 OK:=T<>nil;
493 if OK and (T^.Text=nil) then
494 begin
495 LinkPosCount:=0; FillChar(LinkPos,Sizeof(LinkPos),0);
496 FillChar(TextR,SizeOf(TextR),0); FillChar(KeyWR,SizeOf(KeyWR),0);
497 F^.Seek(T^.FileOfs); OK:=F^.Status=stOK;
498 if OK then OK:=ReadRecord(TextR,true);
499 OK:=OK and (TextR.SClass=oa_rtText);
500 if OK then OK:=ReadRecord(KeyWR,true);
501 OK:=OK and (KeyWR.SClass=oa_rtKeyword);
502
503 if OK then
504 begin
505 case Version.FormatVersion of
506 TP55FormatVersion :
507 with THLPKeywordRecord55(KeyWR.Data^) do
508 begin
509 UpContext:=LEToN(UpContext);
510 DownContext:=LEToN(DownContext);
511 T^.LinkCount:=KeywordCount;
512 GetMem(T^.Links,T^.LinkSize);
513 if T^.LinkCount>0 then
514 for I:=0 to T^.LinkCount-1 do
515 with Keywords[I] do
516 begin
517 KwContext:=LEToN(KwContext);
518 T^.Links^[I].Context:=KwContext;
519 T^.Links^[I].FileID:=ID;
520 Inc(LinkPosCount);
521 with LinkPos[LinkPosCount] do
522 begin
523 A.Y:=PosY-1; B.Y:=PosY-1;
524 A.X:=StartX-1; B.X:=EndX-1;
525 end;
526 end;
527 end;
528 else
529 with THLPKeywordRecord(KeyWR.Data^) do
530 begin
531 KeywordCount:=LEToN(KeywordCount);
532 UpContext:=LEToN(UpContext);
533 DownContext:=LEToN(DownContext);
534 T^.LinkCount:=KeywordCount;
535 GetMem(T^.Links,T^.LinkSize);
536 if KeywordCount>0 then
537 for I:=0 to KeywordCount-1 do
538 begin
539 Keywords[I].KwContext:=LEToN(Keywords[I].KwContext);
540 T^.Links^[I].Context:=Keywords[I].KwContext;
541 T^.Links^[I].FileID:=ID;
542 end;
543 end;
544 end;
545 end;
546
547 if OK then OK:=ExtractTextRec(TextR);
548 if OK then
549 if TextR.Size>0 then
550 begin
551 T^.Text:=TextR.Data; T^.TextSize:=TextR.Size;
552 TextR.Data:=nil; TextR.Size:=0;
553 end;
554
555 DisposeRecord(TextR); DisposeRecord(KeyWR);
556 end;
557 ReadTopic:=OK;
558 end;
559
560 destructor TOAHelpFile.Done;
561 begin
562 if F<>nil then Dispose(F, Done);
563 inherited Done;
564 end;
565
CreateProcnull566 function CreateProc(const FileName,Param: string;Index : longint): PHelpFile;
567 begin
568 CreateProc:=New(POAHelpFile, Init(FileName,Index));
569 end;
570
571 procedure RegisterHelpType;
572 begin
573 RegisterHelpFileType(@CreateProc);
574 end;
575
576 END.
577