' $LINESIZE:132
' $title: 'RBBS-SUB1.BAS CPC17-1D, Copyright 1986-89 by D. Thomas Mack'
'  Copyright 1987 by D. Thomas Mack, all rights reserved.
'  Name ...............: RBBSSUB1.BAS
'  Written by .........: D. Thomas Mack
'  First Released .....: September 18, 1988
'  Subsequent Releases.: OCT 30 1988
'  Copyright ..........: 1986, 1987, 1988
'  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  20103   Change subdirectory
'  CHECKINT   58360   Check input is valid integer
'  FINDFREE   52000   Find amount of space on the upload disk drive
'  FINDIT     20221   Find if a file exists on a device
'  FINDUSER   12610   Find a user in the USERS file
'  FLUSHCOM   20311   Read all characters in the communications port
'  GETCOM      1420   Read a character from the communications port
'  GETPASWD   58280   Read RBBS-PC's "PASSWORD" file
'  GETWRK     58330   Read record from file number 2
'  KILLWORK   58260   Delete a RBBS-PC "WORK" file
'  NETBIOS    29900   Lock/Unlock NETBIOS semaphore files
'  OPENCOM      200   Open communications port (number 3)
'  OPENFMS    58190   Open the upload management system directory
'  OPENOUTW   28220   Open RBBS-PC's "WORK" file (number 2) for output
'  OPENRSEQ    1479   Open a sequential file (number 2) for random I/O
'  OPENUSER    9400   Open the USER file (number 5)
'  OPENWORK   58000   Open RBBS-PC's work file (number 2)
'  OPENWRKA   58340   Open RBBS-PC's "WORK" file (number 2) for append
'  PRINTIT    13674   Print line on the local PC running RBBS-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
'  READANY    58310   Read file number 2 into A$
'  READDEF      117   Read configuration file
'  READDIR    58290   Read entire lines
'  READPARMS  58300   Read certain number of parameters from file 2
'  SETCALL      108   Find where next callers record is
'  UPDATEC    43050   Update the caller's file with elasped session time
'  UPDTCALR   13665   Update to the caller's file
'
'  $INCLUDE: 'RBBS-VAR.BAS'
'
' $SUBTITLE: 'SETCALL - subroutine to find last callers rec'
' $PAGE
'
'  SUBROUTINE NAME    -- SETCALL
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'
'  OUTPUT PARAMETERS  --  CALLERS.FILE.INDEX!
'
'  SUBROUTINE PURPOSE --  TO FIND WHERE TO LEAVE OFF ON CALLERS FILE
'
108 SUB SETCALL STATIC
    ON ERROR GOTO 65000
    IF PREV.CALLERS$ = CALLERS.FILE$ OR CALLERS.FILE.PREFIX$ = "" THEN _ 'KG102505
       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 _           ' KG102505
    ELSE OPEN "R",4,CALLERS.FILE$,64
    FIELD 4,64 AS CALLERS.RECORD$
    IF LOF(4) > 0 THEN _                                             ' KG102505
       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
'
' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
' $PAGE
'
'  SUBROUTINE NAME    -- READDEF
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                         CONFIG.FILENAME$            NAME OF RBBS-PC.DEF FILE
'                         SUBROUTINE.PARAMETER = -62  ONLY READ THE .DEF FILE
'
'  OUTPUT PARAMETERS  --  ALL THE RBBS-PC.DEF PARAMETERS
'
'  SUBROUTINE 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 (CONFIG.FILE$)                                     ' LP102201
    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, _
             ACTIVE.BULLETINS, _
             PROMPT.BELL, _
             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$, _                                                  ' KG120501
             MAIN.MESSAGE.FILE$, _                                   ' KG120501
             MAIN.MESSAGE.BACKUP$                                    ' KG120501
    INPUT #2, X$, _
              COMMENTS.FILE$, _
              MAIN.USER.FILE$, _
              WELCOME.FILE$, _
              NEWUSER.FILE$, _
              MAIN.DIRECTORY.EXTENTION$
    CALL BRKFNAME (X$,Y$,DF$,Z$,FALSE)                               ' KG102705
    IF DF$ <> "" THEN _                                              ' KG102705
       CALLERS.FILE$ = X$
    IF CONFERENCE.MODE THEN _
       INPUT #2, DF$ _
    ELSE INPUT #2, COM.PORT$
    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), _   ' GLOBAL 4
             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, _
              CALLBACK.VERIFICATION, _
              RESTRICT.VALID.CMDS, _
              NEW.USER.DEFAULT.MODE, _
              NEW.USER.LINE.FEEDS, _
              ARKVIEW.PATH$, _
              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$                                              ' KG110504
    IF CONFERENCE.MODE THEN _                                        ' KG110504
       INPUT #2, DF$,DF$,DF$ _                                       ' KG110504
    ELSE INPUT #2, DEFAULT.ECHOER$, _                                ' KG110504
                   HOST.ECHO.ON$, _                                  ' KG110504
                   HOST.ECHO.OFF$                                    ' KG110504
   INPUT #2,  SWITCH.BACK, _                  Pe11/07/88
              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$                                            ' KG101402
     IF CONFERENCE.MODE THEN _                                       ' KG101402
        INPUT #2,DF _                                                ' KG101402
     ELSE INPUT #2,FOSSIL                                            ' KG101402
     INPUT #2,MAX.CARRIER.WAIT, _                                    ' KG101402
              DF, _
              SMART.TEXT, _
              TIME.LOCK, _
              WRITE.BUF.DEF, _
              DF, _
              DF, _
              DF, _
              AUTOPAGE.DEF$
     IF EC > 0 THEN _
        EXIT SUB
     CONFIG.FILENAME$ = CONFIG.FILE$                                 ' KG121501
     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
