Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/RADOOR30.ZIP/ML-MOD.ZIP/LANGUAGE.PAS

Pascal/Delphi Source File | 1994-04-10 | 9.0 KB | 304 lines

{╔═════════════════════════════════════════════════════════════════════════╗
 ║                                                                         ║
 ║                   (c) CopyRight LiveSystems 1990, 1994                  ║
 ║                                                                         ║
 ║ Author    : Gerhard Hoogterp                                            ║
 ║ FidoNet   : 2:282/100.5   2:283/7.33                                    ║
 ║ BitNet    : [e-mail]                                     ║
 ║                                                                         ║
 ║ SnailMail : Kremersmaten 108                                            ║
 ║             7511 LC Enschede                                            ║
 ║             The Netherlands                                             ║
 ║                                                                         ║
 ║        This module is part of the RADoor BBS doorwriters toolbox.       ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝}

Unit Language;
Interface
Uses Dos,
     GlobInfo,
     LowLevel;

{ The results which are passed back }

Const Lang_Ok                        =  0;
      Lang_CannotOpenFile            = -1;
      Lang_CannotReadHeader          = -2;
      Lang_CannotReadIndex           = -3;
      Lang_CannotReadLanguage        = -4;
      Lang_NotEnoughMemory           = -5;
      Lang_IncorrectLangFileVersion  = -6;

      CurrentLangFileVersion         = $100;

{ The record with the global language information }

Type SpecialRecord  = Record
                       FileId    : Array[1..32] Of Char;
                       VersionNr : Word;              { CurrLanguage version }
                       ProgName  : String[8];         { using programname    }
                       LanguageID: String[3];         { ENG/NL     }
                       YesDef    : Char;              { %Y         }
                       NoDef     : Char;              { %N         }
                       StopDef   : Char;              { %S         }
                       YesNorm   : Char;              { %y         }
                       NoNorm    : Char;              { %n         }
                       StopNorm  : Char;              { %s         }
                       BrackRgt  : Char;              { %L         }
                       BrackLft  : Char;              { %R         }
                       ENTER     : String[10];        { %E         }
                       Colors    : Array[0..9] Of Byte; { Colortable }
                       Entries   : Word;              { No strings }
                      End;

Var Specials  : SpecialRecord;

{----------------------------------------------------------------------------|
InitLanguageData  reads the languagefile and prepares the index and language
                  buffer
|----------------------------------------------------------------------------}
Function InitLanguageData(FileName : PathStr):Integer;

{----------------------------------------------------------------------------|
CleanUpHeap       Clears the buffers. Finalize the language support.
|----------------------------------------------------------------------------}
Procedure CleanUpHeap;

{----------------------------------------------------------------------------|
GrabLine          Returns the string which is defined by the given number.
|----------------------------------------------------------------------------}
Function GrabLine(Nr : Word):String;

{----------------------------------------------------------------------------|
ExpandString      Expand the macro's (%Y,%E etc) in the given string. Handy
                  for example when you want to center the string!
|----------------------------------------------------------------------------}
Function ExpandString(S : String):String;

Implementation

Var ExitSave : Pointer;

Const MaxSentence = 500;

Type  IndexEntryRec  = Record
                        Nr    : Word;
                        Start : Word;
                        Len   : Byte;
                       End;

      LanguageArray  = Array[0..$FFFE] Of Char;
      LanguagePtr    = ^LanguageArray;

      IndexArray     = Array[1..MaxSentence] of IndexEntryRec;
      IndexPtr       = ^IndexArray;

Var LangData  : LanguagePtr;
    LangSize  : Word;
    Index     : IndexPtr;
    IdxSize   : Word;

Function InitLanguageData(FileName : PathStr):Integer;
Var Data   : File;
    Entry  : IndexEntryRec;

Begin
LangData:=NIL;
Index:=NIL;

Assign(Data,FileName);
Reset(Data,1);
If IoResult<>0
   Then Begin
        InitLanguageData:=Lang_CanNotOpenFile;
        Exit;
        End;

BlockRead(Data,Specials,SizeOf(Specials));
If IoResult<>0
   Then Begin
        Close(Data);
        InitLanguageData:=Lang_CannotReadHeader;
        Exit;
        End;

If Specials.VersionNr<>CurrentLangFileVersion
   Then Begin
        Close(Data);
        InitLanguageData:=Lang_IncorrectLangFileVersion;
        Exit;
        End;

IdxSize:=Specials.Entries*SizeOf(Entry);
GetMem(Index,IdxSize);
If Index=NIL
   Then Begin
        Close(Data);
        InitLanguageData:=Lang_NotEnoughMemory;
        Exit;
        End;

