' $linesize:132
' $title: 'RBBS-SUB1.BAS CPC17.2B, Copyright 1986-89 by D. Thomas Mack'
'  Copyright 1989 by D. Thomas Mack, all rights reserved.
'  Name ...............: RBBSSUB1.BAS
'  Written by .........: D. Thomas Mack
'  First Released .....: May 28, 1989
'  Subsequent Releases.: 07-30-89
'  Copyright ..........: 1986-1989
'  Purpose.............:
'     Subprorams that require error trapping are incorporated
'     within RBBSSUB1.BAS as separately callable subroutines
'     in order to free up as much code as possible within
'     the 64K code segment used by RBBS-PC.BAS.
'  Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine  Line               Function of Subroutine
'   Name     Number
'  CHANGEDIR  20101   Change subdirectory
'  CHECKINT   58360   Check input is valid integer
'  COMMPUT    59275   Write string to communications port
'  FINDFREE   51098   Find amount of space on the upload disk drive
'  FINDITX    20219   Find if a file exists on a device              ' KG061001
'  FINDUSER   12598   Find a user in the USERS file
'  FLUSHCOM   20308   Read all characters in the communications port
'  GETCOM      1418   Read a character from the communications port
'  GETPASWD   58280   Read RBBS-PC's "PASSWORD" file
'  GETWRK     58330   Read record from file number 2
'  KILLWORK   58258   Delete a RBBS-PC "WORK" file
'  NETBIOS    20898   Lock/Unlock NETBIOS semaphore files
'  OPENCOM      200   Open communications port (number 3)
'  OPENFMS    58188   Open the upload management system directory
'  OPENOUTW   28218   Open RBBS-PC's "WORK" file (number 2) for output
'  OPENRSEQ    1479   Open a sequential file (number 2) for random I/O
'  OPENUSER    9398   Open the USER file (number 5)
'  OPENWORK   57978   Open RBBS-PC's work file (number 2)
'  OPENWRKA   58340   Open RBBS-PC's "WORK" file (number 2) for append
'  PRINTIT    13673   Print line on the local PC printer
'  PRINTWRK   58320   Print string to file #2 w/o CR/LF
'  PRNTWRKA   58350   Print string to file #2 with CR/LF
'  PUTCOM     59650   Write to the communications port
'  PUTWORK    59660   Write to work file randomly
'  RBBSPLAY   59680   Plays a musical string
'  READANY    58310   Read file number 2 into A$
'  READDEF      112   Read configuration file
'  READDIR    58290   Read entire lines
'  READPARMS  58300   Read certain number of parameters from file 2
'  TALK       59700   RBBS-PC Voice synthesizer support for sight impaired
'  SETCALL      108   Find where next callers record is
'  UPDATEC    43048   Update the caller's file with elasped session time
'  UPDTCALR   13661   Update to the caller's file
'
'  $INCLUDE: 'RBBS-VAR.BAS'
'
108 ' $SUBTITLE: 'SETCALL - subroutine to find last callers rec'
' $PAGE
'
'  NAME    -- SETCALL
'
'  INPUTS  --     PARAMETER                    MEANING
'
'  OUTPUTS --  CALLERS.FILE.INDEX!
'
'  PURPOSE --  To find where to leave off on callers file
'
    SUB SETCALL STATIC
    ON ERROR GOTO 65000
    IF PREV.CALLERS$ = CALLERS.FILE$ OR CALLERS.FILE.PREFIX$ = "" THEN _
       EXIT SUB
    PREV.CALLERS$ = CALLERS.FILE$
    CALLERS.FILE.INDEX! = 1
    CLOSE 2
    CLOSE 4
    IF SHARE.IT THEN _
       OPEN CALLERS.FILE$ FOR RANDOM SHARED AS #4 LEN=64 _
    ELSE OPEN "R",4,CALLERS.FILE$,64
    FIELD 4,64 AS CALLERS.RECORD$
    IF LOF(4) > 0 THEN _
       CALLERS.FILE.INDEX! = LOF(4) / 64
    IF CALLERS.FILE.INDEX! < 1 THEN _
       CALLERS.FILE.INDEX! = 0
    B$ = STRING$(13,0)
110 GET 4,CALLERS.FILE.INDEX!
    IF EC > 0 THEN _
       EC = 0 : _
       CALLERS.FILE.INDEX! = 0 : _
       EXIT SUB
    IF LEFT$(CALLERS.RECORD$,13) = B$ THEN _
       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! - 1 : _
       GOTO 110
    END SUB

112 ' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
' $PAGE
'
'  NAME    -- READDEF
'
'  INPUTS  --     PARAMETER                    MEANING
'                CONFIG.FILENAME$            NAME OF RBBS-PC.DEF FILE
'                SUBROUTINE.PARAMETER = -62  ONLY READ THE .DEF FILE
'
'  OUTPUTS --  ALL THE RBBS-PC.DEF PARAMETERS
'
'  PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
'
     SUB READDEF (CONFIG.FILE$) STATIC
     ON ERROR GOTO 65000
