* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against RBBSSUB1.BAS to produce D:\LITE\RBBSSUB1.OLD
* RBBSSUB1.BAS:  Date 10-2-1988  Size 52864 bytes
* ------------[ Created 10-25-1988 20:16:19 ]------------
* REPLACING old line(s) by new
118 INPUT #2, TURN.PRINTER.OFF,_    ' Turn printer off each recycle
              DIRECTORY.PATH$, _    ' Where dir files are stored
              MIN.SEC.TO.VIEW, _
              LIMIT.SEARCH.TO.FMS, _
              DEFAULT.CATEGORY.CODE$, _
              DIR.CATEGORY.FILE$, _
              NEW.FILES.CHECK, _
              MAX.DESC.LEN, _
              SHOW.SECTION, _
              COMMANDS.IN.PROMPT, _
              NEWUSER.SETS.DEFAULTS, _
              HELP.PATH$, _
              HELP.EXTENSION$, _
              MAIN.COMMANDS$, _
              FILE.COMMANDS$, _
              UTIL.COMMANDS$, _
              GLOBAL.COMMANDS$, _
              SYSOP.COMMANDS$
    INPUT #2, RECYCLE.WAIT, _
              OPT.SEC(39), _       ' SECURITY FOR LIBRARY COMMANDS 1
              OPT.SEC(40), _
              OPT.SEC(41), _
              OPT.SEC(42), _
              OPT.SEC(43), _
              OPT.SEC(44), _
              OPT.SEC(45), _       ' LIBRARY COMMANDS 7
              LIBRARY.DRIVE$, _
              LIBRARY.DIRECTORY.PATH$, _
              LIBRARY.DIRECTORY.EXTENTION$, _
              LIBRARY.WORK.DISK.PATH$, _
              LIBRARY.MAX.DISK, _
              LIBRARY.MAX.DIRECTORY, _
              LIBRARY.MAX.SUBDIR, _
              LIBRARY.SUBDIR.PREFIX$, _
              LIBRARY.ARCHIVE.PATH$, _
              LIBRARY.ARCHIVE.PROGRAM$, _
              LIBRARY.COMMANDS$
'
' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ****
' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ****
'
    INPUT #2, UPLOAD.PATH$, _              ' Where upl dir goes
              MAIN.FMS.DIRECTORY$, _       ' Shared dir in FMS
              ANS.MENU$, _
              REQUIRED.QUESTIONNAIRE$,_
              REMEMBER.NEW.USERS,_
              SURVIVE.NOUSER.ROOM,_
              PROMPT.HASH$,_
              START.HASH,_
              LEN.HASH,_
              PROMPT.INDIV$,_
              START.INDIV,_
              LEN.INDIV
    INPUT #2, BYPASS.MSGS, _
              MUSIC, _
              RESTRICT.BY.DATE, _
              DAYS.TO.WARN, _
              DAYS.IN.REGISTRATION.PERIOD, _
              CALLBACK.VERIFICATION, _
              RESTRICT.VALID.CMDS, _
              NEW.USER.DEFAULT.MODE, _
              NEW.USER.LINE.FEEDS, _