FillChar(Index^,IdxSize,$00);
BlockRead(Data,Index^,IdxSize);
If IoResult<>0
   Then Begin
        Close(Data);
        CleanUpHeap;
        InitLanguageData:=Lang_CannotReadIndex;
        Exit;
        End;

LangSize:=FileSize(Data)-IdxSize-SizeOf(Specials);
GetMem(LangData,LangSize);
If LangData=NIL
   Then Begin
        Close(Data);
        CleanUpHeap;
        InitLanguageData:=Lang_NotEnoughMemory;
        Exit;
        End;

FillChar(LangData^,LangSize,#00);
BlockRead(Data,LangData^,LangSize);
If IoResult<>0
   Then Begin
        Close(Data);
        CleanUpHeap;
        InitLanguageData:=Lang_CannotReadLanguage;
        Exit;
        End;

Close(Data);
InitLanguageData:=Lang_Ok;
End;

Procedure CleanUpHeap;
Begin
If LangData<>NIL
   Then Begin
        FreeMem(LangData,LangSize);
        LangData:=Nil;
        End;
If Index<>NIL
   Then Begin
        FreeMem(Index,IdxSize);
        Index:=Nil;
        End;
FillChar(Specials,SizeOf(Specials),#00);
End;

Function PrepareString(S : String):String;
Var Count : Byte;
    Temp  : String;
Begin
Count:=1;
Temp:='';
While Count<=Length(S) Do
 Begin
 If S[Count]<>'%'
    Then Begin
         Temp:=Temp+S[Count];
         Inc(Count);
         End
    Else Begin
         With Specials Do
           Case S[Count+1] Of
             'Y' : Temp:=Temp+YesDef;
             'N' : Temp:=Temp+NoDef;
             'S' : Temp:=Temp+StopDef;
             'y' : Temp:=Temp+YesNorm;
             'n' : Temp:=Temp+NoNorm;
             's' : Temp:=Temp+StopNorm;
             'L' : Temp:=Temp+ BrackLft;
             'R' : Temp:=Temp+BrackRgt;
             'E' : Temp:=Temp+ENTER;
             '%' : Temp:=Temp+'%';
           End; {Case}
         Inc(Count,2);
         End; {Else}
 End; {For}
PrepareString:=Temp;
End;

Function GrabLine(Nr : Word):String;
Var Temp    : Word;
    TempStr : String;
Begin
If NR=0
   Then Begin
        LogIt('Programmers error!!');
        GrabLine:='** ERROR **';
        Exit;
        End;
Temp:=0;
GrabLine:='';
While (Temp<=Specials.Entries) And (Index^[Temp].Nr<>Nr) Do
 Inc(Temp);
If Temp>Specials.Entries
   Then Exit;
Move(LangData^[Index^[Temp].Start],TempStr[1],Index^[Temp].Len);
TempStr[0]:=Chr(Index^[Temp].Len);
GrabLine:=PrepareString(TempStr);
End;

Function ExpandString(S : String):String;
Var StrNr : Word;
    Temp  : Byte;
    Count : Byte;
Begin
S:=PrepareString(S);
Count:=1;
While Count<Length(S) Do
 Begin
 If (S[Count]=']') And
    ( (Count+1)<Length(S) ) And
    (S[Count+1] in ['0'..'9'])
    Then Begin
         StrNr:=Str2Nr(Copy(S,Count+1,3));
         Delete(S,Count,4);
         Insert(GrabLine(StrNr),S,Count);
         Count:=Count+Length(GrabLine(StrNr));
         End
    Else Inc(Count);
 End;
ExpandString:=S;
End;


{$F+}
Procedure langExitProc;
{$F-}
Begin
ExitProc:=ExitSave;    { Chain to old Exit Procedure }
If (ErrorAddr<>Nil) Or
   (ExitCode<>0)
   Then Begin
        Dispose(HeapOrg);
        LogIt('ExitCode : '+S(ExitCode,0));
        LogIt('ErrorAddr: $'+S(Seg(ErrorAddr),0)+':$'+S(Ofs(ErrorAddr),0));
        LogIt('MemAvail : '+Sl(MemAvail,0));
        ErrorAddr:=Nil;
        ExitCode:=0;
        End;
End;

{$F+}
Function LangHeapFunc(Size : Word):Integer;
{$F-}
Begin
LangHeapFunc:=1;
If Size>MemAvail
   Then Begin
        LogIt('Requested '+SL(Size,0));
        LogIt('Available '+SL(MemAvail,0));
        End;
End;


Begin
HeapError:=@LangHeapFunc; { Set the Heap Function            }
ExitSave:=ExitProc;       { Store the Current Exit procedure }
ExitProc:=@LangExitProc;  { Set My own Exit Procedure        }
End.