'
' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ***
'
117 IF SUBROUTINE.PARAMETER <> -62 THEN _
       IF PREV.READ$ = CONFIG.FILE$ THEN _
          EXIT SUB _
       ELSE PREV.READ$ = CONFIG.FILE$
    CLOSE 2
    BULLETIN.SAVE$ = BULLETIN.MENU$
    CALL OPENWORK (2,CONFIG.FILE$)
    CURRENT.DEF$ = CONFIG.FILE$
    INPUT #2,DF$, _
             DOWNLOAD.DRIVES$, _
             SYSOP.PASSWORD.1$, _
             SYSOP.PASSWORD.2$, _
             SYSOP.FIRST.NAME$, _
             SYSOP.LAST.NAME$, _
             REQUIRED.RINGS, _
             START.OFFICE.HOURS, _
             END.OFFICE.HOURS, _
             MINUTES.PER.SESSION!, _
             DF, _
             DF, _
             UPLOAD.DIRECTORY$, _
             EXPERT.USER.DEF, _
             ACTIVE.BULLETINS, _
             PROMPT.BELL.DEF, _
             DF, _
             MENUS.CAN.PAUSE, _
             MENU$(1), _
             MENU$(2), _
             MENU$(3), _
             MENU$(4), _
             MENU$(5), _
             MENU$(6), _
             CONFERENCE.MENU$, _
             DF, _
             WELCOME.INTERRUPTABLE, _
             REMIND.FILE.TRANSFERS, _
             PAGE.LENGTH, _
             MAX.MESSAGE.LINES.DEF, _
             DOORS.AVAILABLE, _
             DF$, _
             MAIN.MESSAGE.FILE$, _
             MAIN.MESSAGE.BACKUP$
    INPUT #2, X$, _
              COMMENTS.FILE$, _
              MAIN.USER.FILE$, _
              WELCOME.FILE$, _
              NEWUSER.FILE$, _
              MAIN.DIRECTORY.EXTENTION$
    CALL BRKFNAME (X$,Y$,DF$,Z$,FALSE)
    IF DF$ <> "" THEN _                                              ' RB060403
       CALLERS.FILE$ = X$
    INPUT #2, DF$
    IF COM.PORT$ <> "COM0" THEN _
       IF NOT CONFERENCE.MODE THEN _
          COM.PORT$ = DF$
    INPUT #2, BULLETINS.OPTIONAL, _
              MODEM.INIT.COMMAND$, _
              RTS$, _
              DF, _
              FG, _
              BG, _
              BORDER
    IF CONFERENCE.MODE THEN _
       INPUT #2, DF$, _
                 DF$ _
    ELSE INPUT #2, RBBS.BAT$ , _
                   RCTTY.BAT$
    INPUT #2,OMIT.MAIN.DIRECTORY$, _
             FIRST.NAME.PROMPT$, _
             HELP$(3), _
             HELP$(4), _
             HELP$(7), _
             HELP$(9), _
             BULLETIN.MENU$, _
             BULLETIN.PREFIX$, _
             DF$, _
             MESSAGE.REMINDER, _
             REQUIRE.NON.ASCII, _
             ASK.EXTENDED.DESC, _
             MAXIMUM.NUMBER.OF.NODES, _
             NETWORK.TYPE, _
             RECYCLE.TO.DOS, _
             DF, _
             DF, _
             TRASHCAN.FILE$
    INPUT #2,MINIMUM.LOGON.SECURITY, _
             DEFAULT.SECURITY.LEVEL, _
             SYSOP.SECURITY.LEVEL, _
             FILESEC.FILE$, _
             SYSOP.MENU.SECURITY.LEVEL, _
             CONFMAIL.LIST$, _
             MAXIMUM.VIOLATIONS, _
             OPT.SEC(50), _   ' SECURITY FOR SYSOP COMMANDS 1
             OPT.SEC(51), _
             OPT.SEC(52), _
             OPT.SEC(53), _
             OPT.SEC(54), _
             OPT.SEC(55), _
             OPT.SEC(56), _   ' SYSOP 7
             PASSWORDS.FILE$, _
             MAXIMUM.PASSWORD.CHANGES, _
             MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
             OVERWRITE.SECURITY.LEVEL, _
             DOORS.TERMINAL.TYPE, _
             MAX.PER.DAY
    INPUT #2,OPT.SEC(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
             OPT.SEC(2), _
             OPT.SEC(3), _
             OPT.SEC(4), _
             OPT.SEC(5), _
             OPT.SEC(6), _
             OPT.SEC(7), _
             OPT.SEC(8), _
             OPT.SEC(9), _
             OPT.SEC(10), _
             OPT.SEC(11), _
             OPT.SEC(12), _
             OPT.SEC(13), _
             OPT.SEC(14), _
             OPT.SEC(15), _
             OPT.SEC(16), _
             OPT.SEC(17), _
             OPT.SEC(18), _   ' MAIN COMMAND 18
             MIN.NEWCALLER.BAUD, _
             WAIT.BEFORE.DISCONNECT
    INPUT #2,OPT.SEC(19), _      ' Security for FILE COMMANDS 1
             OPT.SEC(20), _
             OPT.SEC(21), _
             OPT.SEC(22), _
             OPT.SEC(23), _
             OPT.SEC(24), _
             OPT.SEC(25), _
             OPT.SEC(26), _      ' FILE COMMAND 8
             OPT.SEC(27), _      ' SECURITY FOR UTILITY COMMANDS 1
             OPT.SEC(28), _
             OPT.SEC(29), _
             OPT.SEC(30), _
             OPT.SEC(31), _
             OPT.SEC(32), _
             OPT.SEC(33), _
             OPT.SEC(34), _
             OPT.SEC(35), _
             OPT.SEC(36), _
             OPT.SEC(37), _
             OPT.SEC(38), _   ' UTIL COMMAND 12
             OPT.SEC(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
             OPT.SEC(47), _
             OPT.SEC(48), _
             OPT.SEC(49), _
             UPLOAD.TIME.FACTOR!, _
             COMPUTER.TYPE, _
             REMIND.PROFILE, _
             RBBS.NAME$, _
             COMMANDS.BETWEEN.RINGS, _
             MNP.SUPPORT, _
             PAGING.PRINTER.SUPPORT$, _
             MODEM.INIT.BAUD$
             IF EC > 0 THEN _
                EXIT SUB
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, _
              VOICE.TYPE, _
              RESTRICT.VALID.CMDS, _
              NEW.USER.DEFAULT.MODE, _
              NEW.USER.LINE.FEEDS, _
              NEW.USER.NULLS, _
              NEW.USER.BELL, _
              NEW.USER.CASE, _
              MESSAGES.CAN.GROW, _
              WRAP.CALLERS.FILE$, _
              REDIRECT.IO.METHOD, _
              AUTO.UPGRADE.SEC, _
              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, _
              MAX.REG.SEC, _
              BUFFER.SIZE, _
              MLCOM, _
              SHOOT.YOURSELF, _
              DEFAULT.EXTENSION$, _
              NEW.USER.DEFAULT.PROTOCOL$, _
              NEW.USER.GRAPHICS$, _
              NET.MAIL$, _
              MASTER.DIRECTORY.NAME$, _
              PROTO.DEF$, _
              UPCAT.HELP$, _
              ALWAYS.STREW.TO$, _
              LAST.NAME.PROMPT$
119 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$
    IF CONFERENCE.MODE THEN _
       INPUT #2, DF$,DF$,DF$ _
    ELSE INPUT #2, DEFAULT.ECHOER$, _
                   HOST.ECHO.ON$, _
                   HOST.ECHO.OFF$
    INPUT #2, 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, _
              MAX.WORK.VAR, _
              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$
     IF CONFERENCE.MODE THEN _
        INPUT #2,DF _
     ELSE INPUT #2,FOSSIL
     INPUT #2,MAX.CARRIER.WAIT, _
              DF, _
              SMART.TEXT, _
              TIME.LOCK, _
              WRITE.BUF.DEF, _
              SEC.KILL.ANY, _
              DOORS.DEF$, _
              SCREEN.OUT.MSG$, _
              AUTOPAGE.DEF$
     IF EC > 0 THEN _
        EXIT SUB
     CONFIG.FILENAME$ = CONFIG.FILE$
     CALL EDITDEF
     END SUB
200 ' $SUBTITLE: 'OPENCOM - subroutine to open the communications port'
' $PAGE
'
'  NAME    -- OPENCOM
'
'  INPUTS  --     PARAMETER                    MEANING
'                BAUD.RATE$                 BAUD TO OPEN MODEM
'                PARITY$                    PARITY TO OPEN MODEM
'
'  OUTPUTS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
'
'  PURPOSE -- To open the communications port.
'
    SUB OPENCOM(BAUD.RATE$,PARITY$) STATIC
    ON ERROR GOTO 65000
    IF FOSSIL THEN _
       IF RTS$ = "YES" THEN _
          FLOW.CONTROL = TRUE : _
          FLOW% = &H00F2 : _
          CALL FOSFLOWCTL(COMPORT%,FLOW%)
    IF INSTR(PARITY$,"N") THEN _
       PARITY% = 2 : _                                     ' NO PARITY
       DATABITS% = 3 : _                                   ' 8 DATA BITS
       STOPBITS% = 0 _                                     ' 1 STOP BIT
    ELSE PARITY% = 3 : _                                   ' EVEN PARITY
         DATABITS% = 2 : _                                 ' 7 DATA BITS
         STOPBITS% = 0                                     ' 1 STOP BIT
    IF FOSSIL THEN _
       COMSPEED% = VAL(BAUD.RATE$) : _
       CALL FOSSPEED(COMPORT%,COMSPEED%,PARITY%,DATABITS%,STOPBITS%) : _
       EXIT SUB
    CLOSE 3
    IF RTS$ = "YES" THEN _
       FLOW.CONTROL = TRUE : _
       X$ = ",CS26600,CD,DS" _
    ELSE X$ = ",RS,CD,DS"
    OPEN COM.PORT$ + ":" + BAUD.RATE$ + PARITY$ + X$ AS #3
'
' ****************************************************************************
' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
' ****************************************************************************
'
    END SUB
1418 ' $SUBTITLE: 'GETCOM -- subroutine reads a char. from  comm. port'
' $PAGE
'
'  NAME    -- GETCOM
'
'  INPUTS  --   PARAMETER     MEANING
'                 STNG$       STRING TO READ A CHARACTER INTO FROM
'                             THE COMMUNICATIONS PORT (FILE #3)
'
'  OUTPUTS --   STNG$
'
'  PURPOSE -- Reads a character from the communications port.
'
     SUB GETCOM (STRNG$) STATIC
     ON ERROR GOTO 65000
1420 IF FOSSIL THEN _
        CALL FOSRXCHAR(COMPORT%,CHAR%) : _
        STRNG$ = CHR$(CHAR%) _
     ELSE STRNG$ = INPUT$(1,3)
1421 IF EC = 57 THEN _
        LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
        EC = 0 : _
        GOTO 1420
     END SUB
1479 ' $SUBTITLE: 'OPENRSEQ  - open sequential file randomly'
' $PAGE
'
'  NAME    -- OPENRSEQ
'
'  INPUTS  -- PARAMETER             MEANING
'             FILNAME$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
'
'  OUTPUTS -- NUM.RECS      NUMBER OF 128-BYTE RECORDS IN THE FILE
'             LEN.LAST.REC  NUMBER OF BYTES IN THE LAST RECORD (IT
'                           MAY BE LESS THAN OR EQUAL TO 128).
'
'  PURPOSE -- Open a sequential file as file #2 and read it randomly
'
     SUB OPENRSEQ (FILNAME$,NUM.RECS,LEN.LAST.REC,REC.LEN) STATIC
     ON ERROR GOTO 65000
     CLOSE 2
1480 EC = 0
1481 IF SHARE.IT THEN _
        OPEN FILNAME$ FOR RANDOM SHARED AS #2 LEN=REC.LEN _
     ELSE OPEN "R",2,FILNAME$,REC.LEN
     IF EC = 52 THEN _
        GOTO 1480
     FIELD #2, REC.LEN AS DOWNLOAD.RECORD$
     I# = LOF(2)
     NUM.RECS = FIX(I#/REC.LEN)
     LEN.LAST.REC = I# - CDBL(NUM.RECS) * REC.LEN
     IF LEN.LAST.REC > 0 THEN _
        NUM.RECS = NUM.RECS + 1 _
     ELSE LEN.LAST.REC = REC.LEN
     END SUB
9398 ' $SUBTITLE: 'OPENUSER - subroutine to open users file as #5'
' $PAGE
'
'  NAME    -- OPENUSER
'
'  INPUTS  --     PARAMETER                    MEANING
'                 SHARE.IT
'
'  OUTPUTS -- ACTIVE.USER.FILE$
'             CITY.STATE$
'             ELAPSED.TIME$
'             LAST.DATE.TIME.ON$
'             LAST.REC            # OF LAST RECORD IN USERS FILE
'             LIST.NEW.DATE$
'             PASSWORD$
'             SECURITY.LEVEL$
'             USER.DOWNLOADS$
'             USER.NAME$
'             USER.OPTIONS$
'             USER.RECORD$
'             USER.UPLOADS$
'
'  PURPOSE -- Open the user file as file #5
'
      SUB OPENUSER (LAST.REC) STATIC
      ON ERROR GOTO 65000
'
' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****
'
9400 CLOSE 5
     IF SHARE.IT THEN _
        OPEN ACTIVE.USER.FILE$ FOR RANDOM SHARED AS #5 LEN=128 _
     ELSE OPEN "R",5,ACTIVE.USER.FILE$,128
     I# = LOF(5)
     LAST.REC = FIX(I#/128)
     FIELD 5,31 AS USER.NAME$, _
             15 AS PASSWORD$, _
              2 AS SECURITY.LEVEL$, _
             14 AS USER.OPTIONS$,  _
             24 AS CITY.STATE$, _
              3 AS MACHINE.TYPE$, _
              4 AS TODAY.DL$, _
              4 AS TODAY.BYTES$, _
              4 AS DL.BYTES$, _
              4 AS UL.BYTES$, _
             14 AS LAST.DATE.TIME.ON$, _
              3 AS LIST.NEW.DATE$, _
              2 AS USER.DOWNLOADS$, _
              2 AS USER.UPLOADS$, _
              2 AS ELAPSED.TIME$
     FIELD 5,128 AS USER.RECORD$
     END SUB
12598 ' $SUBTITLE: 'FINDUSER - subroutine to search users file for a name'
' $PAGE
'
'  NAME    -- FINDUSER
'
'  INPUTS  --     PARAMETER                    MEANING
'             HASH.TO.LOOK.FOR$    STRING TO SEARCH FOR IN USERS
'             INDIV.TO.LOOK.FOR$   STRING TO USE TO INDIVIDUATE
'                                  USERS WITH SAME HASH
'             START.HASH.POS       WHERE HASH FIELD STARTS IN THE
'                                  "USERS" FILE
'             LEN.HASH.FIELD       LENGTH OF THE HASH FIELD
'             START.INDIV.POS      WHERE THE FIELD TO DISTINGUISH
'                                  AMONG USERS (I.E. WITH THE SAME
'                                  NAME) STARTS IN THE "USERS" FILE
'                                  (SET TO 0 IF NONE TO BE USED)
'             LEN.INDIV.FIELD      LENGTH OF FIELD TO DISTINGUISH
'                                  AMONG USERS
'             MAX.POSITION         HIGHEST RECORD TO SEARCH OR USE
'
'  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
'
'  OUTPUTS -- WHETHER.FOUND        SET TO "TRUE" IF USER WAS FOUND
'                                  OTHERWISE IT IS "FALSE"
'             POS.TO.USE           NUMBER OF THE "USERS" RECORD THAT
'                                  BELONGS TO THE USER (IF FOUND) OR
'                                  TO USE FOR THE USER (IF THE USER
'                                  WASN'T FOUND)
'             POS.TO.RECLAIM       SET TO 0 IF THE RECORD NUMBER
'                                  SELECTED FOR THIS USER HAS NEVER
'                                  BEEN USED.
'
'  PURPOSE -- To search the "USERS" file and determine the record
'             number to use for the caller in the "USERS" file.
'
      SUB FINDUSER (HASH.TO.LOOK.FOR$,INDIV.TO.LOOK.FOR$,START.HASH.POS,_
                    LEN.HASH.FIELD,START.INDIV.POS,LEN.INDIV.FIELD,_
                    MAX.POSITION,WHETHER.FOUND,_
                    POS.TO.USE,POS.TO.RECLAIM) STATIC
      ON ERROR GOTO 65000
      EC = 0
      WHETHER.FOUND = 0
      IF HASH.TO.LOOK.FOR$ = SPACE$(LEN(HASH.TO.LOOK.FOR$)) THEN _
         EXIT SUB
      EMPTY.REC$ = SPACE$(LEN.HASH.FIELD)
      EMPTY.INDIV$ = SPACE$(LEN.INDIV.FIELD)
      NEWUSER$ = LEFT$("NEWUSER  ",LEN.HASH.FIELD + 2)
      FIELD 5, 128 AS FILLER$
      X$ = HASH.TO.LOOK.FOR$ + SPACE$(LEN.HASH.FIELD - LEN(HASH.TO.LOOK.FOR$))
      CALL HASHRBBS (HASH.TO.LOOK.FOR$,MAX.POSITION,POS.TO.USE,DF)
12600 Y$ = INDIV.TO.LOOK.FOR$ + SPACE$(LEN.INDIV.FIELD - LEN(INDIV.TO.LOOK.FOR$))
      POS.TO.RECLAIM = 0
12610 GET 5,POS.TO.USE
      IF EC > 0 THEN _
         IF EC = 63 THEN _
            EC = 0 : _
            GOTO 12621 _
         ELSE EC = 0 : _
         GOTO 12620
      HASH.VALUE$ = MID$(FILLER$,START.HASH.POS,LEN.HASH.FIELD)
      IF X$ = HASH.VALUE$ THEN _
         IF START.INDIV.POS < 1 THEN _
           WHETHER.FOUND = TRUE : _
           GOTO 12622 _
         ELSE INDIV.VALUE$ = MID$(FILLER$,START.INDIV.POS,LEN.INDIV.FIELD) : _
              IF Y$ = INDIV.VALUE$ OR INDIV.VALUE$ = EMPTY.INDIV$ THEN _
                 WHETHER.FOUND = TRUE : _
                 GOTO 12622
      IF HASH.VALUE$ = EMPTY.REC$ THEN _
         POS.TO.USE = POS.TO.RECLAIM - (POS.TO.RECLAIM = 0) * POS.TO.USE : _
         WHETHER.FOUND = FALSE : _
         GOTO 12622
      IF ASC(HASH.VALUE$) = 0 OR INSTR(HASH.VALUE$,NEWUSER$) = 1 THEN _
         IF POS.TO.RECLAIM = 0 THEN _
            POS.TO.RECLAIM = POS.TO.USE
12620 POS.TO.USE = POS.TO.USE + DF
      IF POS.TO.USE > MAX.POSITION - 1 THEN _
         POS.TO.USE = POS.TO.USE - MAX.POSITION
      GOTO 12610
12621 IF POS.TO.RECLAIM = 0 THEN _
         POS.TO.RECLAIM = POS.TO.USE
      GOTO 12620
12622 END SUB
13661 ' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
' $PAGE
'
'  NAME    -- UPDTCALR
'
'  INPUTS  --     PARAMETER                    MEANING
'            ERRMES$                   MESSAGE TO GO IN CALLER LOG
'            EXT.LOG              = 1  CHECK FOR EXTENDED LOGGING
'                                      BEFORE UPDATING.
'                                 = 2  UPDATE CALLER LOG WITH Z$
'
'  OUTPUTS -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
'             TIM$                    CURRENT TIME (I.E. 1:13 PM)
'             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
'
'  PURPOSE -- To update the caller's file and/or print on the
'             local printer if it is enabled
'
      SUB UPDTCALR (ERRMES$,EXT.LOG) STATIC
      ON ERROR GOTO 65000
      IF CALLERS.FILE.PREFIX$ = "" OR (LOCAL.USER AND SYSOP) THEN _
         EXIT SUB
      X$ = "     " + ERRMES$
13663 EC = 0
      FIELD 4, 64 AS CALLERS.RECORD$
      IF EC > 0 THEN _
         CALL QTPUT1 ("Caller's file:  error"+STR$(EC)) : _
         EC = 0 : _
         EXIT SUB
      ON EXT.LOG GOTO 13665,13670
'
' ****  EXTENDED LOGGING ENTRY  ***
'
13665 IF NOT EXTENDED.LOGGING THEN _
         EXIT SUB
      CALL AMORPM                                                    ' KG061203
      X$ = X$ + " at " + TIM$
'
' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****
'
13670 LSET CALLERS.RECORD$ = X$
      CALL PRINTIT (CALLERS.RECORD$)
      IF LOCAL.USER AND PRINTER THEN _
         EXIT SUB
      CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
13672 PUT 4,CALLERS.FILE.INDEX!
      END SUB
13673 ' $SUBTITLE: 'PRINTIT - subroutine to print on the local printer'
' $PAGE
'
'  NAME    -- PRINTIT
'
'  INPUTS  --     PARAMETER                    MEANING
'                 STRNG$             STRING TO WRITE TO THE PRINTER
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To write to the printer attached to the pc running
'             RBBS-PC and toggle the printer switch off whenever
'             the printer is/becomes unavailable
'
      SUB PRINTIT (STRNG$) STATIC
      ON ERROR GOTO 65000
13674 IF PRINTER THEN _
         LPRINT STRNG$
      END SUB
20101 ' $SUBTITLE: 'CHANGEDIR - subroutine to change subdirectories'
' $PAGE
'
'  NAME    -- CHANGEDIR
'
'  INPUTS  -- PARAMETER                    MEANING
'             DIRECTORY$              NAME OF SUBDIRECTORY
'
'  OUTPUTS -- OK                      TRUE IF CHDIR SUCCESSFUL
'             EC                      ERROR CODE
'
'  PURPOSE -- Change subdirectory
'
      SUB CHANGEDIR (DIRECTORY$) STATIC
      ON ERROR GOTO 65000
      EC = 0
      OK = TRUE
20103 CHDIR DIRECTORY$
      END SUB
20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
' $PAGE
'
'  NAME    -- FINDITX
'
'  INPUTS  -- PARAMETER                    MEANING
'             FILNAME$                NAME OF FILE TO FIND
'             FILNUM                  # TO OPEN FILE AS              ' KG061001
'
'  OUTPUTS -- OK                      TRUE IF FILE EXISTS
'             EC                      ERROR CODE
'
'  PURPOSE -- Determine whether a file exists
'
      SUB FINDITX (FILNAME$,FILNUM) STATIC                           ' KG061001
      ON ERROR GOTO 65000
      EC = 0
      OK = FALSE
      IF LEN(FILNAME$) < 1 THEN _
         EXIT SUB
      IF TURBO.RBBS THEN _
         CALL FINDFILE (FILNAME$,OK) : _
         IF OK THEN _
            GOTO 20222 _
         ELSE EXIT SUB
20221 CALL BADFILECHAR (FILNAME$,OK)
      IF NOT OK THEN _
         EXIT SUB
      OK = FALSE
      NAME FILNAME$ AS FILNAME$
      IF EC = 53 THEN _
         EXIT SUB
20222 CLOSE FILNUM                                                   ' KG061001
20223 CALL OPENWORK (FILNUM,FILNAME$)                                ' KG061001
      IF EC = 64 OR EC = 76 THEN _
         EXIT SUB
      OK = TRUE
      END SUB
20308 ' $SUBTITLE: 'FLUSHCOM -- subroutine reads all char. from  comm. port'
' $PAGE
'
'  NAME -- FLUSHCOM
'
'  INPUTS --   PARAMETER     MEANING
'              STNG$       STRING TO READ CHARACTERS INTO FROM
'                          THE COMMUNICATIONS PORT (FILE #3)
'
'  OUTPUTS --   STNG$
'
'  PURPOSE -- Reads all characters from the communications port.
'
      SUB FLUSHCOM (STRNG$) STATIC
      ON ERROR GOTO 65000
      IF LOCAL.USER THEN _
         EXIT SUB
      STRNG$ = ""
      IF NOT FOSSIL THEN _
         GOTO 20311
20310 CALL FOSREADAHEAD(COMPORT%,CHAR%)
      IF CHAR% <> -1 THEN _
         CALL FOSRXCHAR(COMPORT%,CHAR%) : _
         STRNG$ = STRNG$ + CHR$(CHAR%) : _
         GOTO 20310
      EXIT SUB
20311 STRNG$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
20312 IF EC = 57 THEN _
         LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
         EC = 0 : _
         GOTO 20311
      END SUB
20898 ' $SUBTITLE: 'NETBIOS - subroutine to lock/unlock using NETBIOS'
' $PAGE
'
'  NAME    -- NETBIOS   (WRITTEN BY DOUG AZZARITO)
'
'  INPUTS  -- IBM.LOCK.CMD       = 1-LOCK, 0-UNLOCK
'             IBM.FILE.LOCK      = 5 USERS FILE
'                                = 6 SEMAPHORE FILE
'             IBM.RECORD.LOCK    = RECORD NUMBER TO LOCK
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- Lock and unlock files using NETBIOS commands.
'             If lock fails, this routine tries forever.
'
      SUB NETBIOS (IBM.LOCK.CMD,IBM.FILE.LOCK,IBM.RECORD.LOCK) STATIC
      STATIC IBMCOUNT
      ON ERROR GOTO 65000
29900 ON IBM.LOCK.CMD + 1 GOTO 29920, 29910
      EXIT SUB
'
' *****  LOCK LOOP   ****
'
29910 EC = 0
      IF IBM.FILE.LOCK = 6 AND IBM.RECORD.LOCK = 3 THEN _
         IBMCOUNT = IBMCOUNT + 1 : _
         IF IBMCOUNT > 1 THEN _
            EXIT SUB
      LOCK IBM.FILE.LOCK, IBM.RECORD.LOCK TO IBM.RECORD.LOCK
      IF EC <> 0 THEN _
         GOTO 29910
      EXIT SUB
29920 EC = 0
      IF IBM.FILE.LOCK = 6 AND IBM.RECORD.LOCK = 3 THEN _
         IBMCOUNT = IBMCOUNT - 1 : _
         IF IBMCOUNT > 0 THEN _
            EXIT SUB _
         ELSE IBMCOUNT = 0
      UNLOCK IBM.FILE.LOCK, IBM.RECORD.LOCK TO IBM.RECORD.LOCK
      IF EC <> 0 THEN _
         GOTO 29920
      END SUB
43048 ' $SUBTITLE: 'UPDATEC - update of callers log on exiting'
' $PAGE
'
'  NAME    -- UPDATEC
'
'  INPUTS  --     PARAMETER                    MEANING
'             CALLERS.FILE.INDEX!
'             FIRST.NAME$
'             HHH
'             LAST.NAME$
'             MMM
'             NG$
'             SSS
'             SYSOP.FIRST.NAME$
'             SYSOP.LAST.NAME$
'
'  OUTPUTS -- CALLERS.RECORD$
'             CALLERS.FILE.INDEX!
'             SYSOP
'
'  PURPOSE -- Update the callers file at logoff so that the number
'             of hours, minutes, and seconds for the session are
'             recorded as the last 9 characters of the 64-character
'             callers file record
'
      SUB UPDATEC STATIC
      ON ERROR GOTO 65000
      IF CALLERS.FILE.PREFIX$ = "" THEN _
         EXIT SUB
'
' ****  UPDATE CALLERS FILE AT LOGOFF  ***
'
43050 FIELD 4,55 AS CALLERS.RECORD$,3 AS HOURS$,3 AS MINUTES$,3 AS SECONDS$
      LSET CALLERS.RECORD$ = MID$(NG$,65,55)
      LSET HOURS$ = STR$(HHH)
      LSET MINUTES$ = STR$(MMM)
      LSET SECONDS$ = STR$(SSS)
      CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
      PUT 4,CALLERS.FILE.INDEX!
      FIELD 4,64 AS CALLERS.RECORD$
      LSET CALLERS.RECORD$ = LEFT$(NG$,64)
      CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
      PUT 4,CALLERS.FILE.INDEX!
43060 LSET CALLERS.RECORD$ = STRING$(64,CHR$(0))
      CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
      PUT 4,CALLERS.FILE.INDEX!
      CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
      PUT 4,CALLERS.FILE.INDEX!
      IF ORIG.CALLERS$ <> CALLERS.FILE$ THEN _
         CALLERS.FILE$ = ORIG.CALLERS$ : _
         CALL SETCALL : _
         GOTO 43050
      END SUB
51098 ' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
' $PAGE
'
'  NAME    -- FINDFREE
'
'  INPUTS  --     PARAMETER                    MEANING
'                 Z$                        NAME OF FILE TO FIND
'
'  OUTPUTS -- FREE.SPACE$               NUMBER OF BYTES FREE
'
'  PURPOSE -- To determine amount of free space on a device
'
      SUB FINDFREE STATIC
      ON ERROR GOTO 65000
      EC = 0
52000 IF TURBO.RBBS THEN _
         GOTO 52003
      FREE.SPACE$ = ""
      CLS
      EC = 0
52001 FILES Z$
      IF EC = 53 AND (Z$ = COMMENTS.FILE$ OR Z$ = UPLOAD.DRIVE.FILE$ ) THEN _
         CALL OPENOUTW (Z$) : _
         GOTO 52000
      IF EC = 53 AND Z$ = UPLOAD.DIRECTORY$ THEN _
         A$ = "Upload directory missing.  Tell SYSOP" : _
         SUBROUTINE.PARAMETER = 6 : _
         CALL TPUT : _
         GOTO 52002
      FOR X = 1 TO 25
         FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
      NEXT
52002 SUBROUTINE.PARAMETER = 1
      CALL LINE25
      EXIT SUB
52003 AX% = 0
      BX% = 0
      CX% = 0
      DX% = 0
      IF MID$(Z$,2,1) = ":" THEN _
         AX% = ASC(Z$) - ASC("A") + 1
      CALL RBBSFREE (AX%,BX%,CX%,DX%)
      I# = CDBL(AX%) * (BX% + 65536! * (-(BX% < 0)))                 ' DA050204
      I# = I# * CX%
      FREE.SPACE$ = STR$(I#) + _
                    " bytes free"
      END SUB
57978 ' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
' $PAGE
'
'  NAME   -- OPENWORK
'
'  INPUTS --     PARAMETER                    MEANING
'                FILNUM                    # OF FILE TO OPEN AS
'                FILNAME$                  NAME OF FILE TO FIND
'                SHARE.IT                  USE DOS' "SHARE" FACILITIES
'
'  OUTPUTS -- EC                        ERROR CODE
'
'  PURPOSE -- To open RBBS-PC's "work" file (number 2)
'
      SUB OPENWORK (FILNUM,FILNAME$) STATIC
      ON ERROR GOTO 65000
58000 CLOSE FILNUM
58010 EC = 0
58020 IF SHARE.IT THEN _
         OPEN FILNAME$ FOR INPUT SHARED AS #FILNUM _
      ELSE OPEN "I",FILNUM,FILNAME$
      IF EC = 52 THEN _
         GOTO 58010
58030 END SUB
58190 ' $SUBTITLE: 'OPENFMS - subroutine to open the FMS directory'
' $PAGE
'
'  NAME    -- OPENFMS
'
'  INPUTS  -- PARAMETER                      MEANING
'             SHARE.IT                DOS SHARING FLAG
'             FMS.DIRECTORY$        NAME OF FMS DIRECTORY
'
'  OUTPUTS -- LAST.REC                NUMBER OF THE LAST
'                                     RECORD IN THE FILE
'
'  PURPOSE -- To open the upload directory as a random file and find
'             the number of the last record in the file.
'
      SUB OPENFMS (LAST.REC) STATIC
      ON ERROR GOTO 65000
      FILE.LENGTH = 38 + MAX.DESC.LEN
      CLOSE 2
      IF ACTIVE.FMS.DIRECTORY$ = "" THEN _
         IF MENU.INDEX = 6 THEN _
            ACTIVE.FMS.DIRECTORY$ = LIBRARY.DIRECTORY$ _
         ELSE ACTIVE.FMS.DIRECTORY$ = FMS.DIRECTORY$
      IF SHARE.IT THEN _
         OPEN ACTIVE.FMS.DIRECTORY$ FOR RANDOM SHARED AS #2 LEN=FILE.LENGTH _
      ELSE OPEN "R",2,ACTIVE.FMS.DIRECTORY$,FILE.LENGTH
      IF EC > 0 THEN _
         CALL QTPUT1 ("Drive/path does not exist or bad name for FMS dir " + _
                     ACTIVE.FMS.DIRECTORY$) : _
         END
      LAST.REC = LOF(2)/FILE.LENGTH
      IF ACTIVE.FMS.DIRECTORY$ = PREV.FMS$ THEN _
         EXIT SUB
      PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
      FIELD 2, FILE.LENGTH AS FMS.REC$
      GET #2,1
      A = (LEFT$(FMS.REC$,4) <> "\FMS")
      UPINC = 2*(INSTR(FMS.REC$," TOP ") = 0 OR A) + 1
      DATE.ORDERED.FMS = A OR (INSTR(FMS.REC$," NOSORT") = 0)
      DF = INSTR(FMS.REC$,"CH(")
      CHAINED.DIR$ = ""
      IF DF > 0 AND (NOT A) THEN _
         X = INSTR(DF,FMS.REC$,")") : _
         IF X > 0 THEN _
            CHAINED.DIR$ = MID$(FMS.REC$,DF+3,X-DF-3) : _
            CALL FINDFILE (CHAINED.DIR$,OK) : _
            IF NOT OK THEN _
               CHAINED.DIR$ = ""
      END SUB
58220 ' $SUBTITLE: 'OPENOUTW - sub to open output work file (2)'
' $PAGE
'
'  NAME    -- OPENOUTW
'
'  INPUTS  --     PARAMETER                 MEANING
'                 FILE.NAME$            NAME OF FILE TO FIND
'                 SHARE.IT              USE DOS' "SHARE" FACILITIES
'
'  OUTPUTS -- EC                        ERROR CODE
'
'  PURPOSE -- To open RBBS-PC's "work" file (number 2) for output
'
      SUB OPENOUTW (FILNAME$) STATIC
      ON ERROR GOTO 65000
      CLOSE 2
58225 EC = 0
58230 IF SHARE.IT THEN _
         OPEN FILNAME$ FOR OUTPUT SHARED AS #2 _
      ELSE OPEN "O",2,FILNAME$
58235 END SUB
58260 ' $SUBTITLE: 'KILLWORK - subroutine to delete a "work" file'
' $PAGE
'
'  NAME    -- KILLWORK
'
'  INPUTS  --     PARAMETER                    MEANING
'                 FILNAME$                  NAME OF FILE TO DELETE
'
'  OUTPUTS -- EC                        ERROR CODE
'
'  SUBROUTINE PURPOSE -- To delete a RBBS-PC "work" file
'
      SUB KILLWORK (FILNAME$) STATIC
      ON ERROR GOTO 65000
      CLOSE 2
      EC = 0
58270 KILL FILNAME$
58275 END SUB
58280 ' $SUBTITLE: 'GETPASWD - sub to read the "passwords" file'
' $PAGE
'
'  NAME    -- GETPASWD
'
'                          PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'
'  OUTPUTS -- TEMP.PASSWORD$
'             TEMP.SECURITY.LEVEL
'             TEMP.TIME.ALLOWED
'             TEMP.REG.PERIOD
'             TEMP.MAX.PER.DAY
'
'  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
'
      SUB GETPASWD STATIC
      ON ERROR GOTO 65000
      EC = 0
      INPUT #2,TEMP.PASSWORD$,     TEMP.SECURITY.LEVEL, _
               TEMP.TIME.ALLOWED,  TEMP.MAX.PER.DAY, _
               TEMP.REG.PERIOD,    START.TIME, _
               END.TIME,           BYTE.METHOD, _
               RATIO.RESTRICTION#, INITIAL.CREDIT#, _
               TEMP.TIME.LOCK
58285 END SUB
58290 ' $SUBTITLE: 'READDIR - subroutine to read the "DIR" files'
' $PAGE
'
'  NAME    -- READDIR
'
'                          PARAMETER             MEANING
'  INPUTS  -- FILNUM                  WHICH # FILE TO READ
'             WHICH.LINE              HOW MANY LINES TO ADVANCE
'
'  OUTPUTS -- A$
'
'  PURPOSE -- To read possible "DIR" files
'
      SUB READDIR (FILNUM,WHICH.LINE) STATIC
      ON ERROR GOTO 65000
      EC = 0
      FOR I = 1 TO WHICH.LINE
         LINE INPUT #FILNUM,A$
      NEXT
58295 END SUB
58300 ' $SUBTITLE: 'READPARMS - subroutine to read parameter values'
' $PAGE
'
'  NAME    -- READPARMS
'
'               PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'             NUM.PARMS               # parameters to read
'             WHICH.LINE              Which set of parms to return
'  OUTPUTS -- ARA.TO.USER$            Array of string values
'             FILE.SECURITY
'             FILE.PASSWORD$
'
'  PURPOSE -- To read different values, where values are
'             separated by a comma or carriage-return-line-feed.
'
      SUB READPARMS (ARA.TO.USE$(1),NUM.PARMS,WHICH.LINE) STATIC
      ON ERROR GOTO 65000
      EC = 0
      FOR J = 1 TO WHICH.LINE
         FOR I = 1 TO NUM.PARMS
            INPUT #2,ARA.TO.USE$(I)
         NEXT
      NEXT
58305 END SUB
58310 ' $SUBTITLE: 'READANY - subroutine to read file 2 into A$'
' $PAGE
'
'  NAME    -- READANY
'
'               PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'
'  OUTPUTS -- A$
'
'  PURPOSE -- To read file #2 into A$
'
      SUB READANY STATIC
      ON ERROR GOTO 65000
      EC = 0
      INPUT #2,A$
58315 END SUB
58320 ' $SUBTITLE: 'PRINTWRK - subroutine to print to file 2'
' $PAGE
'
'  NAME    -- PRINTWRK
'
'               PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'             STRING TO WRITE OUT
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To print a string to file #2
'
      SUB PRINTWRK (STRNG$) STATIC
      ON ERROR GOTO 65000
      EC = 0
      PRINT #2,STRNG$;
58325 END SUB
58330 ' $SUBTITLE: 'GETWORK - subroutine to read file 2'
' $PAGE
'
'  NAME    -- GETWORK
'
'               PARAMETER             MEANING
'  INPUTS  -- REC.LEN            Length of record
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To read a record from file #2
'
      SUB GETWORK (REC.LEN) STATIC
      ON ERROR GOTO 65000
      EC = 0
      FIELD 2, REC.LEN AS DOWNLOAD.RECORD$
      GET 2,(LOC(2)+1)
58335 END SUB
58340 ' $SUBTITLE: 'OPENWRKA - subroutine to open output work file (2)'
' $PAGE
'
'  NAME    -- OPENWRKA
'
'  INPUTS  --     PARAMETER                    MEANING
'              FILNAME$                  NAME OF FILE TO FIND
'              SHARE.IT                  USE DOS' "SHARE" FACILITIES
'
'  OUTPUTS -- EC                        ERROR CODE
'
'  PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
'
      SUB OPENWRKA (FILNAME$) STATIC
      ON ERROR GOTO 65000
      CLOSE 2
      EC = 0
      IF SHARE.IT THEN _
         OPEN FILNAME$ FOR APPEND SHARED AS #2 _
      ELSE OPEN "A",2,FILNAME$
58345 END SUB
58350 ' $SUBTITLE: 'PRNTWRKA - subroutine to print to file 2 with CR'
' $PAGE
'
'  NAME    -- PRNTWRKA
'
'                          PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'                        STRING TO WRITE OUT
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To print a string to file #2 followed by a carriage return
'
      SUB PRNTWRKA (STRNG$) STATIC
      ON ERROR GOTO 65000
      EC = 0
      PRINT #2,STRNG$
58355 END SUB
58360 ' $SUBTITLE: 'CHECKINT - subroutine to check input is an integer'
' $PAGE
'
'  NAME    -- CHECKINT
'
'             PARAMETER             MEANING
'  INPUTS  -- STRNG$         STRING TO VERIFY CAN BE AN INTEGER
'
'  OUTPUTS -- EC             = 0 MEANS IT IS AN INTEGER VALUE
'                           <> 0 MEANS IT IS NOT AN INTEGER VALUE
'
'  PURPOSE -- To validate that a string represents an integer
'
      SUB CHECKINT (STRNG$) STATIC
      ON ERROR GOTO 65000
      EC = 0
      TESTED.INTEGER.VALUE = VAL(STRNG$)
58365 END SUB
59650 ' $SUBTITLE: 'PUTCOM -- subroutine to write to communications port'
' $PAGE
'
'  NAME    --  PUTCOM
'
'  INPUTS  --   PARAMETER     MEANING
'                STNG$       STRING TO PRINT TO COMM PORT
'              FLOW.CONTROL  WHETHER USING CLEAR TO SEND FOR FLOW
'                            CONTROL BETWEEN THE PC AND THE MODEM
'
'  OUTPUTS --
'
'  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
'             before writing to the communications port.
'
      SUB PUTCOM (STRNG$) STATIC
      ON ERROR GOTO 65000
      IF LOCAL.USER THEN _
         EXIT SUB
      CALL CHKCARRIER                                                ' KG061203
      IF SUBROUTINE.PARAMETER = -1 THEN _
         EXIT SUB
      IF NOT XOFF.ED THEN _
         GOTO 59652
      SUBROUTINE.PARAMETER = 1
      CALL LINE25
      Y$ = XOFF$
      CALL SETABORT (X!,WAIT.BEFORE.DISCONNECT)
      WHILE Y$ = XOFF$ AND SUBROUTINE.PARAMETER <> -1
         CHAR% = -1
         WHILE CHAR% = -1 AND SUBROUTINE.PARAMETER <> -1
            GOSUB 59654
         WEND
         IF CHAR% <> -1 THEN _
            CALL GETCOM(Y$) : _
            IF XON.XOFF AND Y$ <> XON$ THEN _
               Y$ = XOFF$
      WEND
      XOFF.ED = FALSE
      SUBROUTINE.PARAMETER = 1
      CALL LINE25
59652 NOT.CTS = FALSE
      IF NOT FOSSIL THEN _
         PRINT #3,STRNG$; : _
         EXIT SUB
      IF STRNG$ = "" THEN _
         EXIT SUB
      FOR N = 1 TO LEN(STRNG$)
          CHAR% = ASC(MID$(STRNG$,N,1))
59653     CALL FOSTXCHARNW(COMPORT%,CHAR%,RESULT%)
          IF RESULT% = 0 THEN _
             GOTO 59653
      NEXT
      EXIT SUB
59654 CALL EOFCOMM (CHAR%)
      CALL GOIDLE
      CALL CHKCARRIER                                                ' KG061203
      CALL CHKTREMAIN (X!)
      RETURN
      END SUB
59660 ' $SUBTITLE: 'PUTWORK -- subroutine to write to upload files'
' $PAGE
'
'  NAME    -- PUTWORK
'
'  INPUTS  --   PARAMETER     MEANING
'                STNG$       STRING TO WRITE TO FILE
'                REC.NUM     RECORD NUMBER TO WRITE
'                REC.LEN     LENGTH OF RECORD TO WRITE
'
'  OUTPUTS --
'
'  PURPOSE -- Writes uploaded file records to work file
'
      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
59680 ' $SUBTITLE: 'RBBSPLAY -- subroutine to play music'
' $PAGE
'
'  NAME    -- RBBSPLAY
'
'  INPUTS  --   PARAMETER     MEANING
'                          STRNG$      STRING TO PLAY
'
'  OUTPUTS --
'
'  PURPOSE -- Play music.  Skip if get an error.
'
      SUB RBBSPLAY (STRNG.TO.PLAY$) STATIC
      PLAY STRNG.TO.PLAY$
      EC = 0
      END SUB
59700 ' $SUBTITLE: 'TALK -- subroutine for voice response'
' $PAGE
'
'  NAME    -- TALK
'
'  INPUTS  --   PARAMETER     MEANING
'               VOICE.TYPE    TYPE OF VOICE SYNTHESIZER
'               VOICE.RECORD  RECORD NUMBER TO RETRIEVE
'
'  OUTPUTS --
'
'  PURPOSE -- Retrieve voice record and send to voice synthesizer
'
      SUB TALK (VOICE.RECORD,STRNG.WRK$) STATIC
      IF VOICE.TYPE = 0 THEN _
         EXIT SUB
      IF VOICE.RECORD > 0 THEN _
         GOTO 59720
      CLOSE 7,8
      IF VOICE.TYPE = 1 THEN _
         OPEN "COM2:2400,E,7,1,CS65535" AS #7 : _
         LPRINT "OPENED COM PORT"
      IF SHARE.IT THEN _
         OPEN "RBBSTALK.DEF" FOR RANDOM SHARED AS #8 LEN=32 _
      ELSE OPEN "R",8,"RBBSTALK.DEF",32
      FIELD 8,30 AS TALK.RECORD$,2 AS DUMMY$
      EXIT SUB
59720 IF NOT SNOOP THEN _
         EXIT SUB
      IF VOICE.RECORD < 65 THEN _
         GET 8,VOICE.RECORD : _
         STRNG.WRK$ = TALK.RECORD$ : _
         CALL TRIM (STRNG.WRK$)
59721 IF SMART.TEXT THEN _
         CALL SMARTTXT (STRNG.WRK$, CR.FOUND,FALSE)                  ' CS062802
59722 IF VOICE.TYPE = 1 THEN _
         PRINT #7,STRNG.WRK$
59723 IF VOICE.TYPE = 2 THEN _
         CALL RBBSHS (CHR$(LEN(STRNG.WRK$)+1)+STRNG.WRK$+CHR$(13))
      END SUB
59725 ' $SUBTITLE: 'COMMPUT -- Writes to communications port'
' $PAGE
'
'  NAME    -- COMMPUT
'
'  INPUTS  --   PARAMETER     MEANING
'               STRNG$        String to write
'               FOSSIL        Whether using Fossil driver
'
'  OUTPUTS --
'
'  PURPOSE -- Send string to comm port.  Recovers from errors.
'
      SUB COMMPUT (STRNG$) STATIC
      ON ERROR GOTO 65000
      IF FOSSIL THEN _
         STRNG$ = STRNG$ + CARRIAGE.RETURN$ : _
         BYTES% = LEN(STRNG$) : _
         CALL FOSWRITE(COMPORT%,BYTES%,STRNG$) _
      ELSE PRINT #3,STRNG$
      END SUB
'  $SUBTITLE: 'Error Handling for separately compiled subroutines'
'  $PAGE
'
'
' Error handling for the separately compiled subroutines of RBBS-PC
' 
'
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 <= 119 THEN _
          RESUME NEXT
'
'     OPEN COM PORT ERROR HANDLING
'
      IF ERL = 200 THEN _
         CLS : _
         CALL PSCRN (COM.PORT$ + " does not exist/not responding- Error" + STR$(ERR)) : _
         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 = 13672 AND ERR = 61 THEN _
          CALL QTPUT1 ("Disk Full") : _
          IF DISKFULL.GO.OFFLINE THEN _
             GOTO 65010 _
          ELSE RESUME NEXT
       IF ERL = 13672 THEN _
          CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! - 1 : _
          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
'
'     CHECKINT ERROR HANDLING
'
       IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
          NOT.CTS = TRUE : _
          CALL LINE25 : _
          EC = 0 : _
          RESUME
       IF ERL => 52000 AND ERL <= 59725 THEN _
          RESUME NEXT
'
'     CATCH ALL OTHER ERRORS
'
       A$ = "RBBS-SUB1 Untrapped Error" + _
            STR$(ERR) + _
            " in line" + _
            STR$(ERL)
       CALL QTPUT1 (A$)
       CALL UPDTCALR (A$,2)
       RESUME NEXT
'     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
65010  CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
       IF FOSSIL THEN _
          CALL FOSEXIT(COMPORT%)
       SYSTEM