200 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
' $SUBTITLE: 'GETCOM -- subroutine reads a char. from  comm. port'
' $PAGE
'
'  SUBROUTINE NAME    -- GETCOM
'
'  INPUT PARAMETERS   --   PARAMETER     MEANING
'                          STNG$       STRING TO READ A CHARACTER INTO FROM
'                                      THE COMMUNICATIONS PORT (FILE #3)
'
'  OUTPUT PARAMETERS  --   STNG$
'
'  SUBROUTINE PURPOSE -- READS A CHARACTER FROM 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
' $SUBTITLE: 'OPENRSEQ  - subroutine open sequential file randomly'
' $PAGE
'
'  SUBROUTINE NAME    -- OPENRSEQ
'
'  INPUT PARAMETERS   -- PARAMETER             MEANING
'                        FILNAME$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
'
'  OUTPUT PARAMETERS  -- 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).
'
'  SUBROUTINE PURPOSE -- SUBROUTINE TO OPEN A SEQUENTIAL FILE AS FILE # 2 AND
'                        READ IT RANDOMLY.
'
     SUB OPENRSEQ (FILNAME$,NUM.RECS,LEN.LAST.REC,REC.LEN) STATIC
1479 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
' $SUBTITLE: 'OPENUSER - subroutine to open the users file as #5'
' $PAGE
'
'  SUBROUTINE NAME    -- OPENUSER
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                        SHARE.IT
'
'  OUTPUT PARAMETERS  -- ACTIVE.USER.FILE$
'                        CITY.STATE$
'                        ELAPSED.TIME$
'                        LAST.DATE.TIME.ON$
'                        LAST.REC            # OF LAST RECORD IN USERS FILE
'                        LIST.NEW.DATE$
'                        MACHINE.TYPE$
'                        PASSWORD$
'                        SECURITY.LEVEL$
'                        USER.DOWNLOADS$
'                        USER.NAME$
'                        USER.OPTIONS$
'                        USER.RECORD$
'                        USER.UPLOADS$
'
'  SUBROUTINE 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
' $SUBTITLE: 'FINDUSER - subroutine to search users file for a name'
' $PAGE
'
'  SUBROUTINE NAME    -- FINDUSER
'
'  INPUT PARAMETERS   --     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.
'
'  OUTPUT PARAMETERS  -- 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.
'
'  SUBROUTINE 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 = O : _
            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
' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
' $PAGE
'
'  SUBROUTINE NAME    -- UPDTCALR
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                        ERRMES$                   MESSAGE TO GO IN CALLER LOG
'                        EXT.LOG              = 1  CHECK FOR EXTENDED LOGGING
'                                                  BEFORE UPDATING.
'                                             = 2  UPDATE CALLER LOG WITH Z$
'
'  OUTPUT PARAMETERS  -- 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)
'
'  SUBROUTINE 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 _   'KG121802
         EXIT SUB
      X$ = "     " + ERRMES$
13663 EC = 0
      FIELD 4, 64 AS CALLERS.RECORD$
      IF EC > 0 THEN _
         CALL QTPUT ("Caller's file:  error"+STR$(EC),1) : _
         EC = 0 : _
         EXIT SUB
      ON EXT.LOG GOTO 13665,13670
'
' ****  EXTENDED LOGGING ENTRY  ****
'
13665 IF NOT EXTENDED.LOGGING THEN _
         EXIT SUB
      SUBROUTINE.PARAMETER = 2
      CALL AMORPM
      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!                        'KG102502
      END SUB
' $SUBTITLE: 'PRINTIT - subroutine to print on the local PC's printer'
' $PAGE
'
'  SUBROUTINE NAME    -- PRINTIT
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                             STRNG$             STRING TO WRITE TO THE PRINTER
'
'  OUTPUT PARAMETERS  -- NONE
'
'  SUBROUTINE PURPOSE -- TO WRITE TO THE PRINTER ATTACHED TO THE PC RUNNING
'                        RBBS-PC AND TOGGLE THE PRINTER SWTICH OFF WHENEVER
'                        THE PRINTER IS/BECOMES UNAVAILABLE
'
      SUB PRINTIT (STRNG$) STATIC
      ON ERROR GOTO 65000
13674 IF PRINTER THEN _
         LPRINT STRNG$
      END SUB
' $SUBTITLE: 'CHANGEDIR - subroutine to change subdirectories'
' $PAGE
'
'  SUBROUTINE NAME    -- CHANGEDIR
'
'  INPUT PARAMETERS   -- PARAMETER                    MEANING
'                        DIRECTORY$              NAME OF SUBDIRECTORY
'
'  OUTPUT PARAMETERS  -- OK                      TRUE IF CHDIR SUCCESSFUL
'                        EC                      ERROR CODE
'
'  SUBROUTINE PURPOSE -- CHANGE SUBDIRECTORY
'
      SUB CHANGEDIR (DIRECTORY$) STATIC
      ON ERROR GOTO 65000
      EC = 0
      OK = TRUE
20103 CHDIR DIRECTORY$
      END SUB
' $SUBTITLE: 'FINDIT - subroutine to find if a file exists'
' $PAGE
'
'  SUBROUTINE NAME    -- FINDIT
'
'  INPUT PARAMETERS   -- PARAMETER                    MEANING
'                        FILNAME$                NAME OF FILE TO FIND
'
'  OUTPUT PARAMETERS  -- OK                      TRUE IF FILE EXISTS
'                        EC                      ERROR CODE
'
'  SUBROUTINE PURPOSE -- DETERMINE IF A FILE EXISTS BY RENAMING IT TO ITSELF
'
      SUB FINDIT (FILNAME$) STATIC
      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 2
20223 CALL OPENWORK (FILNAME$)                                       ' KG102207
      IF EC = 64 OR EC = 76 THEN _
         EXIT SUB
      OK = TRUE
      END SUB
