www.pudn.com > tp60src.zip > HELPFILE.PAS
unit HelpFile;
{$O+,F+,S-,X+,V-}
interface
uses Objects;
function ReadTopic(Num: Word; P: PChar; MaxLen: Word;
var Size, NKeywords: Word): Boolean;
function ReadIndex(P: PChar; Beg, Size: Word): Word;
implementation
uses TDos, TVars, Utils, StrNames;
var
CurFile: Word;
RecHeader: record
RecType: Byte;
RecLength: Word
end;
const
rtFileHeader = 0;
rtContext = 1;
rtText = 2;
rtKeyword = 3;
rtIndex = 4;
rtCompression = 5;
type
Ofs24 = array[0..2] of Shortint;
function Ofs2Long(T: Ofs24): Longint;
var
L: Longint absolute T;
begin
LongRec(L).Hi := T[2];
Ofs2Long := L;
end;
function ReadChar: Char;
var
C: Char;
begin
FRead(CurFile, C, SizeOf(C));
ReadChar := C;
end;
function CheckSignature(S: string): Boolean;
var
C: Char;
I: Integer;
begin
CheckSignature := False;
C := ReadChar;
I := 1;
while C <> #0 do
begin
if S[I] <> C then
Exit;
C := ReadChar;
Inc(I);
end;
CheckSignature := I - 1 = Length(S);
end;
procedure ReadRecHeader;
begin
FRead(CurFile, RecHeader, SizeOf(RecHeader));
end;
function CheckSign1: Boolean;
var
C: Char;
begin
CheckSign1 := False;
if not CheckSignature(Strings^.Get(sHelpSign1)) then
Exit;
C := ReadChar;
if C <> ^Z then
Exit;
CheckSign1 := True;
end;
function CheckSign2: Boolean;
begin
CheckSign2 := CheckSignature(Strings^.Get(sHelpSign2));
end;
var
Version: record
FormatVersion: Byte;
TextVersion: Byte;
end;
function CheckVersion: Boolean;
begin
FRead(CurFile, Version, SizeOf(Version));
CheckVersion := Version.FormatVersion = $33;
end;
var
Header: record
Options: Word;
MainIndexScreen: Word;
MaxScreenSize: Word;
Height: Byte;
Width: Byte;
LeftMargin: Byte;
end;
procedure ReadHeader;
begin
ReadRecHeader;
FRead(CurFile, Header, SizeOf(Header));
end;
var
Compression: record
CompType: Byte;
CharTable: array[0..13] of Byte;
end;
const
ctNibble = 2;
procedure ReadCodes;
begin
ReadRecHeader;
FRead(CurFile, Compression, SizeOf(Compression));
end;
function Decode(S1, S2: Pointer; var Size: Word): Boolean; assembler;
asm
PUSH DS
LDS SI,S1
LES DI,S2
SUB DX,DX
SUB CH,CH
LEA BX,Compression.CharTable
CLD
@@1: MOV AL,DH
XOR DL,1
JZ @@2
LODSB
MOV DH,AL
MOV CL,4
SHR DH,CL
AND AL,0FH
@@2: CMP AL,14
JAE @@3
PUSH DS
MOV DS,[BP-2]
XLAT
POP DS
JMP @@6
@@3: JNZ @@5
MOV AL,DH
XOR DL,1
JZ @@4
LODSB
MOV DH,AL
MOV CL,4
SHR DH,CL
AND AL,0FH
@@4: MOV CH,AL
ADD CH,2
JMP @@1
@@5: LODSB
TEST DL,1
JZ @@6
MOV CL,4
SUB AH,AH
SHL AX,CL
OR AL,DH
MOV DH,AH
@@6: CMP AL,1
JE @@9
AND CH,CH
JNZ @@7
CMP DI,SI
JAE @@8
STOSB
JMP @@1
@@7: MOV CL,CH
SUB CH,CH
ADD CX,DI
CMP CX,SI
JAE @@8
SUB CX,DI
REP STOSB
JMP @@1
@@8: XOR AX,AX
JMP @@10
@@9: MOV AX,1
@@10: LDS SI,Size
SUB DI,WORD PTR S2
MOV [SI],DI
POP DS
end;
function ReadKeywords(P: PChar; MaxLen, Size: Word; var NKeywords: Word):
Boolean;
var
PP: PWordArray;
begin
ReadKeywords := False;
ReadRecHeader;
if Size + RecHeader.RecLength <= MaxLen then
begin
PP := PWordArray(Longint(P) + (MaxLen - RecHeader.RecLength));
FRead(CurFile, PP^, RecHeader.RecLength);
NKeywords := PP^[2];
ReadKeywords := True;
end;
end;
function SearchTopic(Num: Word; var Ofs: Longint): Boolean;
var
L: Ofs24;
Max: Word;
Pos: Longint;
begin
ReadRecHeader;
FRead(CurFile, Max, SizeOf(Max));
if (Num = 0) or (Num > Max) then
SearchTopic := False
else
begin
Pos := FSeek(CurFile, 0, 1);
FSeek(CurFile, Num * 3, 1);
FRead(CurFile, L, SizeOf(L));
Ofs := Ofs2Long(L);
if Ofs < 0 then
begin
FSeek(CurFile, Pos + 4 * 3, 0);
FRead(CurFile, L, SizeOf(L));
Ofs := Ofs2Long(L);
end;
SearchTopic := True;
end;
end;
function ReadCode(Ofs: Longint; P: PChar; MaxLen: Word;
var Size, NKeywords: Word): Boolean;
var
Code: PWordArray;
begin
ReadCode := False;
FSeek(CurFile, Ofs, 0);
ReadRecHeader;
if MaxLen >= RecHeader.RecLength then
begin
Code := PWordArray(MaxLen - RecHeader.RecLength + Longint(P));
FRead(CurFile, Code^, RecHeader.RecLength);
if Decode(Code, P, Size) then
ReadCode := ReadKeywords(P, MaxLen, Size, NKeywords);
end;
end;
function DoReadTopic(Num: Word; P: PChar; MaxLen: Word;
var Size, NKeywords: Word): Boolean;
var
Ofs: Longint;
begin
DoReadTopic := False;
if SearchTopic(Num, Ofs) then
DoReadTopic := ReadCode(Ofs, P, MaxLen, Size, NKeywords);
end;
function OpenFile: Boolean;
var
S: string;
begin
OpenFile := False;
S := Strings^.Get(sHelpFileName);
SearchSysDir(S);
if S <> '' then
begin
CurFile := FOpen(S, 0);
if CurFile < 0 then
Exit;
end else
begin
MessageBox(sNoHelpFile, nil,mfError + mfOkButton);
Exit
end;
if not CheckSign1 or not CheckSign2 or not CheckVersion then
begin
MessageBox(sInvalidHelpFile, nil, mfError + mfOkButton);
FClose(CurFile);
Exit;
end;
ReadHeader;
ReadCodes;
OpenFile := True;
end;
procedure CloseFile;
begin
FClose(CurFile);
end;
function ReadTopic(Num: Word; P: PChar; MaxLen: Word; var Size, NKeywords: Word):
Boolean;
procedure ReadFailed;
begin
Size := 1;
P^ := #0;
NKeywords := 0;
ReadTopic := False;
end;
begin
ReadTopic := True;
if OpenFile then
begin
if not DoReadTopic(Num, P, MaxLen, Size, NKeywords) then
ReadFailed;
CloseFile;
end else
ReadFailed;
end;
function DoReadIndex(P: PChar; Beg, Size: Word): Word;
begin
DoReadIndex := 0;
ReadRecHeader;
FSeek(CurFile, RecHeader.RecLength, 1);
ReadRecHeader;
if RecHeader.RecType = rtIndex then
begin
FSeek(CurFile, Beg, 1);
DoReadIndex := FRead(CurFile, P^, Size);
if Beg + Size > RecHeader.RecLength then
PByteArray(P)^[RecHeader.RecLength - Beg] := 0;
end;
end;
function ReadIndex(P: PChar; Beg, Size: Word): Word;
procedure ReadFailed;
begin
PWordArray(P)^[0] := 0;
ReadIndex := 0;
end;
begin
ReadIndex := 0;
if Size = 0 then
Exit;
if OpenFile then
begin
ReadIndex := DoReadIndex(P, Beg, Size);
CloseFile;
end else
ReadFailed;
end;
end.