Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/RADOOR30.ZIP/DOORSYS.PAS

Pascal/Delphi Source File | 1994-04-10 | 9.5 KB | 352 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.       ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝}
{---------------------------------------------------------------------------|
 Description:

 This unit contains general procedures and functions which are common to
 most doors. The routines have access to the information in GlobalInfo
 so they can adjust themself to the users settings.

|--------------------------------------------------------------------------}

Unit DOORSys;
Interface
Uses DOS,
     CRT,
     KeyDefs,   { Keyboard definitions             }
     GlobInfo,  { Global system info               }
     LowLevel,  { Lowlevel procedures and functions}
     FileObj,   { Binary file handling routines    }
     Fossil;    { Fossil routines                  }




{----------------------------------------------------------------------------|
  Display Routines:

    DisplayFile   Displays a single file to the remote console. YOU have to
                  give the right path and extention, DisplayFile only copy's
                  it to the comport. (And to the local console)
                  The procedure responds to the [S] Stop and [P] pause
                  keys. With pause ANY key will restart sending.
                  The fossil output filter is turned off while displaying.


    Display       Displays a file according the the users GRAPHICS (ANSI)
                  AVATAR or ASCII settings. It uses DisplayFile for the
                  actual displaying.
                  You should only give the path and the filename without
                  extention. If no file is found and nothing is displayed
                  the function returns FALSE, otherwise it returns TRUE.

    ShowTextFile  This procedure is intended to show textfiles. It uses the
                  users ScreenLength, UseClrScr and UseMoreYN toggles.
                  Again, the fossils output filter is turned off while
                  displaying the contents of the file, but is on while showing
                  the PressEnterPrompt and the TitleLine.
                  The [P] pause and [S] stop keys are recognised. ANY key
                  will resume displaying after a Pause.
                  You must give the complete path, filename and extention
                  of the file to show.

    ShowHelpFile  Shows a helpfile. Translates the $$ into pagefeeds
                  etc.

|----------------------------------------------------------------------------}




Function DisplayFile( Foss     : FossilObject;
                      FileName : ComStr):Boolean;

Procedure Display( Foss     : FossilObject;
                   FileName : ComStr);

Procedure ShowTextFile( Foss     : FossilObject;
                        FileName : ComStr;
                        Title    : String);

Procedure ShowHelpFile( Foss     : FossilObject;
                        FileName : ComStr;
                        Title    : String);



Implementation


{---- Display functions ----------------------------------------------------}

Procedure Display( Foss     : FossilObject;
                   FileName : ComStr);

Const MaxBuf = 256;

Var AAAFile : FileObject;
    Buffer  : Array[1..MaxBuf] Of Char;
    BufPtr  : Word;
    BufUsage: Word;
    Stop    : Boolean;

Begin

AAAFile.Open(FileName,1,ReadOnly+ShareDenyNone);
If AAAFile.Error<>0
   Then Exit;

Foss.OutputFilterOff;

BufUsage:=MaxBuf;
Stop:=False;

While (Not Stop) And (BufUsage=MaxBuf) Do
 Begin
 AAAFile.ReadBuffer(Buffer,BufUsage);
 BufPtr:=1;
 While (Not Stop) And (BufPtr<=BufUsage) Do
  Begin
  Case Buffer[BufPtr] Of
   #01  : Begin
          Foss.OutPutFilterOn;
          Foss.PressEnter;
          Foss.OutputFilterOff;
          End;
   #16  :
          Delay(1000);
    Else  Foss.WriteF(Buffer[BufPtr]);
  End;
  Inc(BufPtr);
  If Foss.KeyPressedF
     Then Begin
          Case Upcase(Foss.ReadKeyF) Of
           'S' : Stop:=True;
           'P' : Foss.PressANYKey;
          End; {Case}
          End;
  End;
 End;
AAAFile.Close;

Foss.OutputFilterOn;
End;

Function DisplayFile( Foss     : FossilObject;
                      FileName : ComStr):Boolean;
Begin
DisplayFile:=True;
If GlobalInfo.UseGraphics And
   GlobalInfo.UseAvatar And
   ExistFile(FileName+'.AVT')
   Then Begin
        Display(Foss,FileName+'.AVT');
        Exit;
        End;

If GlobalInfo.UseGraphics And
   ExistFile(FileName+'.ANS')
   Then Begin
        Display(Foss,FileName+'.ANS');
        Exit;
        End;

If ExistFile(FileName+'.ASC')
   Then Display(Foss,FileName+'.ASC')
   Else DisplayFile:=False;
End;

