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

Pascal/Delphi Source File | 1994-04-10 | 27.3 KB | 707 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 all the QBBS specific stuff. It's main purpose is to
  fill the GlobalInfo record. Doing things this way it's easier to make a
  door less system dependable. As long as you only use the information
  in GlobalInfo in your doors, it's easy to make versions for other BBSses
  or to add support for more than one BBS. (Detect in your mainprogram and
  call the right initprocedure!)

  If an other BBS doesn't support some information which is contained in the
  GlobalInfo record, it's up to YOU to provide usable values!

|--------------------------------------------------------------------------}
{$Define UseMultiLanguage}  {Turn multilang. support for logging on/off}

Unit QuickBBS;
Interface
Uses Dos,
     CRT,
{$IfDef UseMultiLanguage}
     Language, { Language support, needed for Logging         }
{$EndIf}
     FileObj,  { Typed file handling object                   }
     Fossil,   { Fossil object, needed for online msgs.       }
     GlobInfo; { The globale info. Thisone needs to be filled }

Const  QBBS = 3;  { This is a unike BBS tag to indentify the current  }
                  { BBS in the global info. Make tags for other BBSes }
                  { Also unike, at least for your own programs!       }

Var QPath : PathStr;


(*****************************************************************)
(*         Structures document for QuickBBS version 2.75         *)
(*         Copyright 1991, Pegasus Software                      *)
(*                     All Rights Reserved.                      *)
(*****************************************************************)
{ Downsized a bit by me, Gerhard Hoogterp                         }

Const
  MaxMsgAreas  = 200;
  MaxFileAreas = 200;
  MaxEvents    = 30;

type

  QFlagType = array[1..4] of Byte;

  QUserRecord = record
                 Name        : String[35];
                 City        : String[25];
                 Pwd         : String[15];
                 DataPhone,
                 HomePhone   : String[12];
                 LastTime    : String[5];
                 LastDate    : String[8];
                 Attrib      : Byte;
                 Flags       : QFlagType;
                 Credit,
                 Pending,
                 TimesPosted,
                 HighMsgRead,
                 SecLvl,
                 Times,
                 Ups,
                 Downs,
                 UpK,
                 DownK,
                 TodayK      : Word;
                 Elapsed,
                 Len         : Integer;
                 CombinedPtr : Word; (* Record number in
                               COMBINED.BBS *)
                 AliasPtr     : Word; (* Record number in ALIAS.BBS
                               *)
                 Birthday    : Longint;
               end;