* ------[ first line different ]------
              ARKVIEW.PATH$, _            'VIEWARC info comes from CONFIG.EXE
              NEW.USER.BELL, _
              NEW.USER.CASE, _
              NEW.USER.MARGINS, _
              WRAP.CALLERS.FILE$, _
              REDIRECT.IO.METHOD, _
              GO.TO.SHELL, _
              HALT.ON.ERROR, _
              NEW.PUBLIC.MSGS.SECURITY, _
              NEW.PRIVATE.MSGS.SECURITY, _
              SECURITY.NEEDED.TO.CHANGE.MSGS, _
              SL.CATEGORIZE.UPLOADS, _
              BAUDOT, _
              TIME.TO.DROP.TO.DOS, _
              EXPIRED.SECURITY, _
              DTR.DROP.DELAY, _
              ASK.IDENTITY, _
              USE.EXTERNAL.XMODEM, _
              BUFFER.SIZE, _
              MLCOM, _
              SHOOT.YOURSELF, _
              F7.MESSAGE$, _
              NEW.USER.DEFAULT.PROTOCOL$, _
              NEW.USER.GRAPHICS$, _
              NET.MAIL$, _
              MASTER.DIRECTORY.NAME$, _
              PROTO.DEF$, _
              UPCAT.HELP$, _
              ALWAYS.STREW.TO$, _
              LAST.NAME.PROMPT$
    INPUT #2, PERSONAL.DRVPATH$, _
              PERSONAL.DIR$, _
              PERSONAL.BEGIN, _
              PERSONAL.LEN, _
              PERSONAL.PROTOCOL$, _
              PERSONAL.CONCAT , _
              PRIVATE.READ.SEC, _
              PUBLIC.READ.SEC, _
              SEC.CHANGE.MSG, _
              KEEP.INIT.BAUD, _
              MAIN.PUI$, _
              DEFAULT.ECHOER$, _
              HOST.ECHO.ON$, _
              HOST.ECHO.OFF$, _
              SWITCH.BACK, _
              DEFAULT.LINE.ACK$, _
              ALTDIR.EXTENSION$, _
              DIRECTORY.PREFIX$
    IF CONFERENCE.MODE THEN _
       INPUT #2, DF, _
                 DF, _
                 DF _
    ELSE INPUT #2, DF,_
                   MODEM.INIT.WAIT.TIME, _
                   MODEM.COMMAND.DELAY.TIME
    INPUT #2, TURBO.RBBS, _
              SUBDIR.COUNT, _
              DF, _
              UPLOAD.TO.SUBDIR, _
              DF, _
              UPLOAD.SUBDIR$, _
              MIN.OLDCALLER.BAUD, _
              USE.EXTERNAL.YMODEM, _
              DISKFULL.GO.OFFLINE, _
              EXTENDED.LOGGING
     IF CONFERENCE.MODE THEN _
        INPUT #2, DF$, _
                  DF$, _
                  DF$, _
                  DF$ _
     ELSE INPUT #2, MODEM.RESET.COMMAND$, _
                    MODEM.COUNT.RINGS.COMMAND$, _
                    MODEM.ANSWER.COMMAND$, _
                    MODEM.GO.OFFHOOK.COMMAND$
     INPUT #2,DISK.FOR.DOS$, _
              DUMB.MODEM, _
              COMMENTS.AS.MESSAGES
     IF CONFERENCE.MODE THEN _
        INPUT #2, DF, _
                  DF, _
                  DF, _
                  DF, _
                  DF, _
                  DF _
     ELSE INPUT #2, LSB,_
                    MSB,_
                    LINE.CONTROL.REGISTER,_
                    MODEM.CONTROL.REGISTER,_
                    LINE.STATUS.REGISTER,_
                    MODEM.STATUS.REGISTER
     INPUT #2,KEEP.TIME.CREDITS, _
              XON.XOFF, _
              ALLOW.CALLER.TURBO, _
              USE.DEVICE.DRIVER$, _
              PRELOG$, _
              NEW.USER.QUESTIONNAIRE$, _
              EPILOG$, _
              REGISTRATION.PROGRAM$, _
              QUES.PATH$, _
              USER.LOCATION$, _
              DF$, _
              DF$, _
              DF$, _
              ENFORCE.UPLOAD.DOWNLOAD.RATIOS, _
              SIZE.OF.STACK, _
              SECURITY.EXEMPT.FROM.EPILOG, _
              USE.BASIC.WRITES, _
              DOSANSI, _
              ESCAPE.INSECURE, _
              USE.DIR.ORDER, _
              ADD.DIR.SECURITY, _
              MAX.EXTENDED.LINES, _
              ORIG.COMMANDS$
     INPUT #2,LOGON.MAIL.LEVEL$, _
              MACRO.DRVPATH$, _
              MACRO.EXTENSION$, _
              EMPHASIZE.ON.DEF$, _
              EMPHASIZE.OFF.DEF$, _
              FG.1.DEF$, _
              FG.2.DEF$, _
              FG.3.DEF$, _
              FG.4.DEF$, _
              SECVIO.HLP$, _
              FOSSIL, _
              MAX.CARRIER.WAIT, _
              DF, _
              SMART.TEXT, _
              TIME.LOCK, _
              WRITE.BUF.DEF, _
              DF, _
              DF, _
              DF, _
              AUTOPAGE.DEF$
     IF EC > 0 THEN _
        EXIT SUB
     CALL EDITDEF
     END SUB