' $SUBTITLE: 'FLUSHCOM -- subroutine reads all char. from  comm. port'
' $PAGE
'
'  SUBROUTINE NAME    -- FLUSHCOM
'
'  INPUT PARAMETERS   --   PARAMETER     MEANING
'                          STNG$       STRING TO READ CHARACTERS INTO FROM
'                                      THE COMMUNICATIONS PORT (FILE #3)
'
'  OUTPUT PARAMETERS  --   STNG$
'
'  SUBROUTINE PURPOSE -- READS ALL CHARACTER FROM 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
' $SUBTITLE: 'NETBIOS - subroutine to lock/unlock using NETBIOS'
' $PAGE
'
'  SUBROUTINE NAME    -- NETBIOS   (WRITTEN BY DOUG AZZARITO)
'
'  INPUT PARAMETERS   -- IBM.LOCK.CMD       = 1-LOCK, 0-UNLOCK
'                        IBM.FILE.LOCK      = 5 USERS FILE
'                                           = 6 SEMAPHORE FILE
'                        IBM.RECORD.LOCK    = RECORD NUMBER TO LOCK
'
'  OUTPUT PARAMETERS  -- NONE
'
'  SUBROUTINE PURPOSE -- LOCK AND UNLOCK FILES USING NETBIOS CMNDS.
'                        IF LOCK FAILS, THIS ROUTINE TRIES FOREVER.
'
      SUB NETBIOS (IBM.LOCK.CMD,IBM.FILE.LOCK,IBM.RECORD.LOCK) STATIC
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
' $SUBTITLE: 'UPDATEC - update of callers log on exiting'
' $PAGE
'
'  SUBROUTINE NAME    -- UPDATEC
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                        CALLERS.FILE.INDEX!
'                        FIRST.NAME$
'                        HHH
'                        LAST.NAME$
'                        MMM
'                        NG$
'                        SSS
'                        SYSOP.FIRST.NAME$
'                        SYSOP.LAST.NAME$
'
'  OUTPUT PARAMETERS  -- CALLERS.RECORD$
'                        CALLERS.FILE.INDEX!
'                        SYSOP
'
'  SUBROUTINE 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 _              'KG102705
         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
' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
' $PAGE
'
'  SUBROUTINE NAME    -- FINDFREE
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                        Z$                        NAME OF FILE TO FIND
'
'  OUTPUT PARAMETERS  -- FREE.SPACE$               NUMBER OF BYTES FREE
'
'  SUBROUTINE 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%
      I# = I# * CX%
      FREE.SPACE$ = STR$(I#) + _
                    " bytes free"
      END SUB
' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
' $PAGE
'
'  SUBROUTINE NAME    -- OPENWORK
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                        FILE.NAME$                NAME OF FILE TO FIND
'                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
'
'  OUTPUT PARAMETERS  -- EC                        ERROR CODE
'
'  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2)
'
      SUB OPENWORK (FILNAME$) STATIC
      ON ERROR GOTO 65000
58000 CLOSE 2
58010 EC = 0
58020 IF SHARE.IT THEN _
         OPEN FILNAME$ FOR INPUT SHARED AS #2 _
      ELSE OPEN "I",2,FILNAME$
      IF EC = 52 THEN _
         GOTO 58010
58030 END SUB
' $SUBTITLE: 'OPENFMS - subroutine to open the FMS directory'
' $PAGE
'
'  SUBROUTINE NAME    -- OPENFMS
'
'  INPUT PARAMETERS   -- PARAMETER                      MEANING
'                        SHARE.IT                DOS SHARING FLAG
'                        FMS.DIRECTORY$        NAME OF FMS DIRECTORY
'
'  OUTPUT PARAMETERS  -- LAST.REC                NUMBER OF THE LAST
'                                                RECORD IN THE FILE
'
'  SUBROUTINE 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
58190 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 QTPUT ("Drive/path does not exist or bad name for FMS dir " + _
      '               ACTIVE.FMS.DIRECTORY$,1) : _
      '   END
      IF EC > 0 THEN
      EC = 0 
CALL QTPUT (CHR$(7)+"Error Has Occured...try again !!!!!  " ,1)
LAST.REC =0
EXIT SUB
END IF
      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)
      END SUB
' $SUBTITLE: 'OPENOUTW - subroutine to open output work file (2)'
' $PAGE
'
'  SUBROUTINE NAME    -- OPENOUTW
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                        FILE.NAME$                NAME OF FILE TO FIND
'                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
'
'  OUTPUT PARAMETERS  -- EC                        ERROR CODE
'
'  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2) FOR OUTPUT
'
      SUB OPENOUTW (FILNAME$) STATIC
      ON ERROR GOTO 65000
58220 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
' $SUBTITLE: 'KILLWORK - subroutine to delete a "work" file'
' $PAGE
'
'  SUBROUTINE NAME    -- KILLWORK
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                        FILNAME$                NAME OF FILE TO DELETE
'
'  OUTPUT PARAMETERS  -- EC                        ERROR CODE
'
'  SUBROUTINE PURPOSE -- TO DELETE A RBBS-PC "WORK" FILE
'
      SUB KILLWORK (FILNAME$) STATIC
      ON ERROR GOTO 65000
58260 CLOSE 2
       EC = 0
58270 KILL FILNAME$
58275 END SUB
' $SUBTITLE: 'GETPASWD - subroutine to read the "passwords" file'
' $PAGE
'
'  SUBROUTINE NAME    -- GETPASWD
'
'                          PARAMETER             MEANING
'  INPUT PARAMETERS   -- FILE # 2 OPENED
'
'  OUTPUT PARAMETERS  -- TEMP.PASSWORD$
'                        TEMP.SECURITY.LEVEL
'                        TEMP.TIME.ALLOWED
'                        TEMP.REG.PERIOD
'                        TEMP.MAX.PER.DAY
'
'  SUBROUTINE PURPOSE -- TO READ THE RBBS-PC "PASSWORDS" FILE
'
58280 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
' $SUBTITLE: 'READDIR - subroutine to read the "DIR" files'
' $PAGE
'
'  SUBROUTINE NAME    -- READDIR
'
'                          PARAMETER             MEANING
'  INPUT PARAMETERS   -- FILE # 2 OPENED
'                        WHICH.LINE              HOW MANY LINES TO ADVANCE
'
'  OUTPUT PARAMETERS  -- A$
'
'  SUBROUTINE PURPOSE -- TO READ POSSIBLE "DIR" FILES
'
58290 SUB READDIR (WHICH.LINE) STATIC
      ON ERROR GOTO 65000
      EC = 0
      FOR I = 1 TO WHICH.LINE
         LINE INPUT #2,A$
      NEXT
58295 END SUB
' $SUBTITLE: 'READPARMS - subroutine to read parameter values'
' $PAGE
'
'  SUBROUTINE NAME    -- READPARMS
'
'                          PARAMETER             MEANING
'  INPUT PARAMETERS   -- FILE # 2 OPENED
'                        NUM.PARMS               # parameters to read
'                        WHICH.LINE              Which set of parms to return
'  OUTPUT PARAMETERS  -- ARA.TO.USER$            Array of string values
'                        FILE.SECURITY
'                        FILE.PASSWORD$
'
'  SUBROUTINE PURPOSE -- To read different values, where values are
'                        separated by a comma or carriage-return-line-feed.
'
58300 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
' $SUBTITLE: 'READANY - subroutine to read file 2 into A$'
' $PAGE
'
'  SUBROUTINE NAME    -- READANY
'
'                          PARAMETER             MEANING
'  INPUT PARAMETERS   -- FILE # 2 OPENED
'
'  OUTPUT PARAMETERS  -- A$
'
'  SUBROUTINE PURPOSE -- TO READ FILE #2 INTO A$
'
58310 SUB READANY STATIC
      ON ERROR GOTO 65000
      EC = 0
      INPUT #2,A$
58315 END SUB
' $SUBTITLE: 'PRINTWRK - subroutine to print to file 2'
' $PAGE
'
'  SUBROUTINE NAME    -- PRINTWRK
'
'                          PARAMETER             MEANING
'  INPUT PARAMETERS   -- FILE # 2 OPENED
'                        STRING TO WRITE OUT
'
'  OUTPUT PARAMETERS  -- NONE
'
'  SUBROUTINE PURPOSE -- TO PRINT A STRING TO FILE #2
'
58320 SUB PRINTWRK (STRNG$) STATIC
      ON ERROR GOTO 65000
      EC = 0
      PRINT #2,STRNG$;
58325 END SUB
' $SUBTITLE: 'GETWORK - subroutine to read file 2'
' $PAGE
'
'  SUBROUTINE NAME    -- GETWORK
'
'                          PARAMETER             MEANING
'  INPUT PARAMETERS   -- REC.LEN            Length of record
'
'  OUTPUT PARAMETERS  -- NONE
'
'  SUBROUTINE PURPOSE -- TO READ A RECORD FROM FILE #2
'
58330 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
' $SUBTITLE: 'OPENWRKA - subroutine to open output work file (2)'
' $PAGE
'
'  SUBROUTINE NAME    -- OPENWRKA
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                        FILNAME$                  NAME OF FILE TO FIND
'                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
'
'  OUTPUT PARAMETERS  -- EC                        ERROR CODE
'
'  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2) FOR APPENDED
'                        OUTPUT
'
58340 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
' $SUBTITLE: 'PRNTWRKA - subroutine to print to file 2 with CR'
' $PAGE
'
'  SUBROUTINE NAME    -- PRNTWRKA
'
'                          PARAMETER             MEANING
'  INPUT PARAMETERS   -- FILE # 2 OPENED
'                        STRING TO WRITE OUT
'
'  OUTPUT PARAMETERS  -- NONE
'
'  SUBROUTINE PURPOSE -- TO PRINT A STRING TO FILE #2 FOLLOWED BY A CARRIAGE
'                        RETURN
'
58350 SUB PRNTWRKA (STRNG$) STATIC
      ON ERROR GOTO 65000
      EC = 0
      PRINT #2,STRNG$
58355 END SUB
' $SUBTITLE: 'CHECKINT - subroutine to check input is an integer'
' $PAGE
'
'  SUBROUTINE NAME    -- CHECKINT
'
'                          PARAMETER             MEANING
'  INPUT PARAMETERS   -- STRNG$         STRING TO VERIFY CAN BE AN INTEGER
'
'  OUTPUT PARAMETERS  -- EC             = 0 MEANS IT IS AN INTEGER VALUE
'                                      <> 0 MEANS IT IS NOT AN INTEGER VALUE
'
'  SUBROUTINE PURPOSE -- TO PRINT VALIDATE A STRING CAN HAVE AN INTEGER VALUE
'
58360 SUB CHECKINT (STRNG$) STATIC
      ON ERROR GOTO 65000
      EC = 0
      TESTED.INTEGER.VALUE = VAL(STRNG$)
58365 END SUB
' $SUBTITLE: 'PUTCOM -- subroutine to write to communications port'
' $PAGE
'
'  SUBROUTINE NAME    -- PUTCOM
'
'  INPUT PARAMETERS   --   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
'
'  OUTPUT PARAMETERS  --
'
'  SUBROUTINE PURPOSE -- CHECKS FOR CARRIER DROP AND FLOW CONTROL (I.E. "CLEAR
'                        TO SEND" SIGNAL) BEFORE WRITING TO THE COMMUNICATIONS
'                        PORT.
'
59650 SUB PUTCOM (STRNG$) STATIC
      ON ERROR GOTO 65000
      IF LOCAL.USER THEN _
         EXIT SUB
      CALL CARRIER
      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 CARRIER
      CALL CHKTREMAIN (X!)
      RETURN
      END SUB
' $SUBTITLE: 'PUTWORK -- subroutine to write to upload files'
' $PAGE
'
'  SUBROUTINE NAME    -- PUTWORK
'
'  INPUT PARAMETERS   --   PARAMETER     MEANING
'                          STNG$       STRING TO WRITE TO FILE
'                          REC.NUM     RECORD NUMBER TO WRITE
'                          REC.LEN     LENGTH OF RECORD TO WRITE
'
'  OUTPUT PARAMETERS  --
'
'  SUBROUTINE PURPOSE -- WRITES UPLOADED FILE RECORDS TO WORK FILE
'
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
'
' $SUBTITLE: 'DGSALIAS - Subroutine to Create/Update Alias Info file'
' $PAGE
'
'  SUBROUTINE NAME    -- DGSALIAS
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                         GRN$                        CONFERENCE NAME
'                         ORIG.USER.NAME$             USERS - LOG ON NAME
'                         DGS.ALIAS$                  USERS - ALIAS NAME
'                         DGS.STL$                    NULL FIRST TIME IN
'                                                     'STILL' IF ALIAS EXISTS
'                                                     OR REAL NAME
'                         DGS.FILE.NAME$              CONFERENCE ALIAS FILE
'
'  OUTPUT PARAMETERS  --  GRN$ ORIG.USER.NAME$ DGS.ALIAS$ DGS.STL$
'                         DGS.FILE.NAME$
'
'  SUBROUTINE PURPOSE --  TO READ CONFA.DEF AND GET USERS ALIAS OR
'                         CREATE ONE
'
     SUB DGSALIAS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$) STATIC