(*  Attrib:

      Bit 0: Deleted
      Bit 1: Screen Clear Codes
      Bit 2: More Prompt
      Bit 3: ANSI
      Bit 4: No-Kill
      Bit 5: Ignore Download Hours
      Bit 6: ANSI Full Screen Editor
      Bit 7: Sex (0=male, 1=female)

*)

  QAliasRecord = String[35]; (* for ALIAS.BBS *)

  { Other Stuff ************************************************* }


  QSysInfoRecord = record
                    CallCount  : LongInt;
                    LastCaller : String[35];
                    ExtraSpace : array[1..128] of Byte;
                  end;

  QTimeLogRecord = record
                    StartDate   : String[8];
                    BusyPerHour : array[0..23] of Integer;
                    BusyPerDay  : array[0..6] of Integer;
                  end;

  { Configuration Information *********************************** }

  QTypeMsgs  = (Standard,Netmail,EMail,EchoMail);
  QKindMsgs  = (Both,Private,Public,ROnly);
  QEventStat = (Deleted, Enabled, Disabled);
  QAskType   = (No, Maybe, Yes);

  QSecurityRecord = Record
                      Security : Word;
                      Flags    : QFlagType;
                    End;

  QEventRecord = record (* EVENTCFG.DAT *)
                  Status      : QEventStat;
                  RunTime     : LongInt;
                  ErrorLevel  : Byte;
                  Days        : Byte;
                  Forced      : Boolean;
                  LastTimeRun : LongInt;
                  Spare       : Array[1..7] of Byte;
                end;

  QConfigRecord = record  (* QUICKCFG.DAT *)

                   VersionID : Word;

                   Node      : Byte;

                   (*  Modem Parameters  *)
                   CommPort      : Integer;
                   InitBaud      : Word;
                   ModemDelay    : Word;
                   InitTimes,
                   AnswerWait    : Integer;
                   ModemInitStr,
                   ModemBusyStr  : String[70];
                   ModemInitResp,
                   ModemBusyResp,
                   Resp300,
                   Resp1200,
                   Resp2400,
                   Resp9600,
                   Resp19200,
                   Resp38400     : String[40];

                   (*  System Paths  *)
                   EditorCmdStr    : String[70];
                   MenuPath,
                   TextPath,
                   NetPath,
                   NodelistPath,
                   MsgPath,
                   SwapPath,
                   OverlayPath     : String[66];

                   (* System misc strings *)
                   LoadingMessage  : String[70];
                   SelectionPrompt : String[70];
                   NoMailString    : String[70];
                   OriginLine      : String[58];
                   QuoteStr        : String[3];

                   (*  User Restrictions *)
                   LowBaudStart,
                   LowBaudEnd,
                   DownloadStart,
                   DownloadEnd     : LongInt;
                   MaxPageTimes,
                   PageBellLen     : Integer;
                   PagingStart,
                   PagingEnd       : LongInt;
                   MinBaud,
                   GraphicsBaud,
                   XferBaud        : Integer;

                   (*  Matrix Information  *)
                   MatrixZone,
                   MatrixNet,
                   MatrixNode,
                   MatrixPoint     : array[0..10] of Integer;
                   NetMailBoard    : Integer;

                   (*  Default Information for New Users  *)
                   DefaultSec      : QSecurityRecord;
                   MinimumSec      : QSecurityRecord;
                   DefaultCredit   : Integer;

                   (*  Sysop Security Etc. *)
                   SysopSecurity   : QSecurityRecord;
                   SysopName       : String[35];
                   SystemName      : String[40];
                   RegKey          : LongInt;

                   (*  Misc System Parameters  *)

                   TextFileShells,
                   AltJswap,
                   Editorswap,
                   AutoLogonChar,
                   FastLogon,
                   UseLastRead,
                   MonoMode,
                   DirectWrite,
                   SnowCheck,
                   NetEchoExit,
                   OneWordNames,
                   CheckMail,
                   AskHomePhone,
                   AskDataPhone,
                   AskBirthday,
                   AskSex,
                   Use_Xmodem,
                   Use_Xmodem1k,
                   Use_Ymodem,
                   Use_YmodemG,
                   Use_Sealink,
                   Use_Zmodem,
                   Inp_Fields,
                   GraphicsAvail,
                   ForceUS_Phone   : Boolean;
                   InactiveTimeOut : Integer;
                   LogonTime       : Integer;
                   DefFgColor      : Integer;
                   DefBgColor      : Integer;
                   PasswordTries   : Integer;
                   EntFldColor     : Byte; (*  Color for entry
                                     fields *)
                   BorderColor      : Byte; (* Color for menu
                                     borders *)
                   WindowColor     : Byte;
                   StatusBarColor  : Byte;
                   UploadCredit    : Integer;
                   ScreenBlank     : Byte;

                   (* Callback verifier *)
                   VerifierInit    : string[35];
                   DialString      : string[15];
                   DialSuffix      : string[15];
                   DupeCheck       : Boolean;
                   NewUserSec,
                   MemberSec       : Word;
                   MemberFlags     : Array[1..4,1..8] of Char;
                   LDcost          : Word;
                   LDenable,
                   ResumeLocal,
                   ResumeLD        : Boolean;
                   LDstart,
                   LDend           : Longint;

                   ExtraSpace      : Array[1..400] of Byte;

                 end;

 QGosubDataType = array[1..20] of String[8];

 QExitRecord = record
                 BaudRate        : Integer;
                 SysInfo         : QSysInfoRecord;
                 TimeLogInfo     : QTimeLogRecord;
                 UserInfo        : QUserRecord;
                 EventInfo       : QEventRecord;
                 NetMailEntered  : Boolean;
                 EchoMailEntered : Boolean;
                 LoginTime       : String[5];
                 LoginDate       : String[8];
                 TmLimit         : Integer;
                 LoginSec        : LongInt;
                 Credit          : LongInt;
                 UserRecNum      : Integer;
                 ReadThru        : Integer;
                 PageTimes       : Integer;
                 DownLimit       : Integer;
                 WantChat        : Boolean;
                 GosubLevel      : Byte;
                 GosubData       : QGosubDataType;
                 Menu            : String[8];
               end;