' $SUBTITLE: 'OPENCOM - subroutine to open the communications port'
' $PAGE
'
'  SUBROUTINE NAME    -- OPENCOM
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                       BAUD.RATE$                 BAUD TO OPEN MODEM
'                       PARITY$                    PARITY TO OPEN MODEM
'
'  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
'
'  SUBROUTINE PURPOSE -- TO OPEN THE COMMUNICATIONS PORT.
'
      SUB OPENCOM(BAUD.RATE$,PARITY$) STATIC
      ON ERROR GOTO 65000
* REPLACING old line(s) by new
59660 SUB PUTWORK (STRNG$,REC.NUM,REC.LEN) STATIC
      ON ERROR GOTO 65000
      FIELD #2,REC.LEN AS UPLOAD.RECORD$
      LSET UPLOAD.RECORD$ = STRNG$
      REC.NUM = REC.NUM + 1
      PUT #2,REC.NUM
      END SUB
* ------[ first line different ]------
' 
'
' $SUBTITLE: 'VIEWTXT - Subroutine to display ASCII file from ARC file'
' $PAGE
'
  SUB VIEWTXT STATIC
  ON ERROR GOTO 65000
* INSERTING new line(s)
60148 SUBROUTINE.PARAMETER = 1
      CALL SKIPLINE (1)
      A$ = "Would you like to view an ASCII file from this ARC (Y/[N])"  'DMOD1
      CALL TGET
       IF NOT YES THEN _
       EXIT SUB 
60149  A$ = "What file(s) to view, [ENTER] quits"                       'DMOD1
     CALL TGET
       B = 1                                                            'DMOD1
       IF Q = 0 THEN _                                                  'DMOD1
          EXIT SUB                                                      'DMOD1
       LAST.ARC = Q                                                     'DMOD1
       FIRST.ARC = B                                                    'DMOD1
       FOR ARC.INDEX = FIRST.ARC TO LAST.ARC                            'DMOD1
 Z$ = B$(ARC.INDEX)                                                     'DMOD1
      CALL ALLCAPS (Z$)  
      CALL PETER2                                                       'PEMOD1
     IF OK = FALSE THEN 60149                                           'PEMOD1
      CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)                        'DMOD1
 IF EXT$ = "ARC" OR EXT$ = "COM" OR EXT$ = "EXE" OR EXT$ = "BAS" OR _   'DMOD1
         EXT$ = "BIN" OR EXT$ = "LIB" OR EXT$ = "OBJ" THEN _            'DMOD1
         CALL QTPUT ("Sorry, only ASCII files can be viewed",1) :_      'DMOD1
         GOTO 60149                                                     'DMOD1
      CALL QTPUT ("Please stand by while I extract that file....",1)    'DMOD1
      SHOWME$ = "PKXARC -R " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$'PEMOD1
      SHELL SHOWME$                                                     'PEMOD1
      Z$ = ARKVIEW.PATH$ +"\"+ Z$     'Added \ to fix error 63
      TEMP$ = Z$                                                        'PEMOD1
      CALL BUFFILE (Z$,X)                                   '10/09/88.fix
   CALL KILLWORK(TEMP$)   'get rid of the files that were xtracted 10/09/88
       NEXT                                                             'DMOD1
60152 END SUB
'
'*******************************
'*  Subroutine for Viewarc txt *
'*******************************
' SUBTITLE: 'PETER2
' $PAGE
  SUB PETER2 STATIC
  OK = TRUE
  IF INSTR(Z$,"*") OR INSTR(Z$,"?") THEN _
  OK = FALSE : _
  CALL QTPUT ("Sorry Widcars NOT allowed !!",1)
   END SUB
'******************** INSERTED DLVIEWARC HERE ******************
'
' $SUBTITLE: 'DLVIEWARC - Subroutine to  DL a file from ARC file'
' $PAGE
'
  SUB DLVIEWARC STATIC
  ON ERROR GOTO 65000
60168 DLARC = 0
      SUBROUTINE.PARAMETER = 1
      CALL SKIPLINE (1)
      A$ = "Would you like to DOWNLOAD a file from this ARC (Y/[N])"  'DMOD1
      CALL TGET
       IF NOT YES THEN _
       EXIT SUB 