'
     IF DGS.STL$ = "" THEN
	CONFA.DEF.FLAG = 0
	CALL BRKFNAME (MAIN.USER.FILE$,DRV$,PREFIX$,EXT$,TRUE)
	DGS.FILE.NAME$ = DRV$ + GRN$ + "A.DEF"
	CALL FINDIT (DGS.FILE.NAME$)
	IF OK THEN
	   CONFA.DEF.FLAG = TRUE
	END IF
	IF CONFA.DEF.FLAG = TRUE THEN
	   OPEN "I", 7, DGS.FILE.NAME$
	   DGS.ALIAS$ = ""
	   WHILE DGS.ALIAS$ = "" AND NOT EOF(7)
	      INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$
	      DGS.UNL = LEN(DGS.USER.NAME$)
	      IF DGS.USER.NAME$ = LEFT$(ORIG.USER.NAME$,DGS.UNL) THEN
		 DGS.ALIAS$ = DGS.TEMP.ALIAS$
	      END IF
	   WEND
	   CLOSE 7
	ELSE
	   DGS.ALIAS$ = "NO CONFA.DEF"
	   EXIT SUB
	END IF
     END IF
     CALL GOODALS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$)
     END SUB
'
'
' $SUBTITLE: 'GOODALS - Subroutine to Make Sure Alias Good'
' $PAGE
'
'  SUBROUTINE NAME    -- GOODALS
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                         GRN$                        CONFERENCE NAME
'                         ORIG.USER.NAME$             USERS - LOG ON NAME
'                         DGS.ALIAS$                  USERS - ALIAS NAME
'                         DGS.STL$                    NULL FIRST TIME IN
'                                                     'STILL' IF ALIAS EXISTS
'                                                     OR REAL NAME
'                         DGS.FILE.NAME$              CONFERENCE ALIAS FILE
'
'  OUTPUT PARAMETERS  --  GRN$ ORIG.USER.NAME$ DGS.ALIAS$ DGS.STL$
'                         DGS.FILE.NAME$
'
'  SUBROUTINE PURPOSE --  TO READ CONFA.DEF AND SEE IF GET USERS ALIAS IS
'                         ALREADY IN USE OR A REAL NAME
'
     SUB GOODALS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$) STATIC
'
     IF DGS.ALIAS$ = "" THEN
	DGS.SFN.SLN$ = SYSOP.FIRST.NAME$+" "+SYSOP.LAST.NAME$
	A$ = "Do you" +DGS.STL$+ " want to use an Alias? (Y,[N])"
	SUBROUTINE.PARAMETER = 1
	CALL TGET
	IF YES THEN
	   ABFLG$ = ""
	   A$ = "Enter Alias (31 Char. Max.) "
	   SUBROUTINE.PARAMETER = 1
	   CALL TGET
	   CALL ALLCAPS (B$)
	   IF B$ = "" OR INSTR(SPACE$(31),B$) > 0 THEN
	      B$ = ""
	      ABFLG$ = "Alias Must NOT be Blank"
	   END IF
	   IF LEN(B$) > 31 THEN
	      B$= ""
	      ABFLG$ = "Length Must NOT Exceed 31 Characters"
	   END IF
	   IF B$ = "SYSOP" OR B$ = DGS.SFN.SLN$ THEN
	      A$ = CHR$(7)+CHR$(7)
	      A$ = A$ + "Wrong Answer! Alias Request Denied!"
	      A$ = A$ + CHR$(13) + "Contact Sysop for Alias Retry"
	      CALL QTPUT (A$,2)
	      DGS.ALIAS$ = ORIG.USER.NAME$+CHR$(250)
	      ACTIVE.USER.NAME$ = ORIG.USER.NAME$+CHR$(250)
	      FIRST.NAME$ = ORIG.USER.NAME$+CHR$(250)
	   ELSE
	      OPEN "I", 7, DGS.FILE.NAME$
	      WHILE ABFLG$ = "" AND NOT EOF(7)
		 INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$
		 IF B$ = DGS.USER.NAME$ THEN
		    ABFLG$ = " is a Real User"
		 ELSE
		    IF B$ = DGS.TEMP.ALIAS$ THEN
		       ABFLG$ = " has Already been Used"
		    END IF
		 END IF
	      WEND
	      CLOSE 7
	      IF ABFLG$="" THEN
		 DGS.ALIAS$ = B$
		 ACTIVE.USER.NAME$ = B$
		 FIRST.NAME$ = B$
	      ELSE
		 A$="Sorry "+FIRST.NAME$+" but "+B$+ABFLG$
		 CALL QTPUT (A$,1)
		 DGS.STL$ = " still"
		 DGS.ALIAS$ = ""
	      END IF
	   END IF
	ELSE
	   DGS.ALIAS$ = ORIG.USER.NAME$
	END IF
	IF DGS.ALIAS$ <> "" THEN
	   CLOSE 2
	   OPEN "A", 2, DGS.FILE.NAME$
	   WRITE #2, ORIG.USER.NAME$, DGS.ALIAS$
	   CLOSE 2
	END IF
     ELSE
	ACTIVE.USER.NAME$ = DGS.ALIAS$
	FIRST.NAME$ = DGS.ALIAS$
     END IF
 END SUB