Procedure ShowTextFile( Foss     : FossilObject;
                        FileName : ComStr;
                        Title    : String);

Var STFile  : Text;
    TextBuf : Array[0..1023] Of Char;
    Stop    : Boolean;
    Lines   : Word;
    Line    : String;
Begin
FileMode:=ReadOnly+ShareDenyNone;
If Not ExistFile(FileName)
   Then Exit;

Assign(STFile,FileName);
SetTextBuf(STFile,TextBuf);
Reset(STFile);
If IoResult<>0
   Then Exit;

Stop:=False;

Lines:=0;
If Title<>''
   Then Begin
        Foss.WriteF('^0');
        Foss.ClrScrF;
        Foss.WriteLnF(Title);
        Foss.WriteLnF('');
        Inc(Lines,2);
        End;

While Not (Stop Or Eof(STFile)) Do
 Begin
 ReadLn(STFile,Line);
 Foss.WriteLnF(Line);
 Inc(Lines);

 If Foss.KeyPressedF
    Then Begin
         Case Upcase(Foss.ReadKeyF) Of
          'S' : Stop:=True;
          'P' : Foss.PressAnyKey;
         End;
         End;

 If GlobalInfo.UseMoreYN And
    (Lines= (GlobalInfo.ScreenLength -2)) { For the press enter line.. }
    Then Begin

         Lines:=0;
         Foss.WriteLnF('');
         Stop:=Foss.PressEnterOrStop;
         If (Not Stop) and
            (Title<>'')
            Then Begin
                 Foss.WriteF('^0');
                 Foss.ClrScrF;
                 Foss.WriteLnF(Title);
                 Foss.WriteLnF('');
                 Inc(Lines,2);
                 End;

         End;
 End;

Close(StFile);
If Not Stop
   Then Begin
        While Lines<=(GlobalInfo.ScreenLength-2) Do
          Begin
          Foss.WriteLnF('');
          Inc(Lines);
          End;
        Foss.PressEnter;
        End;
Foss.WriteF('^0');
End;

Procedure ShowHelpFile( Foss     : FossilObject;
                        FileName : ComStr;
                        Title    : String);

Var STFile  : Text;
    TextBuf : Array[0..1023] Of Char;
    Stop    : Boolean;
    Lines   : Word;
    Line    : String;
Begin
FileMode:=ReadOnly+ShareDenyNone;
If Not ExistFile(FileName)
   Then Exit;

Assign(STFile,FileName);
SetTextBuf(STFile,TextBuf);
Reset(STFile);
If IoResult<>0
   Then Exit;

Stop:=False;

Lines:=0;
If Title<>''
   Then Begin
        Foss.ClrScrF;
        Foss.WriteLnF(Title);
        Foss.WriteLnF('');
        Inc(Lines,2);
        End;

While Not (Stop Or Eof(STFile)) Do
 Begin
 ReadLn(STFile,Line);
 If Pos('$$',Line)=1
    Then Begin
         While Lines<=(GlobalInfo.ScreenLength-2) Do
          Begin
          Foss.WriteLnF('');
          Inc(Lines);
          End;
         Stop:=Foss.PressEnterOrStop;
         If (Not Stop) and
            (Title<>'')
            Then Begin
                 Foss.WriteF('^0');
                 Foss.ClrScrF;
                 Foss.WriteLnF(Title);
                 Foss.WriteLnF('');
                 Lines:=2;
                 End;
         End
    Else Begin
         Foss.WriteLnF(Line);
         Inc(Lines);
         End;

 If Foss.KeyPressedF
    Then Begin
         Case Upcase(Foss.ReadKeyF) Of
          'S' : Stop:=True;
          'P' : Foss.PressAnyKey;
         End;
         End;

 If GlobalInfo.UseMoreYN And
    (Lines= (GlobalInfo.ScreenLength -2)) { For the press enter line.. }
    Then Begin

         Lines:=0;
         Foss.WriteLnF('');
         Stop:=Foss.PressEnterOrStop;
         If (Not Stop) and
            (Title<>'')
            Then Begin
                 Foss.WriteF('^0');
                 Foss.ClrScrF;
                 Foss.WriteLnF(Title);
                 Foss.WriteLnF('');
                 Inc(Lines,2);
                 End;

         End;
 End;

Close(StFile);
If Not Stop
   Then Begin
        While Lines<=(GlobalInfo.ScreenLength-2) Do
          Begin
          Foss.WriteLnF('');
          Inc(Lines);
          End;
        Foss.PressEnter;
        End;
Foss.WriteF('^0');
End;

End.