60169  DLARC=1
  CALL QTPUT(FILE.NAME.HOLD$ + " Contains the following Files",1)
   CALL VIEWARC
   SUBROUTINE.PARAMETER = 1
   CALL SKIPLINE (1)
   A$ = "What file(s) to download, [ENTER] quits"                      'DMOD1
    CALL TGET
      B = 1                                                            'DMOD1
      IF Q = 0 THEN _                                                  'DMOD1
       EXIT SUB                                                        'DMOD1
       LAST.ARC = Q                                                    'DMOD1
       FIRST.ARC = B                                                   'DMOD1
       FOR ARC.INDEX = FIRST.ARC TO LAST.ARC                           'DMOD1
  Z$ = B$(ARC.INDEX)                                                   'DMOD1
     CALL ALLCAPS (Z$)  
     CALL PETER2                                                       'PEMOD1
     IF OK = FALSE THEN 60169                                           'PEMOD1
     CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)                        'DMOD1
     CALL QTPUT ("Please stand by while I extract that file....",1)    'DMOD1
     SHOWME$ = "PKXARC -R " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$'PEMOD1
     SHELL SHOWME$
     IF DLARC = 1 THEN _
    CALL QTPUT(Z$+" Is now  Extracted ...",2)
  NEXT
CALL QTPUT ("One Moment while I ARC the file for you........",1)
'
'********** ARC all files in the ARKVIEW.PATH$ into VIEWARC.ARC **********
'
  SHELL "PKARC A " + ARKVIEW.PATH$ + "\VIEW.ARC " + ARKVIEW.PATH$ + "\*.*"