{--------------------------------------------------------------------------|
  Variables which contain the CONFIG.RA and the EXITINFO.BBS info. Note
  that I included Q(bbs) in the variable name to avoid conflicts with the
  names of other BBSses their configuration files.
|--------------------------------------------------------------------------}

Var QExitInfo  : QExitRecord;
    QConfig    : QConfigRecord;

{--------------------------------------------------------------------------|
  And the procedures to read and write the configuration info.

  InitQBBS
         Should be called once at the start of your program to initialize
         your door for QBBS

  UpdateExitInfo
         Rewrites the EXITINFO.BBS Record. To avoid problems with newer
         version of QBBS, which probably add fields to this file, only
         as much bytes are read and written as the size of the record
         defined in this unit. As long as the file is upward compatible
         this should avoid conflicts.
         The function returns false if it wasn't able to write the info.

         The users TimeLimit and Security are always updated while writing,
         Other field you have to change for yourself.

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


Procedure InitQBBS;
Function QBBSUpdateExitInfo:Boolean;


Implementation
Uses LowLevel; { To avoid a circular reference error }

Const UseLog : Boolean = False; { Is set to TRUE as soon as a LogProcedure }
                                { is installed                             }

Const Months : Array[1..12] Of String[3] =
       ('Jan','Feb','Mar','Apr','May','Jun',
        'Jul','Aug','Sep','Oct','Nov','Dec');

{$F+}
Procedure QBBSLogIt(LogLine  : MaxlogStr);
{$F-}

Var Log    : Text;
    temp   : Integer;
    Hour   : Word;
    Minute : Word;
    Dum    : Word;
    Day    : Word;
    Month  : Word;
    Year   : Word;

Begin
If Not UseLog
   Then Exit;

{$IfDef UseMultiLanguage}
  LogLine:=ExpandString(LogLine);
{$EndIf}

GetTime(Hour,Minute,Dum,Dum);
GetDate(Year,Month,Day,Dum);
LogLine:= S(Day,2)+'-'+
          Months[Month]+'-'+
          S(Year-1900,2)+' '+
          S(Hour,2)+':'+
          S(Minute,2)+'  '+
          LogLine;

If LogLine[1]=' '
   Then LogLine[1]:='0';
For Dum:=11 To 15 Do
 If LogLine[Dum]=' '
    Then LogLine[Dum]:='0';

FileMode:=ReadWrite+ShareDenyNone;
Assign(Log,GlobalInfo.LogFileName);
Append(Log);
If IoResult<>0
   Then Rewrite(Log);
WriteLn(Log,LogLine);
Close(Log);
If IoResult<>0
   Then Begin
        WriteLn(#254' Can''t LOG anymore !!!');
        UseLog:=False;
        End;
End;

Procedure QBBSBirthDay(    Magic          : LongInt;
                       Var Day,Month,Year : Word;
                       Var Age            : Byte);

Const DaysAMonth : Array[1..12] Of Byte =
                   (31,28,31,30,31,30,31,
                    31,30,31,30,31);

Var Now : DateTime;
    Dum : Word;

Function IsLeapYear(Year : Word):Boolean;
Begin
IsLeapYear:= ((Year Mod 4)   =  0)  And
             {((Year Mod 400) =  0) And}
             ((Year Mod 100) <> 0);
End;

Begin
Year:=1600;
While (Magic>365) Do
 Begin
 If (IsLeapYear(Year))
    Then Dec(Magic);
 Inc(Year);
 Dec(Magic,365);
 End;

Month:=1;
Repeat
 If Magic>DaysAMonth[Month]
    Then Begin
         Dec(Magic,DaysAMonth[Month]);
         If (Month=2) And
            IsLeapYear(Year)
            Then Dec(Magic);
         Inc(Month);
         End;
Until Magic<=DaysAMonth[Month];
Day:=Magic;
With Now Do
 GetDate(Year,Month,Day,Dum);

Age:=Now.Year-Year-1;
If (Now.Month>Month) or
   ((Now.Month=Month) And (Now.Day>=Day))
   Then Inc(Age);

End;


Function ReadQBBSConfig:Boolean;
Var Conf : FileObject;
    Size : Word;
Begin
ReadQBBSConfig:=False;
FillChar(QConfig,SizeOf(QConfig),#00);

Conf.Open('QUICKCFG.DAT',1,ReadOnly+ShareDenyNone);
If Conf.Error<>0
   Then Begin
        Conf.Open(QPath+'QUICKCFG.DAT',1,ReadOnly+ShareDenyNone);
        If Conf.Error<>0
           Then Exit;
        End;
Size:=SizeOf(QConfig);
Conf.ReadBuffer(QConfig,Size);
Conf.Close;


With GlobalInfo Do
 Begin
 BBStag  := QBBS;
 BBSName := 'QBBS v.'+S(Lo(QConfig.VersionID),0)+'.'+SF(Hi(QConfig.VersionID),2);

 OnlineStatus:=Normal;
 SystemStatus:=S_OK;

 LogfileName   := 'SYSTEM.LOG';

 LogIt := QBBSLogIt;

 UseLog        := True;
 TimeOutTime   := QConfig.InactiveTimeout;
 Warnings      := 2; { My constate! }


 UserFilePath  := QConfig.MsgPath;
 CompletePath(UserFilePath);


 LeftBracket   := '[';
 RightBracket  := ']';

 SysopName     := QConfig.SysOpName;
 SystemName    := QConfig.SystemName;
 SystemLocation:= 'UnKnown';

 LocalMono     := QConfig.MonoMode;

 If ExistParameter('P:')
    Then ComPort:=Str2Nr(GrabParameter('P:'))
    Else ComPort := QConfig.CommPort;

 MultiLine     := QConfig.Node>1;
 End; {With}

{---- To make sure the major paths are all nice and complete... ---------}

CompletePath(QConfig.MenuPath);
CompletePath(QConfig.TextPath);
CompletePath(QConfig.NetPath);
CompletePath(QConfig.NodelistPath);
CompletePath(QConfig.MsgPath);
GlobalInfo.CommonDir:=GlobalInfo.SystemPath;

ReadQBBSConfig  := True;
End;



{---- ExitInfo.bbs procedures -----------------------------------------}

Function QBBSUpdateExitInfo:Boolean;
Var Info : FileObject;
    Size : Word;
Begin
QBBSUpdateExitInfo:=False;

If GlobalInfo.MultiLine
   Then Info.Open('EXITINFO.BBS',1,ReadWrite+ShareDenyNone)
   Else Info.Open(GlobalInfo.SystemPath+'EXITINFO.BBS',1,ReadWrite+ShareDenyNone);

If Info.Error <> 0
   Then Exit;

Size:=SizeOf(QExitInfo);

QExitInfo.UserInfo.SecLvl:=GlobalInfo.UserSecurity;

QExitInfo.TmLimit:=GlobalInfo.MinRemaining;

Info.GotoRecord(0);
Info.WriteBuffer(QExitInfo,Size);
Info.Close;

QBBSUpdateExitInfo:=Info.Error=0;
End;


Function ReadExitInfo:Boolean;
Var Info : FileObject;
    Size : Word;
    TDate: DateTime;
Begin
ReadExitInfo:=False;
FillChar(QExitInfo,SizeOf(QExitInfo),#00);

If GlobalInfo.MultiLine
   Then Info.Open('EXITINFO.BBS',1,ReadOnly+ShareDenyNone)
   Else Info.Open(GlobalInfo.SystemPath+'EXITINFO.BBS',1,ReadOnly+ShareDenyNone);

If Info.Error <> 0
   Then Exit;

Size:=SizeOf(QExitInfo);
Info.ReadBuffer(QExitInfo,Size);
Info.Close;

With GlobalInfo Do
 Begin

 ScreenWidth  := 80;

 UserName     := QExitInfo.UserInfo.Name;
 UserHandle   := '';
 UserGroup    := 1;

 If QExitInfo.UserInfo.AliasPtr>0
    Then Begin
         Info.Open(GlobalInfo.UserFilePath+'ALIAS.BBS',SizeOf(UserHandle),ReadOnly+ShareDenyNone);
         If Info.Error=0
            Then Begin
                 Info.GotoRecord(QExitInfo.UserInfo.AliasPtr);
                 Info.Read(UserHandle);
                 Info.Close;
                 End;
         End;

 UserLocation := QExitInfo.UserInfo.City;
 UserSecurity := QExitInfo.UserInfo.SecLvl;

 If QExitInfo.UserInfo.BirthDay>0
    Then Begin
         With TDate Do
          Begin
          QBBSBirthDay(QExitInfo.USerInfo.BirthDay,Day,Month,Year,UserAge);
          UserBirthDay :=SF(Day,2)+'-'+SF(Month,2)+'-'+SF(Year-1900,2);
          End;
         End
    Else Begin
         UserBirthDay := 'Unknown ';
         UserAge      := 0;
         End;


 UserSex      := (QExitInfo.UserInfo.Attrib  And $40 ) = $40;
 ScreenLength := QExitInfo.UserInfo.Len;
 UseGraphics  := (QExitInfo.UserInfo.Attrib  And $08 ) = $08;
 UseAVATAR    := False;
 UseMoreYN    := (QExitInfo.UserInfo.Attrib  And $04 ) = $04;
 UseClrScr    := (QExitInfo.UserInfo.Attrib  And $02 ) = $02;
 UseQuietMode := False;

 BaudRate     := QExitInfo.BaudRate;
 MinRemaining := QExitInfo.TmLimit;
 TimeLimit    := QExitInfo.TmLimit;
 End; {With}

GlobalInfo.IEMSI.Session := False;

ReadExitInfo:= True;
End;



{--------------------------------------------------------------------------|
  INITQBBS:

  Read the QBBS configuration files (CONFIG.BBS and EXITINFO.BBS) and fill
  and check for the standard commandline parameters.

  -T:<Time>     Maximal time in this door, overrules the EXITINFO.BBS setting
                The time has to be given in minutes. Mostly here for
                compatability with RAdoor 2.3
  -N:<Node>     Node number, there's no other way under RA. Defaults to node 1
  -P:<CommPort> Overrules the CONFIG.RA Comport setting. Usefull for multiline
                Systems.
  -NOS          Turns off local noise for default.

  Further the GlobalInfo variables SystemPath and HomeDir are filled:

  SystemPath    Path to the RA system directory. The environment variable
                RA= has to be there.

  HomeDir       The directory from where the door was fired up. I usual
                use this directory to look for auxilary files. The homedir
                is found by stripping the filename of ParamStr(0). The user
                can ALWAYS overrule this value by setting an environment
                variable <PROGNAME> with an other path. PROGNAME is the REAL
                name of the program (the EXE file) minus the path and the
                extention!

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



Procedure InitQBBS;

Var ProgName : String[8];
    Dum      : String[4];
    TTime    : Word;
Begin
QPath:=GetEnv('QUICK');
CompletePath(QPath);
GlobalInfo.SystemPath:=QPath;


FSplit(ParamStr(0),GlobalInfo.HomeDir,ProgName,Dum);
If GetEnv(ProgName)<>''
   Then GlobalInfo.HomeDir:=GetEnv(ProgName);
If GlobalInfo.HomeDir<>''
   Then CompletePath(GlobalInfo.HomeDir);


GlobalInfo.Node:=Str2Nr(GrabParameter('N:'));
If GlobalInfo.Node=0
   Then GlobalInfo.Node:=1;

If Not ReadQBBSConfig
   Then Begin
        WriteLn(#254' Couldn''t read CONFIG info!');
        Halt;
        End;

If Not ReadExitInfo
   Then Begin
        WriteLn(#254' Couldn''t read EXITINFO.BBS!');
        Halt;
        End;

If ExistParameter('T:')
   Then Begin
        TTime:=Str2Nr(GrabParameter('T:'));
        If TTime<=GlobalInfo.MinRemaining
           Then GlobalInfo.MinRemaining:=TTime;
        End;

If ExistParameter('L:')
   Then GlobalInfo.Language:=GrabParameter('L:')
   Else GlobalInfo.Language:='ENGLISH';

If ExistParameter('NOS')
   Then GlobalInfo.LocalNoise:=False;

End;
End.