'
'********************************************************************
'  THREAD1            First message thread routine                  *
'  THREAD2            Second message thread routine                 *
'  THREAD3            Third message thread routine                  *
'********************************************************************
'===========================================================================


' $SUBTITLE: 'THREAD1 - create/update threaded message file'
' $PAGE
'
'  SUBROUTINE NAME    -- THREAD1
'
'  INPUT PARAMETERS   --    PARAMETER              MEANING
'                           HIGH.MESSAGE.NUMBER    This reply's message number
'                           CURRENT.MESSAGE        Message number being replied
'
'  OUTPUT PARAMETERS  --     <<NONE>>
'
'  SUBROUTINE PURPOSE -- SUBROUTINE TO...
'
      SUB THREAD1 (HIGH.MESSAGE.NUMBER,CURRENT.MESSAGE,GRN$) STATIC
        IF INSTR(GRN$," ") = 0 THEN   'PE102587
         FILE.NAME$ = GRN$ + "T"  'PE102587
        ELSE
           FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T" 'PE102587
      END IF
      CURRENT.MESSAGE$ = STR$(CURRENT.MESSAGE)
      HIGH.MESSAGE.NUMBER$ = STR$(HIGH.MESSAGE.NUMBER)
      OPEN "R",9,FILE.NAME$,12
      FIELD 9, 6 AS CM$, 6 AS HMN$
      LSET CM$ = CURRENT.MESSAGE$
      LSET HMN$ = HIGH.MESSAGE.NUMBER$
      PUT #9,INT(LOF(9)/12)+1
      CLOSE (9)
59670 END SUB       ' THREAD1
'
' $SUBTITLE: 'THREAD2 - a message was killed - check threaded message file'
' $PAGE
'
'  SUBROUTINE NAME    -- THREAD2
'
'  INPUT PARAMETERS   --    PARAMETER              MEANING
'                           MESSAGE.TO.KILL        Killed message's number
'
'  OUTPUT PARAMETERS  --     <<NONE>>
'
'  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
'
      SUB THREAD2 (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) STATIC
      IF INSTR(GRN$," ") = 0 THEN     'PE102587
        FILE.NAME$ = GRN$ + "T"
      ELSE
        FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
      END IF
      OPEN "R",9,FILE.NAME$,12
      FIELD 9, 6 AS CM$, 6 AS HMN$
       FOR I = 1 TO INT(LOF(9)/12)
          GET 9,I
          IF VAL(CM$) = MESSAGE.TO.KILL THEN     ' MARK THE RECORD
             LSET CM$ = LEFT$(CM$,5) + "K"
             PUT 9,I
          ELSE 
           IF VAL(HMN$) = MESSAGE.TO.KILL THEN     ' MARK THE RECORD
              LSET HMN$ = LEFT$(HMN$,5) + "K"
              LSET CM$ = LEFT$(CM$,5) + "K"
             PUT 9,I
          END IF
       END IF
      NEXT I
      CLOSE (9)
59680 END SUB      ' THREAD2
'
' $SUBTITLE: 'THREAD3 - a message was killed - check threaded message file'
' $PAGE
'
'  SUBROUTINE NAME    -- THREAD3
'
'  INPUT PARAMETERS   --    PARAMETER              MEANING
'                           CURRENT.MESSAGE        Message's number
'
'  OUTPUT PARAMETERS  --     <<NONE>>
'
'  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
'
      SUB THREAD3 (CURRENT.MESSAGE,GRN$) STATIC
IF JUST.SEARCHING THEN _            'PE 01/16/89
 EXIT SUB                           'PE 01/16/89
      IF INSTR(GRN$," ") = 0 THEN
         FILE.NAME$ = GRN$ + "T"
       ELSE
         FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
      END IF
       OPEN "R",9,FILE.NAME$,12 
       FIELD 9, 6 AS CM$, 6 AS HMN$
      AA$ = ""
      ZZ$ = ""
      FOR I = 1 TO INT(LOF(9)/12)
          GET 9,I
         IF RIGHT$(HMN$,1) = "K" THEN 59690
         IF VAL(CM$) = CURRENT.MESSAGE AND RIGHT$(HMN$,1) <> "K" THEN 
                AA$ = AA$ + HMN$
         END IF 
          IF VAL(HMN$) = CURRENT.MESSAGE AND RIGHT$(CM$,1) = "K" THEN
                ZZ$ = LEFT$(CM$,5) + CX$(1)+"(deleted) "+EMPHASIZE.OFF$
         END IF
          IF VAL(HMN$) = CURRENT.MESSAGE AND RIGHT$(CM$,1) <> "K" THEN 
                ZZ$ = CM$
         END IF
59690 NEXT I
      IF LEN(AA$) > 0 THEN 
CALL QTPUT(FG.3$+"   Reply(ies) in message number(s): "+CX$(4) + AA$+EMPHASIZE.OFF$,1)
      END IF
      IF LEN(ZZ$) > 0 THEN 
CALL QTPUT (FG.4$+"   This message is in reply to message " +FG.1$+ ZZ$+EMPHASIZE.OFF$,1)
      END IF
CALL QTPUT (CX$(1)+ "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+EMPHASIZE.OFF$,1)
      CLOSE (9)
59695 END SUB      ' THREAD3
'
' $SUBTITLE: 'THREAD4 - UPDATE CONFR.DEF FILE FOR MESSAGE RECOVERY'
' $PAGE
'
'  SUBROUTINE NAME    -- THREAD4
'
'  INPUT PARAMETERS   --    PARAMETER            MEANING
'
'                           MESSAGE.TO.RECOVER   MESSAGE NUMBER BEING RECOVERED
'                           FIRST.MESSAGE.RECORD NOT USED HERE BUT PASSED IN
'                                                FROM RBBS CALL TO SUB2
'                           ACTION.FLAG          PASSED FROM SUB2 NEEDED TO
'                                                GIVE BACK TO RBBS MAIN CODE
'                           GRN$                 CONFERENCE NAME
'
'  OUTPUT PARAMETERS  --      <<NONE>>
'
'  SUBROUTINE PURPOSE -- SUBROUTINE - UPDATE CONFR.DEF FILE AFTER MSG RECVRY
'
      SUB THREAD4 (MESSAGE.TO.RECOVER,FIRST.MESSAGES.RECORD,ACTION.FLAG,GRN$) STATIC
      IF INSTR(GRN$," ") = 0 THEN
         FILE.NAME$ = GRN$ + "T"
      ELSE
         FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
      END IF
      OPEN "R",9,FILE.NAME$,12               'WILL CREATE FILE IF NOT EXIST
      FIELD 9, 6 AS CM$, 6 AS HMN$
      FOR I = 1 TO INT(LOF(9)/12)
          GET 9,I
          IF VAL(CM$) = MESSAGE.TO.RECOVER THEN
             LSET CM$ = LEFT$(CM$,5) + " "
             PUT 9,I
          ELSE
              IF VAL(HMN$) = MESSAGE.TO.RECOVER THEN
                 LSET HMN$ = LEFT$(HMN$,5) + " "
                 LSET CM$ = LEFT$(CM$,5) + " "
                 PUT 9,I
              END IF
          END IF
      NEXT I
      CLOSE (9)
59698 END SUB    'THREAD4
'
' $SUBTITLE: 'VIEWTXT - Subroutine to display ASCII file from ARC file'
' $PAGE
'
  SUB VIEWTXT STATIC
  ON ERROR GOTO 65000
'
60140 SUBROUTINE.PARAMETER = 1 
A$ ="T)ype, X)tract, C)ompress, D)ir, H)elp or [Quit]" +CRLF$
A$ = CRLF$ + A$ + "Enter Choice T,X,C,D,?,H,[Q] "
        TURBO.KEY = -TURBO.KEY.USER
        CALL TGET
IF SUBROUTINE.PARAMETER = -1 THEN_   
   EXIT SUB
IF Q = 0 THEN _
 EXIT SUB          'Pe 05/24/89                    
        CALL ALLCAPS (B$)
        X = INSTR("TXCD?HQ",B$)
     ON X GOTO 60149,60168,60175,60142,60141,60141,60180
GOTO 60180
'
60141 CALL BUFFILE (HELP.PATH$ + "ZIP" + HELP.EXTENSION$,X)  'Pe 03/26/89
      GOTO 60140                                             'Pe 03/26/89
60142  CALL QTPUT ("Creating file list, one moment please....",1)
   EXTRACT$ = "DIR "+ ARKVIEW.PATH$+">VUZIP"+NODE.ID$+".LST"
   SHELL EXTRACT$
CALL BUFFILE("VUZIP"+NODE.ID$ +".LST",X)
GOTO 60140
'
60149 SUBROUTINE.PARAMETER = 1
     A$ = "What file(s) to Type, R)elist or [ENTER] to quit"         'DMOD1
     CALL TGET
IF SUBROUTINE.PARAMETER = -1 THEN _
 EXIT SUB                              'Pe 05/24/89
       B = 1                                                            'DMOD1
       IF Q = 0 THEN _                                                  'DMOD1
        GOTO 60140              'Pe 05/24/89 was Exit Sub
IF B$ = "R" or B$ = "r" THEN _
   CALL BUFFILE (ARC.WORK$,X) : _
GOTO 60149
       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$)  
  IF INSTR(Z$,"*") OR INSTR(Z$,"?") THEN _
  CALL QTPUT ("Sorry Widcars NOT allowed !!",1) : _
  GOTO 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" OR EXT$ = "PIC" THEN _ 
         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
'
'
' ******* Next 3 lines added for ZIP support    Pe 02/19/89
IF LAST.EXT$ = "ZIP" THEN _
 SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKUNZIP -O " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ : _
GOTO 60150
'
 IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="PK" THEN _
      SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKXARC -R " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$
 IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="AR" THEN _
      SHOWME$ = LIBRARY.ARCHIVE.PATH$+"ARCE " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ + " /R"
 IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,3) ="PAK" THEN _
      SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PAK /E/WA " + FILE.NAME$ + " "+ ARKVIEW.PATH$+"\"+Z$
60150 SHELL SHOWME$                                         'Pe 02/19/89
      Z$ = ARKVIEW.PATH$ +"\"+ Z$     'Added \ to fix error 63
      TEMP$ = Z$    
'
      CALL BUFFILE (Z$,X)                                             'DMOD1
        IF NOT OK THEN _
         CALL QTPUT(CHR$(7)+"File NOT found or bad Spelling",1) :_
        GOTO 60149
      CALL KILLWORK(TEMP$)   'get rid of the files that were xtracted   PEMOD1
       NEXT                                                             'DMOD1
GOTO 60140
'
60168 SUBROUTINE.PARAMETER = 1
      CALL SKIPLINE (1)
60169  A$ = "What file(s) to Extract, R)elist or [ENTER] quits"+CRLF$ + _
"Wildcards ARE supported for this feature " +EMPHASIZE.OFF$ 
    CALL TGET
IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 11/29/88
   EXIT SUB                              'Pe 11/29/88
IF B$ = "R" or B$ = "r" THEN _
   CALL BUFFILE (ARC.WORK$,X) : _
   GOTO 60168
      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 BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)                        'DMOD1
     CALL QTPUT ("Please stand by while I extract the file(s)....",1)    'DMOD1