'
'********** Deletes the files that were just ARCED into VIEWARC.ARC **********
'
  FOR ARC.INDEX = FIRST.ARC TO LAST.ARC
      Z$ = B$(ARC.INDEX)
   CALL KILLWORK (ARKVIEW.PATH$ + "\" + Z$)
  NEXT ARC.INDEX
'
'********** Tells the caller the name of the file to download **********
'
CALL QTPUT (CHR$(7)+"File has been ARCHIVED ...and named... VIEW.ARC....",2)
CALL QTPUT (CHR$(7)+"To Download this file You MUST enter VIEW.ARC as the file name",2)
CALL DELAYIT (5)
 60172 END SUB
'
'  $SUBTITLE: 'Error Handling for separately compiled subroutines'
'  $PAGE
'
' *****************************************************************************
' *  Error handling for the separately compiled subroutines of RBBS-PC        *
' *****************************************************************************
'
* REPLACING old line(s) by new
65000 IF DEBUG THEN _
         A$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
              STR$(ERL) + _
              " ERR=" + _
              STR$(ERR) : _
         IF PRINTER THEN _
            CALL PRINTIT(A$) _
         ELSE CALL LPRNT(A$,1)
      EC = ERR
'
'     SETCALL
'
      IF ERL = 110 THEN _
          RESUME NEXT
'
'     OPEN CONFIG FILE
'
       IF ERL => 117 AND ERL <= 118 THEN _
          RESUME NEXT
'
'     OPEN COM PORT ERROR HANDLING
'
      IF ERL = 200 THEN _
         CLS : _
         CALL LPRNT("Fatal error opening " + COM.PORT$,1) : _
         CALL LPRNT ("DOS ERROR=" + STR$(ERR),1) : _
         STOP
'
'     GETCOM ERROR HANDLING
'
       IF ERL = 1420 AND ERR = 57 THEN _
          RESUME NEXT
       IF ERL = 1420 AND ERR = 69 THEN _
          SUBROUTINE.PARAMETER = -1 :_
          RESUME NEXT
'
'      OPENRESEQ ERROR HANDLING
'
       IF ERL = 1481 THEN _
           EC = ERR : _
           RESUME NEXT
'
'      OPENUSER ERROR HANDLING
'
       IF ERL = 9400 AND ERR = 75 AND SHARE.IT THEN _
          CALL DELAYIT (30) : _
          RESUME
'
'      FINDUSER ERROR HANDLING
'
       IF ERL = 12610 THEN _
          RESUME NEXT
'
'     UPDTCALR ERROR HANDLING
'
       IF ERL = 13663 THEN _
          RESUME NEXT
       IF ERL = 13670 AND ERR = 61 THEN _
          CALL QTPUT ("Disk Full",1) : _
          IF DISKFULL.GO.OFFLINE THEN _
             GOTO 65010 _
          ELSE RESUME NEXT
'
'     PRINTER ERROR HANDLING
'
       IF ERL = 13674 THEN _
          PRINTER = FALSE : _
          RESUME
'
'      CHANGEDIR ERROR HANDLING
'
       IF ERL = 20103 THEN _
          OK = FALSE : _
          RESUME NEXT
'
'     FINDIT ERROR HANDLING
'
       IF ERL = 20221 THEN _
          RESUME NEXT
       IF ERL = 20223 AND EC = 58 THEN _
          EC = 64 : _
          OK = FALSE : _
          RESUME NEXT
       IF ERL = 20223 AND EC = 76 THEN _
          CALL LPRNT("Bad path.  File name is " + FILNAME$,1) : _
          EC = 76 : _
          OK = FALSE : _
          RESUME NEXT
       IF ERL => 20221 AND ERL <= 20223 AND EC = 70 _
          AND NETWORK.TYPE = 6 THEN _
             EC = 0 : _
             RESUME NEXT
       IF ERL => 20221 AND ERL <= 20223 THEN _
          RESUME
'
'     FLUSHCOM ERROR HANDLING
'
       IF ERL = 20311 AND ERR = 57 THEN _
          RESUME NEXT
       IF ERL = 20311 AND ERR = 69 THEN _
          ABORT = TRUE : _
          SUBROUTINE.PARAMETER = -1 : _
          RESUME NEXT
'
'     NETBIOS ERROR HANDLING
'
       IF ERL => 29900 AND ERL <= 29920 THEN _
          RESUME NEXT
'
'     UPDATEC ERROR HANDLING
'
      IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
         A$ = "* Disk full - terminating *" : _
         SUBROUTINE.PARAMETER =2 : _
         CALL TPUT : _
         IF DISKFULL.GO.OFFLINE THEN _
           GOTO 65010 _
         ELSE SYSTEM
'
'     FINDFREE ERROR HANDLING
'
'
'     OPENWORK ERROR HANDLING
'
'
'      OPENFMS ERROR HANDLING
'
'
'     OPENOUTW ERROR HANDLING
'
'
'     KILLWORK ERROR HANDLING
'
'
'     GETPASWD ERROR HANDLING
'
'
'     READDIR ERROR HANDLING
'
'
'     READSEC ERROR HANDLING
'
'
'     READANY ERROR HANDLING
'
'
'     PRINTWRK ERROR HANDLING
'
'
'     GETWORK ERROR HANDLING
'
'
'     OPENWRKA ERROR HANDLING
'
'
'     PRNTWRKA ERROR HANDLING
'
'
'     CHECKINT ERROR HANDLING
'
       IF ERL = 59652 AND ERR = 24 THEN _
          NOT.CTS = TRUE : _
          CALL LINE25 : _
          RESUME
       IF ERL => 52000 AND ERL <= 59660 THEN _
          RESUME NEXT
* ------[ first line different ]------
'      VIEWARC  ERROR HANDLER 
'
 IF ERL = 60149 AND ERR = 53 THEN _
         CALL QTPUT ("ERROR !!! No Such File, EXITING",1):_
         RESUME NEXT
IF ERL = 60149 AND ERR = 63 THEN _
         CALL QTPUT ("ERROR Occured, Please notify SysOp",1):_
         RESUME NEXT
'
'
'      DLVIEW ARC TXT ERROR HANDLER 
'
 IF ERL = 60169 AND ERR = 53 THEN _
         CALL QTPUT ("ERROR !!! No Such File, EXITING",1):_
         RESUME NEXT
'
'     CATCH ALL OTHER ERRORS
'
       A$ = "RBBS-SUB1 Untrapped Error" + _
            STR$(ERR) + _
            " in line" + _
            STR$(ERL)
       CALL QTPUT (A$,1)
       CALL UPDTCALR (A$,2)
       RESUME NEXT
'     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL