helpfile.pas

Turbo Pascal 6.0编译器源码

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.