'
'Next 3 lines for ZIP Support Pe 02/19/89
'
IF LAST.EXT$ = "ZIP" THEN _
 SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKUNZIP -O " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ : _
GOTO 60170
'
'
 IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="PK" THEN _
      SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKXARC -R " + FILE.NAME$ + " " + Z$ + " " + ARKVIEW.PATH$
 IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="AR" THEN _
      SHOWME$ = LIBRARY.ARCHIVE.PATH$+"ARCE " + FILE.NAME$ + " " + Z$ + " " + ARKVIEW.PATH$+" /R"
 IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,3) ="PAK" THEN _
      SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PAK /E/WA " + FILE.NAME$ + " " + ARKVIEW.PATH$ + "\" +Z$
'
60170  SHELL SHOWME$     'Added line Number Pe 02/19/89
LOOKFOR$ = ARKVIEW.PATH$ + "\" + Z$
CALL FINDIT(LOOKFOR$)
     IF NOT OK THEN _
CALL QTPUT ("Error extracting " + Z$ + "...file Skipped...",2) : _
      GOTo 60171
       CALL QTPUT(Z$+" Is now  Extracted ...",2)
60171 NEXT ARC.INDEX
CALL QTPUT ("Use the C)ompress command to create a ZIP file of Xtracted files",2)
GOTO 60140
'
' ***  Added choice of Compressing file or taking it as is Pe 03/23/89 ***
'
60175 Subroutine.parameter = 1          'Pe 03/26/89
      A$ = CRLF$ +"List files about to be Compressed (Y/[N])"
    CALL TGET
IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 03/29/88
   EXIT SUB                              'Pe 03/29/88
IF B$ ="N" or B$ = "n" Then _            'Pe 04/07/89
   GOTO 60179                            'pe 04/07/89
IF B$ = "Y" or B$ = "y" THEN _           'Pe 03/29/89
 CALL QTPUT ("Creating file list, one moment please....",1): _
   EXTRACT$ = "DIR "+ ARKVIEW.PATH$+">VUZIP"+NODE.ID$+".LST" : _
   SHELL EXTRACT$ : _
CALL BUFFILE("VUZIP"+NODE.ID$ +".LST",X) : _
Subroutine.parameter = 1 : _         'Pe 03/26/89
 A$ = CRLF$ +"Continue with file Compression ([Y]/N) " : _
    CALL TGET : _
IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 03/29/88
   EXIT SUB                               'Pe 03/29/88
IF B$ = "N" or B$ = "n" THEN _           'Pe 03/29/89
 GOTO 60140
 CALL QTPUT ("One Moment while I Compress the file(s) for you........",1)
'
'********** ARC all files in the ARKVIEW.PATH$ into VIEW.ZIP **********
'next line adds comment to Zip file if used EDIT to Suite and replace in 60179
'60179  ZIPME$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -m -ex -z<C:\C3\MPL.CMT " + ARKVIEW.PATH$ + "\VIEW.ZIP " + ARKVIEW.PATH$ + "\*.*"
' old code
60179  ZIPME$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -m -ex " + ARKVIEW.PATH$ + "\VIEW.ZIP " + ARKVIEW.PATH$ + "\*.*"
SHELL ZIPME$                   
' **** Check to see if Compresion was successfull if NOT then redo *****
VIEW.FILE.NAME$ = ARKVIEW.PATH$ + "\VIEW.ZIP"   'Pe 03/06/89
CALL FINDIT (VIEW.FILE.NAME$)
IF NOT OK THEN _
CALL QTPUT ( "No files to Compress...you must use the X)tract command first" ,2) : _
CALL DELAYIT (2) : _
GOTO 60140
'
'
'********** Tells the caller the name of the file to download **********
'
CALL QTPUT (" File has been Compressed and named... VIEW.ZIP....",2)
CALL QTPUT (CHR$(7)+"To Download this file You MUST enter VIEW.ZIP as the file name",2)
CALL DELAYIT (3)
GOTO 60140
60180 END SUB
'
64900 ' $SUBTITLE: 'RBBSPLAY -- subroutine to play music'            ' KG122702
' $PAGE
'
'  SUBROUTINE NAME    -- RBBSPLAY
'
'  INPUT PARAMETERS   --   PARAMETER     MEANING
'                          STRNG$      STRING TO PLAY
'
'  OUTPUT PARAMETERS  --
'
'  SUBROUTINE PURPOSE -- PLAY MUSIC.  SKIP IF GET AN ERROR.
'
      SUB RBBSPLAY (STRNG.TO.PLAY$) STATIC                           ' KG122702
      PLAY STRNG.TO.PLAY$                                            ' KG122702
      EC = 0                                                         ' KG122702
      END SUB                                                        ' KG122702
'  $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 <= 118 THEN _
          RESUME NEXT
'
'     OPEN COM PORT ERROR HANDLING
'
      IF ERL = 200 THEN _
         CLS : _
   CALL PSCRN (COM.PORT$ + " does not exit/not responding (Error" + STR$(ERR)) : _ ' KG120905
         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 _                  'KG102502
          CALL QTPUT ("Disk Full",1) : _
          IF DISKFULL.GO.OFFLINE THEN _
             GOTO 65010 _
          ELSE RESUME NEXT
       IF ERL = 13672 THEN _                                         ' KG102502
          CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! - 1 : _          ' KG102502
          RESUME NEXT                                                ' KG102502
'
'     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 AND ERR = 24 THEN _
          NOT.CTS = TRUE : _
          CALL LINE25 : _
          RESUME
       IF ERL => 52000 AND ERL <= 59660 THEN _           'KG122702
          RESUME NEXT
'
'      VIEW ARC TXT ERROR HANDLER changed 60151 to 60149
'
 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
'
'      VUZIP ERROR HANDLER
'
'IF ERL = 60175 THEN _        'Pe 03/26/89
'         RESUME NEXT         'Pe 03/26/89
'
'
'     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
65010  CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
       IF FOSSIL THEN _
         CALL FOSEXIT(COMPORT%)
       SYSTEM