' $linesize:132 ' $title: 'RBBSSUB2.BAS CPC17-1D, Copyright 1986 - 89 by D. Thomas Mack' ' Copyright 1987 by D. Thomas Mack, all rights reserved. ' Name ...............: RBBSSUB2.BAS ' Written by .........: D. Thomas Mack ' First Released .....: September 18, 1988 ' Subsequent Releases.: OCT 30 , 1988 ' Copyright ..........: 1986, 1987, 1988 ' Purpose.............: The Remote Bulletin Board System for the IBM PC, ' RBBS-PC.BAS utilizes a lot of common subroutines. ' Those that do not require error trapping are ' incorporated within RBBSSUB2.BAS, RBBSSUB3.BAS, ' RBBSSUB4.BAS and RBBSSUB5.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 ' ANSWERIT 201 Answer the telephone when it rings ' ASCCODES 129 Allow a CONFIG string to have any ASCII value ' BADCHAR 455 Check user name for invalid characters ' BADNAME 20235 Check for system crash attempt with bad file name ' BAUD450 5507 Allow 300 baud callers to bump up to 450 baud ' BRKFNAME 20282 Break a file name into it's component parts ' CHECKRATIO 20096 Test upload/download ratio ' CHKMACRO 1242 Checks for macro and processes ' COPYWRIT 97 Display RBBS-PC's copyright notice ' DEFALTU 9600 Write out the user's defaults ' DENYACCESS 1386 Downgrade security so access denied ' DOOREXIT 10987 Set up a .BAT file to exit RBBS-PC and go to a "door" ' DOSEXIT 10934 Set up a .BAT file to exit to DOS (second level) ' EDITALINE 2620 Edits a single line ' EDITDEF Edit configuration parameters ' GETARC 20141 Handle request for verbose arc listing ' GETCOMND 97+ Get RBBS-PC's node id from command line ' GETIME 9140 Calculates callers elapsed time (hours, minutes, seconds) ' GOIDLE 90 Release resources when waiting for keyboard input ' KILLMSG 3955 Delete old or unnecessary messages ' LINE25 949 Build and/or update line 25 of RBBS-PC's local screen ' LINEEDIT 3700 Edit a line while minimizing string space consumption ' LOGERROR 13660 Log error message to CALLERS file ' LPRNT 1480 Subroutine to write to local display ' MLINIT 10 Handle MultiLink initialization/de-initialization ' MSGPROT 2060 Sets protection for a message ' MSGTO 2020 Sets who a message is to ' PAGLEN 5902 Change page length ' PARSEIT 1635 Parses a string ' PASSWRD 667 Verify user & message passwords ' PSCRN 1480+ Print to display ' QTPUT 1477 Fast, but limited, "TPUT" equivalent ' RBBSEXIT 10992 Common RBBS-PC exit to transfer control to other programs ' RECOVMSG 10410 Recover a deleted message ' REMNONALF 5100 Removes non-alpha characters from a string ' RINGCALLER 1635+ Ring caller's bell and put message in emphasis ' SETBAUD 1654 Set baud rate in the 8250 chip of the RS232 interface ' SETCRLF 1496 Set up the necessary carriage return/line feed string ' SETSECT 12000 Set the proper section prompts (main, file, util, libr) ' SETTHREAD 4031 Set up request for threading thru messages ' SKIPLINE 1485 Write a # of blank lines to the communications port ' SRCHCMND 1240 Searches list of commands in RBBS for a request ' SVIOLATION 1380 Process a security violation ' SYSMENU 112 Displays sysop menu/status ' SYSOPCHAT 4657 Sysop and caller chat ' KG102206 ' TESTREL 336 Tests for Reliable connect ' TGET 1500 Read a line from the communications port ' TPUT 1400 Write a line to the communications port ' TRIM 99 Strip leading and trailing blanks from a string ' TRIMTRAIL 99 Strip off specified string off end of another string ' UNTILRIGHT 12880 Ask a question until user says answer is right ' UPDATEU 10600 Updates the user record on loging off/exiting RBBS-PC ' VARINIT 104 Initialize system variables ' VIEWHELP 1330 Processes help command ' WHOCHECK 2250 Checks whether a user exists in user file ' WHOSON 9801 Report status of each node - who's on ' WILDCARD 20285 Determines whether string matches a pattern ' WORDINFILE 10976 Find a whole word within a file/menu ' ' $INCLUDE: 'RBBS-VAR.BAS' ' ' $SUBTITLE: 'MLINIT - MultiLink initialization/deinitialization' ' $PAGE ' ' SUBROUTINE NAME -- MLINIT ' ' INPUT PARAMETERS -- MLPARM = 1 INITIALIZE AT STARTUP OR RE- ' CYLCE TIME ' MLPARM = 2 DE-INITIALIZE ON EXITING TO ' A DOOR OR DOS REMOTELY ' MLPARM = 3 DE-QUEUE COMMUNICATIONS PORTS ' MLPARM = 4 CHECK FOR MULTILINK PRESENT ' DOORS.TERMINAL.TYPE ' BAUD.TEST ' COM.PORT$ ' COMPUTER.TYPE ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO TEST FOR THE PRESENCE OF MULTI-LINK AND SET ' MULTI LINK OPTIONS TO BE COMPATIBLE WITH RBBS-PC ' SUB MLINIT (MLPARM) STATIC DEF SEG = 0 IF COMPUTER.TYPE = 1 _ GOTO 10 IF NOT MLCOM THEN _ IF NETWORK.TYPE <> 1 THEN _ GOTO 10 MULTI.LINK.PRESENT = PEEK(&H1FE) + 256 * PEEK(&H1FF) IF MULTI.LINK.PRESENT = 0 THEN _ GOTO 10 ON MLPARM GOSUB 30,20,60,10 10 DEF SEG EXIT SUB 20 IF DOORS.TERMINAL.TYPE < 1 THEN _ RETURN DEF SEG = MULTI.LINK.PRESENT GOSUB 60 ' ************** MLUTIL BAUD n (where n = BAUD.TEST) ******* AX = &H600 BX = BAUD.TEST ' Tell ML the baud rate GOSUB 80 ' ************** MLUTIL TERM n (where n = DOORS.TERMINAL.TYPE) ***** AX = &H700 + DOORS.TERMINAL.TYPE GOSUB 80 ' Tell ML the terminal type ' ********* MLINK /port ************ ' ' Tell ML the communications port POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(COM.PORT$,1)) - 48 ' ************ MLUTIL SCMON ************** AX = &HB01 BX = 0 ' Tell ML to start monitoring the carrier GOSUB 80 RETURN ' ************** MLUTIL CCMON **************** 30 AX = &HB00 ' Turn off ML's carrier monitoring. BX = 0 GOSUB 80 ' ************** MLUTIL TERM 1 ************** AX = &H701 ' Change terminal type to ML type 1. BX = 0 GOSUB 80 ' ******* MLINK /port (where port = 9 if ML 3.03 or earlier ******* ' ******* port = 0 if ML 4.00 or greater ******* DEF SEG = MULTI.LINK.PRESENT MULTI.LINK.COM.PORT = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC) MULTI.LINK.VERSION = PEEK(&H1) + 256 * PEEK(&H2) IF PEEK(MULTI.LINK.COM.PORT) = &H1 OR _ PEEK(MULTI.LINK.COM.PORT) = &H2 THEN _ IF MULTI.LINK.VERSION > 5000 THEN _ POKE (MULTI.LINK.COM.PORT),&H0 _ ELSE POKE (MULTI.LINK.COM.PORT),&H9 ' ********** MLUTIL ENQ *********** AX = &H1 ' Tell ML to conditional enque on the comm. port GOSUB 70 ' ********** MLUTIL BAUD 19200 ********** AX = &H600 ' Tell ML to reset the buad rate (19200 BAUD) BX = 19200 GOSUB 80 RETURN ' ********** MLUTIL DEQ ********** 60 AX = &H100 ' Tell ML to unconditionally deque the comm. port 70 BX = -4 IF COM.PORT$ = "COM2" THEN _ BX = -3 IF COM.PORT$ = "COM0" THEN _ RETURN ' ****** MULTI-LINK PROGRAMMING SUPPORT INTERFACE ******** 80 CALL RBBSML(AX,BX) RETURN END SUB ' $SUBTITLE: 'GOIDLE - subroutine to release control when waiting' ' $PAGE ' ' SUBROUTINE NAME -- GOIDLE ' ' INPUT PARAMETERS -- MLCOM ' NETWORK.TYPE ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO RELINQUISH CONTROL WHEN RBBS-PC IS WAITING FOR ' INPUT FROM THE COMMUNICATIONS PORT ' SUB GOIDLE STATIC 90 IF MLCOM OR NETWORK.TYPE = 1 THEN _ CALL MLINIT(5) : _ EXIT SUB CALL GIVEBACK END SUB ' $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright' ' $PAGE ' ' SUBROUTINE NAME -- COPYWRIT ' ' INPUT PARAMETERS -- NONE ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO DISPLAY RBBS-PC'S COPYRIGHT NOTICE ON THE LOCAL ' SYSOP'S SCREEN ' SUB COPYWRIT STATIC 97 WIDTH 80,25 CLS KEY OFF LOCATE ,,0 SNOOP = -1 LOCAL.USER = -1 CALL LPRNT(SPACE$(5) + "Copyright (c) 1983-89 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1) CALL DELAYIT (1) SNOOP = 0 END SUB ' $SUBTITLE: 'GETCOMND - subroutine to get command from command line' ' $PAGE ' ' SUBROUTINE NAME -- GETCOMND ' ' INPUT PARAMETERS -- PARAMETER MEANING ' CONFIG.FILENAME$ NAME OF RBBS-PC ".DEF" FILE TO ' USE AS A MODEL WHEN CREATING THE ' .DEF FILE NAME TO BE USED BY THIS ' COPY OF RBBS-PC. ' ' COMMAND LINE COMMAND LINE USED TO INVOKE ' RBBS-PC IN THE FORM: ' ' RBBS-PC.EXE x filename DEBUG /time /baud ' ' WHERE THE OPTIONAL PARAMETERS ARE: ' ' x IS THE NODE ID IN THE RANGE 1-9,0,A-Z ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE ' DEBUG IS A DEBUGGING SWITCH ' /time IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER ' /baud IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY ' ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING ' USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG ' PROGRAM ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER ' ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1. ' ' OUTPUT PARAMETERS -- CONFIG.FILENAME$ NAME OF RBBS-PC ".DEF" FILE FOR ' THIS COPY OF RBBS-PC TO USE ' NODE.RECORD.INDEX RECORD NUMBER WITHIN THE ' MESSAGES FILE FOR THIS "NODE" ' (RANGE IS 2 TO 36) ' ' SUBROUTINE PURPOSE -- TO GET NODE ID FROM COMMAND LINE ' SUB GETCOMND (PASSED.DEBUG,NETIME$,NETBAUD$,NETRELIABLE$) STATIC STATIC DEBUG ' ' * ' * GET NODE ID FROM COMMAND LINE * ' * ' PM$ = COMMAND$ CALL ALLCAPS(PM$) IF INSTR(PM$,"/") = 0 THEN _ GOTO 98 ' ' * ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL * ' * ' CMD.LINE$ = MID$(PM$,INSTR(PM$,"/")) PM$ = LEFT$(PM$,INSTR(PM$,"/") - 1) A = 0 FOR X = 1 TO LEN(CMD.LINE$) IF MID$(CMD.LINE$,X,1) = "/" THEN _ A = A + 1 : _ WORK.ARA$(A) = "" _ ELSE WORK.ARA$(A) = WORK.ARA$(A) + MID$(CMD.LINE$,X,1) NEXT NETIME$ = WORK.ARA$(1) IF A > 1 THEN _ NETBAUD$ = WORK.ARA$(2) IF A > 2 THEN _ NETRELIABLE$ = WORK.ARA$(3) CALL TRIM(NETIME$) CALL TRIM(NETBAUD$) CALL TRIM(NETRELIABLE$) 98 A = INSTR(PM$,"DEBUG") IF A > 0 THEN _ DEBUG = -1 : _ PM$ = LEFT$(PM$,A - 1) + _ RIGHT$(PM$,LEN(PM$) - A - 4) PASSED.DEBUG = DEBUG IF LEN(PM$) = 0 THEN _ PM$ = "-" NODE.RECORD.INDEX = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(PM$,1)) IF NODE.RECORD.INDEX < 2 THEN _ NODE.RECORD.INDEX = 2 NODE.ID$ = MID$(STR$(NODE.RECORD.INDEX-1),2) IF NODE.RECORD.INDEX > 10 THEN _ 'KG110201 NODE.FILE.ID$ = LEFT$(PM$,1) _ ELSE NODE.FILE.ID$ = NODE.ID$ IF NODE.ID$ <> "1" THEN _ LIBRARY.NODE.ID$ = NODE.FILE.ID$ IF LEN(PM$) > 2 AND MID$(PM$,2,1) = " " THEN _ CONFIG.FILENAME$ = MID$(PM$,3)_ ELSE MID$(CONFIG.FILENAME$,5,1) = PM$ ORIG.CONFIG$ = CONFIG.FILENAME$ END SUB ' $SUBTITLE: 'TRIM - subroutine to eliminate leading/trailing blanks' ' $PAGE ' ' SUBROUTINE NAME -- TRIM ' ' INPUT PARAMETERS -- PARAMETER MEANING ' TRIM.PARM$ STRING THAT IS TO HAVE LEADING ' AND TRAILING BLANKS ELIMINATED ' FROM ' ' OUTPUT PARAMETERS -- TRIM.PARM$ STRING WITH NO LEADING OR TRAIL- ' ING BLANKS ' ' SUBROUTINE PURPOSE -- TO STRIP LEADING AND TRAILING BLANKS ' SUB TRIM (TRIM.PARM$) STATIC 99 L = INSTR(TRIM.PARM$," ") IF L < 1 THEN _ EXIT SUB IF L = 1 THEN _ WHILE LEFT$(TRIM.PARM$,1) = " " : _ TRIM.PARM$ = RIGHT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1) : _ WEND CALL TRIMTRAIL (TRIM.PARM$," ") END SUB ' ' $SUBTITLE: 'TRIMTRAIL - subroutine to trim off trailing characters' ' $PAGE ' ' SUBROUTINE NAME -- TRIMTRAIL ' ' INPUT PARAMETERS -- PARAMETER MEANING ' TRIM.PARM$ TIME IN SECONDS AFTER MIDNIGHT TO WAIT ' BEFORE DISPLAYING ' TRIM.THIS$ WHAT CHARACTER TO TRIM OFF END ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN ' SUB TRIMTRAIL (TRIM.PARM$,TRIM.THIS$) STATIC WHILE RIGHT$(TRIM.PARM$,1) = TRIM.THIS$ TRIM.PARM$ = LEFT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1) WEND END SUB ' ' $SUBTITLE: 'VARINIT - subroutine to initialize system variables' ' $PAGE ' ' SUBROUTINE NAME -- VARINIT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' NONE ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO INITIAIZE SYSTEM VARIABLES ' SUB VARINIT STATIC 104 ACKNOWLEDGE$ = CHR$(6) ACKC$ = "C" + _ ACKNOWLEDGE$ ACTIVE.MENU$ = "B" ACTIVE.MESSAGE$ = CHR$(225) BACKSPACE$ = CHR$(8) + _ CHR$(32) + _ CHR$(8) BACK.ARROW$ = CHR$(29) + _ CHR$(32) + _ CHR$(29) BELL.RINGER$ = CHR$(7) BULLETIN.MENU$ = "" C.L = 24 CANCEL$ = CHR$(24) COLOR.RESET$ = CHR$(27) + _ "[00;37;40m" CONFIG.FILENAME$ = "RBBS-PC.DEF" CARRIAGE.RETURN$ = CHR$(13) DELETED.MESSAGE$ = CHR$(226) DOS.VERSION = 2 END.TRANSMISSION$ = CHR$(4) ESCAPE$ = CHR$(27) EXPECT.ACTIVE.MODEM = 0 FALSE = 0 F1.KEY = 59 F10.KEY = 68 GRN$ = "MAIN" CALL SETHILITE (TRUE) HOME.CONFERENCE$ = "" IN.CONF.MENU = -1 LIMIT.MINUTES.PER.SESSION! = 0 LINE.FEED$ = CHR$(10) LINE.FEEDS = NOT FALSE LINEEDIT.CHK$ = CHR$(9) + _ LINE.FEED$ + _ CHR$(11) + _ CHR$(12) + _ CHR$(127) + _ CHR$(8) + _ BELL.RINGER$ + _ CHR$(26) + _ CHR$(227) LINEMES$ = SPACE$(78) ' fixed length string workspace LOCK.STATUS$ = "UM UU UB UD" MENU.INDEX = 2 NEGATIVE.ACKNOWLEDGE$ = CHR$(21) NO.ADVANCE = FALSE PAGE.LENGTH = 23 PARSE.OFF = FALSE PRESS.ENTER$ = " (Press [ENTER] to quit)" PRESS.ENTER.EXPERT$ = " ([ENTER] quits)" PRESS.ENTER.NOVICE$ = PRESS.ENTER$ PRIVATE.DOOR = FALSE RIGHT.MARGIN = 72 RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + _ LINE.FEED$ SMART.TABLE$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _ "C1 C2 C3 C4 C0 DD BD DB UB DL UL NT" 'BK012901 START.OF.HEADER$ = CHR$(1) TIME.LOGGED.ON$ = SPACE$(8) TRUE = NOT FALSE UPINC = -1 XOFF$ = CHR$(19) XON$ = CHR$(17) INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$ OPTION.END$ = RETURN.LINE.FEED$ + " ,(" CRLF$ = CARRIAGE.RETURN$ + LINE.FEED$ LG$(1) = "Registration Check Failed" LG$(2) = "Sysop name attempted" LG$(3) = "Locked out attempt" LG$(4) = "Password Attempt Failed" LG$(5) = "Auto Lockout done" LG$(6) = "Name in use on another Node!" LG$(7) = "" LG$(8) = "Locked reason read!" LG$(9) = "Expired Registration" END SUB ' ' $SUBTITLE: 'SYSMENU - subroutine to display RBBS-PC SYSOP menu' ' $PAGE ' ' SUBROUTINE NAME -- SYSMENU ' ' INPUT PARAMETERS -- PARAMETER MEANING ' DELAY! TIME IN SECONDS AFTER MIDNIGHT TO WAIT ' BEFORE DISPLAYING ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN ' SUB SYSMENU STATIC DELAY! = 0 112 LOCAL.USER = TRUE SNOOP = TRUE NON.STOP = TRUE SUBROUTINE.PARAMETER = 1 WHILE SUBROUTINE.PARAMETER = 1 CALL CHECKTIM (DELAY!) WEND CLS STOP.INTERRUPTS = TRUE BYPASS.TIME.CHECK = TRUE CALL BUFFILE ("MENU0",X) NON.STOP = FALSE BYPASS.TIME.CHECK = FALSE LOCAL.USER = FALSE IF NOT OK THEN _ CALL LPRNT("MENU0 not on default drive",1) LOCATE 2,18 CALL LPRNT(LEFT$(VERSION.ID$,8),0) LOCATE 2,42 CALL LPRNT(NODE.ID$,0) LOCATE 2,60 X$ = DATE$ CALL LPRNT(LEFT$(X$,6) + RIGHT$(X$,2),0) LOCATE 2,74 CALL LPRNT(LEFT$(TIME$,5),0) IF FMS.DIRECTORY$ <> "" THEN _ LOCATE 6,76 : _ CALL LPRNT("YES",0) IF EXTENDED.LOGGING THEN _ LOCATE 8,76 : _ CALL LPRNT("YES",0) IF FOSSIL THEN _ LOCATE 10,76 : _ CALL LPRNT("YES",0) LOCATE 12,75 : _ CALL LPRNT(COM.PORT$,0) LOCATE 14,75 CALL LPRNT (STR$(CINT(FRE("A")/1024)) + "k",0) IF DEBUG THEN _ LOCATE 22,76 : _ CALL LPRNT("Yes",0) END SUB ' ' $SUBTITLE: 'EDITDEF - subrotuine to edit config parameters' ' $PAGE ' ' SUBROUTINE NAME -- EDITDEF ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ' OUTPUT PARAMETERS -- OUTPUT STRING ' ' SUBROUTINE PURPOSE -- Interpretes and adjusts stored configuration ' parameters ' 120 SUB EDITDEF STATIC ALL.OPTS$ = MAIN.COMMANDS$ + _ FILE.COMMANDS$ + _ UTIL.COMMANDS$ + _ LIBRARY.COMMANDS$ + _ GLOBAL.COMMANDS$ + _ SYSOP.COMMANDS$ HELP.EXTENSION$ = "." + _ HELP.EXTENSION$ BEG.MAIN = 1 BEG.FILE = LEN(MAIN.COMMANDS$) + BEG.MAIN BEG.UTIL = LEN(FILE.COMMANDS$) + BEG.FILE BEG.LIBRARY = LEN(UTIL.COMMANDS$) + BEG.UTIL HELP$(3) = HELP.PATH$ + _ HELP$(3) HELP$(4) = HELP.PATH$ + _ HELP$(4) HELP$(7) = HELP.PATH$ + _ HELP$(7) HELP$(9) = HELP.PATH$ + _ HELP$(9) CALL BRKFNAME (WELCOME.FILE$,WELCOME.FILE.DRV.PATH$,PREFIX$,_ EXTENSION$,TRUE) CALL ASCCODES ("[","]",DEFAULT.LINE.ACK$) CALL ASCCODES ("[","]",HOST.ECHO.ON$) CALL ASCCODES ("[","]",HOST.ECHO.OFF$) PERSONAL.DIR$ = PERSONAL.DRVPATH$ + _ PERSONAL.DIR$ CALL ASCCODES ("[","]",EMPHASIZE.OFF.DEF$) CALL ASCCODES ("[","]",EMPHASIZE.ON.DEF$) DR.1$ = FG.1.DEF$ DR.2$ = FG.2.DEF$ DR.3$ = FG.3.DEF$ DR.4$ = FG.4.DEF$ IF SUBROUTINE.PARAMETER = -62 THEN _ EXIT SUB LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1") ' KG110502 IF LOCAL.USER.MODE THEN _ ' KG110502 RECYCLE.TO.DOS = TRUE ' KG110502 ECHOER$ = DEFAULT.ECHOER$ SMART.TEXT$ = CHR$(SMART.TEXT) ' ' *** ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE *** * ' IF MAIN.FMS.DIRECTORY$ <> "" THEN _ FMS.DIRECTORY$ = DIRECTORY.PATH$ + _ MAIN.FMS.DIRECTORY$ + _ "." + _ MAIN.DIRECTORY.EXTENTION$ : _ ACTIVE.FMS.DIRECTORY$ = FMS.DIRECTORY$ : _ ' KG121902 LIBRARY.DIRECTORY$ = LIBRARY.DIRECTORY.PATH$ + _ MAIN.FMS.DIRECTORY$ + _ "." + _ LIBRARY.DIRECTORY.EXTENTION$ UPCAT.HELP$ = HELP.PATH$ + _ UPCAT.HELP$ + _ HELP.EXTENSION$ IF SUBDIR.COUNT < 1 THEN _ GOTO 123 FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT INPUT #2,SUBDIR$ IF RIGHT$(SUBDIR$,1) <> "\" THEN _ SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + _ "\" _ ELSE SUBDIR$(SUBDIR.INDEX) = SUBDIR$ NEXT GOTO 125 123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1 SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + _ ":" NEXT SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1 ' ' ***** SETUP UPLOAD DRIVE AND DIRECTORY.NAME **** ' 125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$ SUBDIR.COUNT = SUBDIR.COUNT + 1 IF UPLOAD.TO.SUBDIR THEN _ SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + _ "\" _ ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _ ":" UPLOAD.DIRECTORY$ = UPLOAD.DIRECTORY$ + _ "." + _ MAIN.DIRECTORY.EXTENTION$ CALL CHKNARY (SUBDIR$(SUBDIR.COUNT),SUBDIR$(),SUBDIR.COUNT-1,FOUND) CAN.DOWNLOAD.FROM.UP = (FOUND > 0) UPLOAD.DIRECTORY$ = UPLOAD.PATH$ + _ UPLOAD.DIRECTORY$ 126 CLOSE #2 IF LIBRARY.DRIVE$ <> "" THEN _ LIBRARY.TYPE = 1 SUBROUTINE.PARAMETER = -10 CALL CARRIER IF SUBROUTINE.PARAMETER = -1 THEN _ IF LIBRARY.DRIVE$ <> "" THEN _ CALL CHANGEDIR (LIBRARY.DRIVE$ + _ "\") : _ CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _ LIBRARY.NODE.ID$ + _ "DK*.ARC") : _ EC = 0 ' ' *** INITIALIZE OMNINET INTERFACE IF OMNINET IN USE *** * ' 128 IF NETWORK.TYPE = 2 THEN _ CN$ = SPACE$(535) : _ CALL INITIO(A) END SUB ' ' $SUBTITLE: 'ASCCODES - subrotuine to allow any ASCII codes' ' $PAGE ' ' SUBROUTINE NAME -- ASCCODES ' ' INPUT PARAMETERS -- PARAMETER MEANING ' LEFT.PAREN$ MARKS BEGINNING OF # ' RIGHT.PAREN$ MARKS END OF # ' STRNG$ INPUT STRING ' ' OUTPUT PARAMETERS -- STRNG$ OUTPUT STRING ' ' SUBROUTINE PURPOSE -- TO ALLOW A CONFIG STRING TO HAVE ANY ASCII VALUES. ' CHARACTERS NOT ENCLOSED TAKEN AS IS. ENCLOSED ' CHARACTERS INTERPRETED AS VALUE OF ASCII CODE. ' (I.E. "123[32]4" IS INTERPRETED AS "123 4"). ' 129 SUB ASCCODES (LEFT.PAREN$,RIGHT.PAREN$,STRNG$) STATIC IF LEN(STRNG$) < 1 THEN _ EXIT SUB STRT = 1 L = LEN(STRNG$) B$ = STRNG$ + _ LEFT.PAREN$ X = INSTR(B$,LEFT.PAREN$) NEW.STRNG$ = "" WHILE STRT <= L NEW.STRNG$ = NEW.STRNG$ + _ MID$(B$,STRT,X - STRT) Y = INSTR(X,B$,RIGHT.PAREN$) IF Y > 0 THEN _ K = VAL(MID$(B$,X + 1,Y - X - 1)) : _ NEW.STRNG$ = NEW.STRNG$ + _ CHR$(K) : _ STRT = Y + 1 _ ELSE NEW.STRNG$ = NEW.STRNG$ + _ MID$(B$,X,L + 1 - X) : _ STRT = L + 1 X = INSTR(STRT,B$,LEFT.PAREN$) WEND STRNG$ = NEW.STRNG$ END SUB ' $SUBTITLE: 'ANSWERIT - subroutine to answer the phone when it rings' ' $PAGE ' ' SUBROUTINE NAME -- ANSWERIT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' SUBROUTINE.PARAMETER = 1 WAIT FOR PHONE TO RING ' SUBROUTINE.PARAMETER = 2 CONTINUE LOOKING FOR CONNECT ' SUBROUTINE.PARAMETER = 3 RENTRY AFTER FUNCTION KEY ' SUBROUTINE.PARAMETER = 4 GO ON LINE IMMEDIATELY ' BG LOCAL DISPLAY'S BACKGROUND ' BORDER LOCAL DISPLAY'S BORDER COLOR ' COM.PORT$ COMMUNICATIONS PORT NAME ' COMPUTER.TYPE TYPE OF COMPUTER RUNNING ON ' DUMB.MODEM NON-HAYES TYPE MODEM FLAG ' EXTENDED.LOGGING EXTENDED CALLERS LOG FLAG ' FG LOCAL DISPLAY'S FOREGROUND ' MODEM.ANSWER.COMMAND$ COMMAND TO ANSWER PHONE ' MODEM.CONTROL.REGISTER LOCATION OF MODEM CNTRL. REG ' MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS ' MODEM.INIT.BAUD$ BAUDE AT WHICH TO OPEN COMM. ' MODEM.RESET.COMMAND$ COMMAND TO RESET THE MODEM ' MODEM.STATUS.REGISTER LOCATION OF MODEM STATUS REG ' PRINTER FLAG TO PRINT ON LOCAL PRT. ' REQUIRED.RINGS NUMBER OF RINGS TO ANSWER ON ' SNOOP FLAG TO DISPLAY ON LOCAL PC ' SYSOP.NEXT FLAG TO GIVE SYSOP CONTROL ' ' OUTPUT PARAMETERS -- BAUD.TEST BAUD RATE TO SET RS232 AT ' EIGHT.BIT PARITY INDICATOR ' RELIABLE.MODE INDICATES MODEM-SUPPLIED ' "ERROR-FREE" PROTOCOL ACTIVE ' SUBROUTINE.PARAMETER = 1 CARRIER DETECT FOUND (I.E. ' MODEM AUTO-ANSWERED). ' = 2 ANSWERED THE PHONE AND ' CARRIER DETECT OCCURRED. ' = 3 SYSOP HIT "ESC" KEY ON THE ' LOCAL KEYBOARD. ' = 4 ANSWERED THE PHONE BUT NO ' CARRIER WAS DETECTED. ' = 5 COMM. BUFFER OVERFLOW. ' = 6 FUNCTION KEY PRESSED ON THE ' LOCAL KEYBOARD. ' ' SUBROUTINE PURPOSE -- TO ANSWER THE TELEPHONE WHEN IT RINGS. ' SUB ANSWERIT STATIC EC = 0 RELIABLE.MODE = FALSE FF = SUBROUTINE.PARAMETER SUBROUTINE.PARAMETER = 0 ON FF GOTO 201,324,245,320 ' ' * ' * INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS * ' * ' 201 SUBROUTINE.PARAMETER = -10 CALL CARRIER IF SUBROUTINE.PARAMETER = 0 THEN _ GOTO 210 EXIT.TO.DOORS = FALSE PRIVATE.DOOR = FALSE ' ' * ' * RESET THE MODEM VIA THE MODEM CONTROL REGISTER TO ASSURE IT IS READY * ' * ' IF FOSSIL THEN _ STATE% = 0 : _ CALL FOSDTR(COMPORT%,STATE%) _ ELSE OUT MODEM.CONTROL.REGISTER,&H4 CALL DELAYIT (MODEM.INIT.WAIT.TIME) ' ' * ' * CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT * ' * ' IF FOSSIL THEN _ STATE% = 1 : _ CALL FOSDTR(COMPORT%,STATE%) _ ELSE OUT MODEM.CONTROL.REGISTER,&H0 CALL DELAYIT (MODEM.INIT.WAIT.TIME) 210 IF PRIVATE.DOOR THEN _ CALL TRANSFER : _ GOTO 235 CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1") 220 SUBROUTINE.PARAMETER = 1 CALL AMORPM 230 IF PRINTER THEN _ CALL PRINTIT (" RBBS-PC " + VERSION.ID$ + " Node " + _ NODE.ID$ + " up " + TIM$ + " on " + DATE$) 235 EIGHT.BIT = TRUE SUBROUTINE.PARAMETER = -10 CALL CARRIER IF SUBROUTINE.PARAMETER = 0 AND _ EXIT.TO.DOORS THEN _ CALL READPROF : _ SUBROUTINE.PARAMETER = 1 : _ GOTO 335 IF SUBROUTINE.PARAMETER = 0 AND _ EXPECT.ACTIVE.MODEM THEN _ BAUD.TEST = VAL(NETBAUD$) : _ CALL TESTREL (NETRELIABLE$) : _ GOTO 328 IF EXPECT.ACTIVE.MODEM OR _ EXIT.TO.DOORS THEN _ SUBROUTINE.PARAMETER = 4 : _ EXIT SUB IF SUBROUTINE.PARAMETER = 0 THEN _ GOTO 324 PCJR = FALSE IF COMPUTER.TYPE = 2 AND _ COM.PORT$ = "COM1" AND _ MODEM.STATUS.REGISTER = 1022 THEN _ MODEM.GO.OFFHOOK.COMMAND$ = CHR$(14) + _ "P" : _ PCJR = TRUE CALL SYSMENU IF PCJR THEN _ A$ = CHR$(14) + _ "I" _ ELSE A$ = MODEM.RESET.COMMAND$ CALL MODEMPUT (A$) CALL DELAYIT (MODEM.INIT.WAIT.TIME) IF PCJR THEN _ A$ = CHR$(14) + _ ' PC-JR'S MODEM COMMAND IDENTIFIER "C 0," + _ ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM "S 1," + _ ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM "H" _ ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY) ELSE A$ = MODEM.INIT.COMMAND$ CALL MODEMPUT (A$) IF PCJR THEN _ A$ = CHR$(14) + _ "F 4" : _ CALL MODEMPUT (A$) RINGBACK = FALSE LOCATE 16,55 IF REQUIRED.RINGS = 0 THEN _ CALL LPRNT("WAITING FOR CARRIER",0) : _ GOTO 237 IF MID$(MODEM.INIT.COMMAND$, _ INSTR(MODEM.INIT.COMMAND$,"S0") + 3,3) = "255" THEN _ CALL LPRNT("RING BACK SYSTEM",0) : _ RINGBACK = TRUE : _ GOTO 236 CALL LPRNT("WAITING FOR RING ",0) 236 LOCATE 16,76 : _ CALL LPRNT(MID$(STR$(REQUIRED.RINGS),2),0) 237 LOCATE 18,76 IF DOSANSI THEN _ CALL LPRNT(ESCAPE$ + "[05m" + "YES" + ESCAPE$ + "[00m",0) _ ELSE CALL LPRNT ("YES",0) COLOR FG,BG,BORDER LOCATE 20,56 ' ' * ' * GET READY TO ANSWER INCOMMING CALL: * ' * 1. LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC. * ' * REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND. * ' * 2. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS. * ' * REQUIRED RINGS > 0 AND S0 = 254 IN MODEM INIT COMMAND. * ' * 3. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER * ' * FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK). * ' * REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND. * ' * ' QQ = 255 I = INSTR(MODEM.INIT.COMMAND$,"S0") IF I = 0 OR PCJR THEN _ GOTO 239 IF VAL(MID$(MODEM.INIT.COMMAND$,I + 3,3)) = 255 THEN _ QQ = 0 : _ BLK = QQ CALL FINDTIME (TCA!) SUBROUTINE.PARAMETER = 1 CALL LINE25 RING.ANSWER = TRUE IF RINGBACK THEN _ RING.ANSWER = FALSE 239 RINGBACK.WAIT.STARTED! = 0 IF RINGBACK THEN _ CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _ COLOR 7,0,0 _ ELSE COLOR FG,BG,BORDER 240 IF SYSOP.NEXT THEN _ SUBROUTINE.PARAMETER = 3 : _ EXIT SUB ' ' * ' * WAIT FOR INCOMING CALLS * ' * ' SCREEN.ALREADY.CLEARED = FALSE 245 CALL SETABORT (INACTIVE.DELAY!, (60 * RECYCLE.WAIT)) NO.CALL = TRUE CALL FLUSHCOM (MODEM.RESPONSE$) MODEM.RESPONSE$ = "" WHILE INP(MODEM.STATUS.REGISTER) < 128 AND NO.CALL CALL FINDFUNC IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB 250 IF KEY.PRESSED$ = ESCAPE$ THEN _ SUBROUTINE.PARAMETER = 3 : _ EXIT SUB 260 IF RINGBACK.WAIT.STARTED! > 0 THEN _ CALL FINDTIME (TI!) : _ IF ABS(TI! - RINGBACK.WAIT.STARTED!) > 45 THEN _ RINGBACK.WAIT.STARTED! = 0 : _ RING.BACK.COUNT = 0 : _ RING.ANSWER = FALSE: _ IF RINGBACK THEN _ LOCATE 20,56 : _ CALL LPRNT("Ringback timeout" + PAGING.PRINTER.SUPPORT$,1) 265 CALL FINDTIME (TI!) IF ABS(TI! - TCA!) > 120 AND NOT SCREEN.ALREADY.CLEARED THEN _ LOCATE ,,0 : _ CLS : _ C.L = 1 : _ SCREEN.ALREADY.CLEARED = TRUE : _ CALL FINDTIME (TCA!) IF TIME.TO.DROP.TO.DOS! > 0 AND _ OLD.DAT$ <> DATE$ AND _ TI! < 86340 AND _ ' Skip btw 23:59 and 00:00 TI! => TIME.TO.DROP.TO.DOS! THEN _ SUBROUTINE.PARAMETER = 7 : _ EXIT SUB 266 IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _ REQUIRED.RINGS > 0 THEN _ GOTO 276 270 IF RECYCLE.WAIT > 0 THEN _ IF TI! > INACTIVE.DELAY! THEN _ SUBROUTINE.PARAMETER = 8 : _ EXIT SUB CALL FLUSHCOM (X$) IF LEN(X$) > 0 THEN _ MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$ : _ RING.DETECTED = (INSTR(MODEM.RESPONSE$,"RING") > 0) : _ CONNECT.DETECTED = (INSTR(MODEM.RESPONSE$,"ONNECT") > 0) : _ NO.CALL = (NOT RING.DETECTED) AND (NOT CONNECT.DETECTED) IF RING.DETECTED AND REQUIRED.RINGS > 0 THEN _ MID$(MODEM.RESPONSE$, INSTR(MODEM.RESPONSE$,"RING")+1,1) = "A" : _ RING.DETECTED = FALSE : _ GOTO 276 CALL GOIDLE WEND IF NOT RINGBACK THEN _ IF CONNECT.DETECTED THEN _ GOTO 321 IF REQUIRED.RINGS = 0 THEN _ CALL DELAYIT (3) : _ GOTO 321 ' ' * ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR * ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) -- * ' * "RING BACK." * ' * ' 276 CALL EOFCOMM (CHAR%) IF CHAR% <> -1 THEN _ CALL FLUSHCOM(X$) : _ IF SUBROUTINE.PARAMETER = - 1 THEN _ EXIT SUB IF PCJR THEN _ GOTO 320 A$ = MODEM.COUNT.RINGS.COMMAND$ CALL MODEMPUT (A$) CALL DELAYIT (MODEM.COMMAND.DELAY.TIME) 290 CALL FLUSHCOM(X$) IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB 291 IF LEN(X$) = 0 THEN _ GOTO 310 292 IF INSTR(X$,"0") < 1 THEN _ GOTO 293 X$ = MID$(X$,INSTR(X$,"0")) 293 IF (NOT RING.ANSWER) AND (VAL(X$) < RING.BACK.COUNT) THEN _ RING.ANSWER = TRUE 300 RING.BACK.COUNT = VAL(X$) Q = RING.BACK.COUNT + 1 IF (NOT RING.ANSWER) THEN _ Q = 0 305 LOCATE 20,56 CALL LPRNT(TIME$ + " Ring " + STR$(Q),0) 310 IF (RING.BACK.COUNT + 1 < REQUIRED.RINGS) OR _ (NOT RING.ANSWER) THEN _ GOTO 239 320 IF PCJR THEN _ A$ = CHR$(14) + _ ' PC-JR'S MODEM COMMAND IDENTIFIER "T 0," + _ ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY "M" _ ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE ELSE A$ = MODEM.ANSWER.COMMAND$ CALL MODEMPUT (A$) ' ' * ' * TEST FOR CARRIER PRESENT * ' * ' 321 CALL SETABORT (CONNECT.DELAY!,MAX.CARRIER.WAIT) IF CONNECT.DELAY! > 86399 THEN _ CONNECT.DELAY! = 86399 322 CALL FINDTIME (TI!) 323 SUBROUTINE.PARAMETER = -10 CALL CARRIER IF SUBROUTINE.PARAMETER AND _ TI! < CONNECT.DELAY! THEN _ GOTO 322 IF SUBROUTINE.PARAMETER THEN _ SUBROUTINE.PARAMETER = 4 : _ EXIT SUB CALL DELAYIT (3) 324 SUBROUTINE.PARAMETER = 0 IF TI! > CONNECT.DELAY! THEN _ CALL UPDTCALR ("Connect timeout",1) : _ SUBROUTINE.PARAMETER = 4 : _ EXIT SUB 325 CALL FLUSHCOM(X$) IF SUBROUTINE.PARAMETER = -1 THEN _ IF EC = 69 THEN _ SUBROUTINE.PARAMETER = 5 : _ EXIT SUB MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$ CALL FINDTIME (TI!) IF TI! > CONNECT.DELAY! THEN _ CALL UPDTCALR ("Connect timeout",1) : _ SUBROUTINE.PARAMETER = 4 : _ EXIT SUB IF DUMB.MODEM THEN _ BAUD.TEST = VAL(MODEM.INIT.BAUD$) : _ GOTO 327 IF INSTR(MODEM.RESPONSE$,"FAST") THEN _ BAUD.TEST = 19200 : _ GOTO 327 IF INSTR(MODEM.RESPONSE$,"ONNECT") THEN _ BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONNECT") + 7)) : _ GOTO 327 IF INSTR(MODEM.RESPONSE$,"ONLINE") THEN _ BAUD.TEST = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONLINE") + 7)) : _ GOTO 327 GOTO 324 327 CALL TESTREL (MODEM.RESPONSE$) 328 IF BAUD.TEST = 0 OR BAUD.TEST = 300 THEN _ BAUD.TEST = 300 : _ BPS = -1 : _ GOTO 331 IF BAUD.TEST = 1200 OR BAUD.TEST = 1275 THEN _ BPS = -3 : _ GOTO 331 IF BAUD.TEST = 2400 THEN _ BPS = -4 : _ GOTO 331 IF BAUD.TEST = 4800 OR BAUD.TEST = 9600 THEN _ BPS = -4-(BAUD.TEST /4800) : _ GOTO 331 IF BAUD.TEST = 19200 THEN _ BPS = -7 : _ GOTO 331 GOTO 324 331 CALL SETBAUD SUBROUTINE.PARAMETER = 2 335 DONT.WRITE = 0 END SUB ' $SUBTITLE: 'TESTREL - Test for Reliable mode connection' ' $PAGE ' ' SUBROUTINE NAME -- TESTREL ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRNG$ String to check for reliable ' ' OUTPUT PARAMETERS -- RELIABLE.MODE Reliable mode indicator ' ' SUBROUTINE PURPOSE -- TO TEST FOR RELIABLE CONNECT ' 336 SUB TESTREL (STRNG$) STATIC RELIABLE.MODE = FALSE IF STRNG$ = "" THEN _ EXIT SUB IF INSTR(STRNG$,"REL") OR _ INSTR(STRNG$,"R C") OR _ (ERROR CONTROL) INSTR(STRNG$,"ARQ") OR _ INSTR(STRNG$,"LAP") OR _ INSTR(STRNG$,"AFT") OR _ INSTR(STRNG$,"MNP") THEN _ RELIABLE.MODE = -1 END SUB ' $SUBTITLE: 'BADCHAR - subroutine to check user names for bad characters' ' $PAGE ' ' SUBROUTINE NAME -- BADCHAR ' ' INPUT PARAMETERS -- PARAMETER MEANING ' PASSED.NAME$ USER NAME ' ' OUTPUT PARAMETERS -- PASSED.NAME$ USER NAME WILL CONTAIN "" ' IF BAD CHARACTERS FOUND ' ' SUBROUTINE PURPOSE -- TO CHECK USER NAMES FOR INVALID CHARACTERS ' SUB BADCHAR (PASSED.NAME$) STATIC J = 1 XX = LEN(PASSED.NAME$) 457 IF J > XX THEN _ EXIT SUB X$ = MID$(PASSED.NAME$,J,1) IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",X$) = 0 THEN _ PASSED.NAME$ = "" : _ EXIT SUB J = J + 1 GOTO 457 END SUB ' $SUBTITLE: 'PASSWRD - verify User and Message passwords' ' $PAGE ' ' SUBROUTINE NAME -- PASSWRD ' ' INPUT PARAMETERS -- PARAMETER MEANING ' SUBROUTINE.PARAMETER = 1 VERIFY USER PASSWORD ' SUBROUTINE.PARAMETER = 2 VERIFY MESSAGE PASSWORD ' SUBROUTINE.PARAMETER = 3 VERIFY MESSAGE PASSWORD ' SUBROUTINE.PARAMETER = 4 VERIFY MESSAGE PASSWORD ' SUBROUTINE.PARAMETER = 5 VERIFY MESSAGE PASSWORD ' ' OUTPUT PARAMETERS -- PASSWORD.FAILED SET TO 0 IF PASSED ' SET TO -1 IF FAILED ' ' SUBROUTINE PURPOSE -- TO VERIFY USER AND MESSAGE PASSWORDS ' SUB PASSWRD STATIC EC = 0 ON SUBROUTINE.PARAMETER GOTO 665,667,670,675,677 665 IF PASSWORD.SAVE$ = PASSWORD$ THEN _ PASSWORD.FAILED = 0 : _ EXIT SUB 667 ATTEMPTS = 0 670 ATTEMPTS = ATTEMPTS + 1 IF ATTEMPTS > ATTEMPTS.ALLOWED THEN _ PASSWORD.FAILED = TRUE : _ EXIT SUB 675 A$ = "Enter Password (dots echo)" HIDDEN = TRUE SUBROUTINE.PARAMETER = 1 CALL TGET IF SUBROUTINE.PARAMETER < 0 THEN _ ' KG122504 PASSWORD.FAILED = TRUE : _ ' KG122504 EXIT SUB ' KG122504 HIDDEN = FALSE Z$ = B$ 677 IF LEN(Z$) > 15 THEN _ GOTO 680 IF EC <> 0 THEN _ GOTO 670 CALL ALLCAPS (Z$) Z$ = Z$ + SPACE$(15 - LEN(Z$)) IF PASSWORD.SAVE$ = Z$ THEN _ PASSWORD.FAILED = 0 : _ A$ = "" : _ 'PE 11/11/88 EXIT SUB 680 CALL QTPUT("Wrong password ",1) IF NOT MESSAGE.PASSWORD THEN _ CALL UPDTCALR (ACTIVE.USER.NAME$+" PW fail: " + Z$,1) GOTO 670 END SUB ' $SUBTITLE: 'LINE25 - subroutine to build/display RBBS-PCs line 25' ' $PAGE ' ' SUBROUTINE NAME -- LINE25 ' ' INPUT PARAMETERS -- PARAMETER MEANING ' SUBROUTINE.PARAMETER = 1 BUILD DISPLAY FOR LINE 25 ' SUBROUTINE.PARAMETER = 2 UPDATE LINE 25 ' LOCK.STATUS$ STATUS OF LOCKS IN A MULTI- ' USER ENVIRONMENT OR TIME OF ' DAY USER LOGGED ON OR THE ' RE-CYCLED ' ' OUTPUT PARAMETERS -- CURSOR.LINE CURRENT LINE ON SCREEN ' CURSOR.ROW CURRENT ROW ON CURSOR.LINE ' ' SUBROUTINE PURPOSE -- TO BUILD OR UPDATE RBBS-PC'S LINE 25 DISPLAYED ' ON THE PC SCREEN THAT IS RUNNING RBBS-PC. ' SUB LINE25 STATIC IF SUBROUTINE.PARAMETER = 2 THEN _ GOTO 950 ' ' * ' * BUILD LINE 25 DISPLAY * ' * ' 949 LINE.25$ = "Node " + _ NODE.ID$ + " " + _ PAGE.STATUS$ + " " + _ MID$(" AVL ",1 - 4 * SYSOP.AVAILABLE,4) + _ MID$(" ANY ",1 - 4 * SYSOP.ANNOY,4) + _ MID$(" LPT ",1 - 4 * PRINTER,4) + _ MID$("SYS",1,-3 * SYSOP.NEXT) + _ MID$(" XOFF",1,-5 * XOFF.ED) + _ MID$(" CTS",1,-4 * NOT.CTS) ' ' * ' * LINE 25 UPDATE ROUTINE * ' * ' 950 IF NOT SNOOP THEN _ EXIT SUB CURSOR.LINE = CSRLIN CURSOR.ROW = POS(0) HH = LEN(ACTIVE.USER.NAME$) + _ LEN(CI$) + _ LEN(LINE.25$) + _ LEN(STR$(USER.SECURITY.LEVEL)) + _ 18 ' IF AUTODOWNLOAD.AVAILABLE THEN _ ' HH = HH + 4 LOCATE 25,1 IF NETWORK.TYPE = 0 THEN _ LOCK.STATUS$ = SPACE$(3) + _ TIME.LOGGED.ON$ IF HH > 79 THEN _ HH = 78 LINE.25.HOLD$ = LINE.25$ + _ SPACE$(79 - HH) + _ STR$(USER.SECURITY.LEVEL) + _ " " + _ ACTIVE.USER.NAME$ + _ " " + _ CI$ + _ " " + _ LOCK.STATUS$ CALL LPRNT(LINE.25.HOLD$,0) LOCATE CURSOR.LINE,CURSOR.ROW END SUB ' $SUBTITLE: 'SRCHCMND - subroutine to search command list' ' $PAGE ' ' SUBROUTINE NAME -- SRCHCMND ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRT.POS POSITION TO BEGIN SEARCH AT ' ALL.OPTS$ STRING TO SEARCH (COMMAND LIST) ' Z$ WHAT TO LOOK FOR ' ' OUTPUT PARAMETERS -- WHERE.FOUND POSITION OF Z$ IN ALL.OPTS$ ' 0 IF NOT FOUND ' ' SUBROUTINE PURPOSE -- SEARCHES VALID COMMAND LIST FOR THE REQUESTED ' COMMAND. IF THE SYSOP HAS CONFIGURED RBBS-PC TO ' RESTRICT COMMANDS TO ONLY THOSE VALID WITHIN THE ' RBBS-PC SUBSYSTEM, THEN ONLY THOSE COMMANDS AND ' "GLOBAL" COMMANDS ARE VALID. OTHERWISE ALL COMMANDS ' ARE VALID FROM ANY OF THE RBBS-PC SUBSYSTEMS. ' SUB SRCHCMND (STRT.POS,WHERE.FOUND) STATIC 1240 IF LEN(Z$) < 1 THEN _ WHERE.FOUND = 0 : _ EXIT SUB CALL ALLCAPS (Z$) 'KG111104 Y$ = LEFT$(Z$,1) WHERE.FOUND = INSTR(STRT.POS,ALL.OPTS$,Y$) IF WHERE.FOUND = 0 THEN _ 'Not found: decide whether to hunt further IF STRT.POS < 2 OR RESTRICT.VALID.CMDS THEN _ GOTO 1242 _ ' fully searched or restricted ELSE WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _ 'hunt further GOTO 1242 IF WHERE.FOUND => BEG.LIBRARY THEN _ IF WHERE.FOUND < LEN(ALL.OPTS$) - 11 THEN _ IF LIBRARY.TYPE = 0 THEN _ WHERE.FOUND = INSTR(WHERE.FOUND+1,ALL.OPT$,Y$) : _ IF WHERE.FOUND = 0 THEN _ WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _ IF WHERE.FOUND >= BEG.LIBRARY OR WHERE.FOUND = 0 THEN _ WHERE.FOUND = 0 : _ GOTO 1242 IF NOT RESTRICT.VALID.CMDS THEN _ GOTO 1242 ' everything found valid ' ' * ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP) * ' * ' IF WHERE.FOUND > LEN(ALL.OPTS$) - 11 THEN _ IF USER.SECURITY.LEVEL < OPT.SEC(WHERE.FOUND) THEN _ WHERE.FOUND = 0 : _ EXIT SUB _ ELSE EXIT SUB IF MID$(ORIG.COMMANDS$,WHERE.FOUND,1) = "G" THEN _ EXIT SUB ' ACCEPT GOODBYE/GRAPHICS IF (WHERE.FOUND < STRT.POS) OR _ (STRT.POS < BEG.FILE AND WHERE.FOUND => BEG.FILE ) OR _ (STRT.POS < BEG.UTIL AND WHERE.FOUND => BEG.UTIL ) OR _ (STRT.POS < BEG.LIBRARY AND WHERE.FOUND => BEG.LIBRARY ) THEN _ WHERE.FOUND = 0 ' REJECT: NOT IN SECTION 1242 IF WHERE.FOUND > 0 AND LEN(Z$) = 1 THEN _ EXIT SUB CALL CHKMACRO (Z$,FOUND) IF FOUND THEN _ GOTO 1240 END SUB ' $SUBTITLE: 'CHKMACRO - subroutine to check if macro exits and process' ' $PAGE ' ' SUBROUTINE NAME -- CHKMACRO ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRNG$ STRING TO CHECK IF IS A MACRO ' MACRO.DRVPATH$ DRIVE/PATH WHERE MACROS ARE ' MACRO.EXTENSION$ EXTENSION OF MACROS ' ' OUTPUT PARAMETERS - MACRO.FOUND WHETHER A MACRO WAS FOUND ' STRNG$ SUBSTITUTE FOR COMMANDS ' COMMPORT.STACK$ REST OF MACRO ' 0 IF NOT FOUND ' ' SUBROUTINE PURPOSE -- MACRO FILE IS CHECKED FOR SECURITY (1ST LINE). ' 2ND LINE IS SUBSTITUTED FOR PASSED STRING ' AND PARSED. REMAINING PART OF MACRO PUT INTO ' STACK TO BE EXECUTED. ' SUB CHKMACRO (STRNG$,MACRO.FOUND) STATIC MACRO.FOUND = FALSE FILNAME$ = MACRO.DRVPATH$ + STRNG$ + MACRO.EXTENSION$ CALL BADFILE (FILNAME$,A) IF A > 1 THEN _ EXIT SUB CALL FINDIT (FILNAME$) IF NOT OK THEN _ EXIT SUB CALL READDIR (1) IF EC > 0 THEN _ EXIT SUB CALL CHECKINT (A$) IF EC > 0 OR USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _ EXIT SUB CALL READDIR (1) IF EC > 0 THEN _ EXIT SUB MACRO.FOUND = TRUE STRNG$ = A$ B$ = STRNG$ CALL PARSEIT Y$ = "" WHILE NOT EOF(2) CALL READDIR (1) Y$ = Y$ + A$ + CARRIAGE.RETURN$ WEND COMMPORT.STACK$ = COMMPORT.STACK$ + Y$ END SUB ' $SUBTITLE: 'VIEWHELP - Processes requests for help' ' $PAGE ' ' SUBROUTINE NAME -- VIEWHELP ' ' INPUT PARAMETERS -- PARAMETER MEANING ' SECTION ORDER OF 1ST COMMAND IN CURRENT ' SECTION ' GRAPHICS.DEFAULT WHAT GRAPHICS TYPE USER WANTS ' HELP.DEFAULT$ HELP GET IF PRESS ENTER ' HELP.PATH$ ' HELP.EXTENSION$ ' BEG.FILE ' BEG.MAIN ' BEG.UTIL ' BEG.LIBRARY ' ' OUTPUT PARAMETERS -- DISPLAYS HELP ' ' SUBROUTINE PURPOSE -- THE MAIN HELP PROCESSOR FOR RBBS. PUTS UP THE ' OPTIONAL MENU. ACCEPTS HELP WITH INDIVIDUAL SUB VIEWHELP (SECTION,GRAPHIC.DEFAULT$,HELP.DEFAULT$) STATIC 1330 HELP.MENU$ = HELP.PATH$ + _ "HELP" + _ HELP.EXTENSION$ GOT.MENU = TRUE IF Q > 1 THEN _ ANS.INDEX = 2 : _ LAST.INDEX = Q: _ FAST.HELP = TRUE : _ GOTO 1332 1331 IF GOT.MENU THEN _ FILE.NAME$ = HELP.MENU$ : _ GOSUB 1350 : _ GOT.MENU = FALSE ANS.INDEX = 1 A$ = "Help with what Command (or TOPIC name)" + _ PRESS.ENTER.EXPERT$ SUBROUTINE.PARAMETER = 1 CALL TGET IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB IF Q = 0 THEN _ EXIT SUB LAST.INDEX = Q 1332 Z$ = B$(ANS.INDEX) CALL ALLCAPS (Z$) IF Z$ = "?" THEN _ Z$ = "H" CALL BADFILE (Z$,BAD.FILE.NAME.INDEX) ON BAD.FILE.NAME.INDEX GOTO 1333,1340,1340 1333 IF LEN(Z$) = 1 THEN _ CALL SRCHCMND (SECTION,FF) : _ IF FF < 1 THEN _ OK = FALSE : _ GOTO 1334 _ ELSE X = - (FF => BEG.MAIN) - (FF => BEG.FILE) - (FF => BEG.UTIL) - (FF => BEG.LIBRARY) : _ Z$ = MID$("MFU@",X,1) + _ MID$(ORIG.COMMANDS$,FF,1) FILE.NAME$ = HELP.PATH$ + _ Z$ + _ HELP.EXTENSION$ GOSUB 1350 1334 IF NOT OK THEN _ A$ = "No help for " + _ Z$ : _ CALL QTPUT (A$,1) : _ CALL UPDTCALR (A$,2) ANS.INDEX = ANS.INDEX + 1 IF ANS.INDEX <= LAST.INDEX THEN _ GOTO 1332 IF FAST.HELP THEN _ FAST.HELP = FALSE : _ EXIT SUB GOTO 1331 1340 OK = FALSE GOTO 1334 1350 CALL GRAPHIC (GRAPHIC.DEFAULT$) CALL BUFFILE (FILE.NAME$,X) RETURN END SUB ' $SUBTITLE: 'VIOLATION - handles all security violations' ' $PAGE ' ' SUBROUTINE NAME -- SVIOLATION ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ' OUTPUT PARAMETERS -- CURSOR.LINE CURRENT LINE ON SCREEN ' CURSOR.ROW CURRENT ROW ON CURSOR.LINE ' ' SUBROUTINE PURPOSE -- INFORM CALLER OF SECURITY VIOLATION, AUGMENT COUNT OF ' VIOLATIONS AND DETERMINE WHETHER TOO MANY OCCURRED. ' 1380 SUB SVIOLATION STATIC CALL BUFFILE (SECVIO.HLP$,X) IF NOT OK THEN _ CALL QTPUT ("Sorry, " + FIRST.NAME$ + ", Security is to low for this feature",1) CALL UPDTCALR ("SV!-" + VIOLATION$,2) VIOLATIONS.THIS.SESSION = VIOLATIONS.THIS.SESSION + 1 IF MAXIMUM.VIOLATIONS = 0 OR VIOLATIONS.THIS.SESSION <= MAXIMUM.VIOLATIONS THEN _ EXIT SUB 1385 IF USER.FILE.INDEX < 1 THEN _ EXIT SUB A$ = "TO MANY SECURITY VIOLATIONS! Sysop can reinstate" IF USER.SECURITY.LEVEL <= MINIMUM.LOGON.SECURITY THEN _ A$ = "" : _ USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - 1 _ ELSE USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY DENY.ACCESS = TRUE END SUB ' $SUBTITLE: 'DENYACCESS - subroutine to build/display RBBS-PCs line 25' ' $PAGE ' ' SUBROUTINE NAME -- DENYACCESS ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ' OUTPUT PARAMETERS -- (USER'S RECORD) ' ' SUBROUTINE PURPOSE -- PERMANENTLY RESETS USER'S SECURITY LEVEL ' WHEN DENIED ACCESS ' SUB DENYACCESS STATIC 1386 CALL TPUT LOGON.ERROR.INDEX = 5 SUBROUTINE.PARAMETER = 6 CALL FILELOCK CALL OPENUSER (HIGHEST.USER.RECORD) FIELD 5, 128 AS USER.RECORD$ GET 5,USER.FILE.INDEX MID$(USER.RECORD$,47,2) = MKI$(USER.SECURITY.LEVEL) PUT 5,USER.FILE.INDEX SUBROUTINE.PARAMETER = 8 CALL FILELOCK END SUB ' $SUBTITLE: 'TPUT -- RBBS-PC common routine to write to comm. port' ' $PAGE ' ' SUBROUTINE NAME -- TPUT (TERMINAL PUT) ' ' INPUT PARAMETERS -- PARAMETER MEANING ' A$ STRING TO WRITE TO THE ' COMMUNICATIONS PORT ' SUBROUTINE.PARAMETER = 1 SKIP A LINE BEFORE WRITING ' TO THE COMMUNICATIONS PORT ' SUBROUTINE.PARAMETER = 2 SKIP A LINE BEFORE WRITING ' TO THE COMMUNICATIONS PORT ' AND THEN SKIP TWO LINES ' AFTER WRITING TO THE COMM- ' UNICATIONS PORT ' SUBROUTINE.PARAMETER = 3 WRITE TO THE COMMUNICATIONS ' PORT AND THEN SKIP TWO ' LINES ' SUBROUTINE.PARAMETER = 4 WRITE TO THE COMMUNICATIONS ' PORT WITHOUT A CR/LF ' SUBROUTINE.PARAMETER = 5 WRITE TO THE COMMUNICATIONS ' PORT WITH A CR/LF ' SUBROUTINE.PARAMETER = 6 RESET EVERYTHING FOR INPUT ' STRING ' SUBROUTINE.PARAMETER = 7 RE-ENTRY AFTER HANDLING A ' FUNCTION KEY ' ' OUTPUT PARAMETERS -- SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED ' FUNCTION.KEY <> 0 FUNCTION KEY PRESSED ' ' SUBROUTINE PURPOSE -- COMMON OUTPUT ROUTINE FOR RBBS-PC TO THE ' COMMUNICATIONS PORT (TERMINAL PUT) SUB TPUT STATIC IF SUBROUTINE.PARAMETER <> 7 THEN _ PARM = SUBROUTINE.PARAMETER ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411 ' ' * ' * COMMON OUTPUT ROUTINE * ' * ' 1398 CALL SKIPLINE (1) GOTO 1405 1399 CALL SKIPLINE (1) 1400 CR = 1 1403 CR = CR + 1 1405 RET = FALSE IF CM THEN _ GOTO 1435 1410 CALL FINDFUNC IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB 1411 Y$ = KEY.PRESSED$ SUBROUTINE.PARAMETER = PARM IF LOCAL.USER THEN _ GOTO 1430 CALL EOFCOMM (CHAR%) IF CHAR% = -1 THEN _ CALL CARRIER : _ IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB _ ELSE GOTO 1430 CALL GETCOM(Y$) 1425 IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB 1430 IF Y$ = "" THEN _ GOTO 1435 ON INSTR(INTERRUPT.ON$,Y$) GOTO 1434,1434,1473,1475,1433 GOSUB 1476 GOTO 1435 1433 GOSUB 1476 IF ASC(RIGHT$(COMMPORT.STACK$,2)) = 13 OR _ STOP.INTERRUPTS THEN _ GOTO 1435 'stack if series of [ENTER]s or no previous stack GOTO 1471 1434 IF STOP.INTERRUPTS THEN _ GOTO 1435 COMMPORT.STACK$ = "" IF FOSSIL THEN _ CALL FOSTXPURGE(COMPORT%) : _ CALL FOSRXPURGE(COMPORT%) GOTO 1471 1435 LOCATE ,,1 CALL LPRNT (A$,0) 'KG122404 1437 IF UPPER.CASE THEN _ IF GR <> 2 THEN _ CALL ALLCAPS (A$) CALL PUTCOM (A$) 1450 IF CR <> 1 THEN _ CALL SKIPLINE (1) _ ELSE IF CR > 1 THEN _ CALL SKIPLINE (1) 1470 CR = 0 TOA! = FRE("A") EXIT SUB 1471 CALL SKIPLINE (1) STOP.INTERRUPTS = FALSE RET = TRUE NON.STOP = FALSE GOTO 1470 1473 XOFF.ED = TRUE GOTO 1410 1475 XOFF.ED = FALSE GOTO 1410 1476 IF ASC(Y$) < 127 THEN _ COMMPORT.STACK$ = COMMPORT.STACK$ + Y$ RETURN END SUB ' $SUBTITLE: 'QTPUT - subroutine to quickly write to terminal' ' $PAGE ' ' SUBROUTINE NAME -- QTPUT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRNG$ STRING TO WRITE OUT ' NUM.RETURNS NUMBER OF CARRIAGE RETURNS ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- SUBROUTINE TO QUICKLY WRITE TO THE TERMINAL. THIS IS ' IS DIFFERENT FROM "TPUT" IN THE THINGS IT DOESN'T DO: ' A.) NO FUNCTION KEY CHECK, ' B.) NO CONVERSION TO UPPER CASE, ' C.) NO STRING RE-INITILIZATION OF "STRNG$", ' D.) NO CHECK FOR CARRIER PRESENT, AND ' E.) NO CHECK FOR IMBEDDED CARRIAGE RETURN IN ' "STRNG$". ' F.) NO SUPPORT FOR XON/XOFF ' SUB QTPUT (STRNG$,NUM.RETURNS) STATIC IF USE.TPUT THEN _ A$ = STRNG$ : _ SUBROUTINE.PARAMETER = 4 : _ CALL TPUT : _ CALL SKIPLINE (NUM.RETURNS) : _ EXIT SUB CALL PUTCOM (STRNG$) LOCATE ,,1 CALL LPRNT (STRNG$,0) ' KG122404 CALL SKIPLINE (NUM.RETURNS) END SUB ' $SUBTITLE: 'LPRNT - subroutine to write to display' ' $PAGE ' ' SUBROUTINE NAME -- LPRNT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRNG$ STRING TO WRITE OUT ' NUM.RETURNS NUMBER OF CARRIAGE RETURNS ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- SUBROUTINE TO WRITE TO THE DISPLAY. ' 1480 SUB LPRNT (STRNG$,NUM.RETURNS) STATIC IF NOT SNOOP THEN _ EXIT SUB CALL PSCRN (STRNG$) IF USE.BASIC.WRITES THEN _ FOR I = 1 TO NUM.RETURNS : _ PRINT : _ NEXT : _ ELSE FOR I = 1 TO NUM.RETURNS : _ LOCATE ,,1 : _ CALL ANSI(CRLF$,C.L,C.C) : _ LOCATE C.L,C.C : _ NEXT END SUB ' $SUBTITLE: 'QLPRNT - subroutine to quickly write to display' ' $PAGE ' ' SUBROUTINE NAME -- QLPRNT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRNG$ STRING TO WRITE OUT ' NUM NUMBER OF CARRIAGE RETURNS ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- SUBROUTINE TO QUICKLY WRITE TO THE DISPLAY. ' OVERWRITES, AND PUTS UP COUNT SUB QLPRNT (STRNG$,NUM) STATIC LOCATE ,1,1 CALL LPRNT (STRNG$ + STR$(NUM),0) ' KG122405 END SUB ' $SUBTITLE: 'PSCRN - subroutine to print to the screen' ' $PAGE ' ' SUBROUTINE NAME -- PSCRN ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRNG$ STRING TO WRITE OUT ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- Assumes you already have positioned ' cursor where you want. ' SUB PSCRN (STRNG$) STATIC 'KG120905 IF STRNG$ = "" THEN _ EXIT SUB IF USE.BASIC.WRITES THEN _ PRINT STRNG$; _ ELSE CALL ANSI (STRNG$,C.L,C.C) : _ LOCATE C.L,C.C END SUB ' $SUBTITLE: 'SKIPLINE - subroutine to write a blank line to user' ' $PAGE ' ' SUBROUTINE NAME -- SKIPLINE ' ' INPUT PARAMETERS -- PARAMETER MEANING ' LOCAL.USER ' MODEM.STATUS.REGISTER ' NUM.RETURNS ' RETURN.LINE.FEED$ ' SNOOP ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- SKIP A LINE ON THE USER'S TERMINAL ' SUB SKIPLINE (NUM.RETURNS) STATIC 1485 FOR I=1 TO NUM.RETURNS CALL PUTCOM (RETURN.LINE.FEED$) NEXT IF NOT SNOOP THEN _ GOTO 1486 IF USE.BASIC.WRITES THEN _ FOR I = 1 TO NUM.RETURNS : _ PRINT : _ NEXT : _ ELSE FOR I = 1 TO NUM.RETURNS : _ LOCATE ,,1 : _ CALL ANSI(CRLF$,C.L,C.C) : _ LOCATE C.L,C.C : _ NEXT 1486 LINES.PRINTED = LINES.PRINTED + NUM.RETURNS UNIT.COUNT = UNIT.COUNT - DISPLAY.AS.UNIT * NUM.RETURNS END SUB ' $SUBTITLE: 'SETCRLF -- subroutine to set up nulls/lf's for output' ' $PAGE ' ' SUBROUTINE NAME -- SETCRLF ' ' INPUT PARAMETERS -- PARAMETER MEANING ' CARRIAGE.RETURN$ CARRIAGE RETURN CHARACTER ' LINE.FEED$ LINE FEED CHARACTER ' LINE.FEEDS LINE FEED SWITCH ' NUL$ NULL CHARACTER ' ' OUTPUT PARAMETERS -- RETURN.LINE.FEED$ END-OF-LINE STRING ' ' SUBROUTINE PURPOSE -- SET UP THE NECESSARCY NULLS/LINE FEEDS TO END ' EACH OUTPUT TO THE COMMUNICATIONS PORT WITH ' SUB SETCRLF STATIC 1496 RETURN.LINE.FEED$ = _ MID$(CARRIAGE.RETURN$,1, - (NOT LOCAL.USER)) + _ NUL$ + _ MID$(LINE.FEED$,1, - (LINE.FEEDS <> 0)) END SUB ' $SUBTITLE: 'TGET -- RBBS-PC common routine to ask a user a question' ' $PAGE ' ' SUBROUTINE NAME -- TGET ' ' INPUT PARAMETERS -- PARAMETER MEANING ' SUBROUTINE.PARAMETER = 1 STANDARD ENTRY ' SUBROUTINE.PARAMETER = 2 ENTRY AFTER A FUNCTION KEY ' HAS BEEN HANDLED ' A$ STRING TO WRITE TO THE ' COMMUNICATIONS PORT ' HIDDEN IF THIS IS TRUE THEN ECHO ' '.' INSTEAD OF ACTUAL ' CHARACTER ENTERED. ' FORCE.KEYBOARD IF TRUE, STACKED INPUT ' IS BYPASSED AND KEYBOARD ' INPUT IS READ. ' ' OUTPUT PARAMETERS -- SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED ' B$ STRING THAT WAS ENTERED ' Q NUMBER OF PARAMETERES THAT ' WERE ENTERED WHICH WHERE ' SEPARATED BY A SEMICOLON ' B$() STRING MATRIX WITH EACH ' ITEM CONTAIN THE STRING ' THAT WAS ENTERED BETWEEN ' SEMICOLONS. ' FUNCTION.KEY <> 0 FUNCTION KEY PRESSED ' YES REPLY IS "Y" OR "YES" ' NO REPLY IS "N" OR "NO" ' NON.STOP REPLY IS "NS" OR "ns" ' KILL.MESSAGE REPLY IS "K" ' REPLY REPLY IS "RE" ' ' SUBROUTINE PURPOSE -- COMMON ROUTINE TO ASK A USER A QUESTION ' SUB TGET STATIC ON SUBROUTINE.PARAMETER GOTO 1500,1526 ' ' * ' * COMMON INPUT ROUTINE * ' * ' 1500 CALL CARRIER IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB LINES.PRINTED = 0 DISPLAY.AS.UNIT = FALSE TOA! = FRE("A") CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT) AUTO.WARN! = AUTO.LOGOFF! - 30 A = 0 B = 0 C = 0 Q = 1 PARM = 0 EOL = FALSE YES = FALSE B$ = "" SLEEP.WARN = TRUE NO = FALSE CALL COLORPMT (A$) A$ = A$ + _ MID$("? ! ",2*TURBO.KEY+1,2) SUBROUTINE.PARAMETER = 4 STOP.SAVE = STOP.INTERRUPTS STOP.INTERRUPTS = TRUE CALL TPUT STOP.INTERRUPTS = STOP.SAVE IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _ EXIT SUB 1523 IF PROMPT.BELL THEN _ IF LOCAL.USER THEN _ BEEP_ ELSE CALL PUTCOM(BELL.RINGER$) 1525 CALL CARRIER IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB IF (NOT FORCE.KEYBOARD) AND LEN(COMMPORT.STACK$) > 0 THEN _ Y$ = LEFT$(COMMPORT.STACK$,1) : _ COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _ GOTO 1541 IF LOCAL.USER THEN _ CALL FINDFUNC: _ IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB _ ELSE GOTO 1526 CALL EOFCOMM (CHAR%) IF CHAR% <> -1 THEN _ CALL GETCOM(Y$) : _ IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB _ ELSE GOTO 1541 CALL FINDTIME (TI!) IF TI! > AUTO.WARN! THEN _ IF TI! > AUTO.LOGOFF! THEN _ CALL UPDTCALR ("Sleep Disconnect",1) :_ SUBROUTINE.PARAMETER = -1 : _ EXIT SUB _ ELSE IF SLEEP.WARN THEN _ SLEEP.WARN = FALSE : _ A$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _ CALL RINGCALLER CALL FINDFUNC IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB 1526 Y$ = KEY.PRESSED$ IF Y$ <> "" THEN _ GOTO 1545 SEND.REMOTE = TRUE CALL GOIDLE GOTO 1525 1541 SEND.REMOTE = REMOTE.ECHO IF TEST.PARITY THEN _ GOTO 1542 IF Y$ = CHR$(127) THEN _ GOTO 1635 GOTO 1545 1542 IF Y$ = "" THEN _ Y$ = " " IF ASC(Y$) = 141 THEN _ OUT LINE.CONTROL.REGISTER,&H1A : _ EIGHT.BIT = FALSE : _ TEST.PARITY = FALSE : _ GR = FALSE Y$ = CHR$(ASC(Y$) AND 127) 1545 X$ = Y$ 'KG101503 IF INSTR(LINEEDIT.CHK$,Y$) > 5 _ GOTO 1635 IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _ GOTO 1525 IF Y$ = "^" THEN _ GOTO 1525 IF Y$ = CARRIAGE.RETURN$ THEN _ GOTO 1547 _ ELSE GOSUB 1550 IF TURBO.KEY < 1 THEN _ GOTO 1546 IF Y$ = " " THEN _ Y$ = "" IF Y$ <> "/" THEN _ B$ = Y$ : _ Y$ = CARRIAGE.RETURN$ : _ X$ = Y$ : _ 'KG101601 GOTO 1547 TURBO.KEY = 0 GOTO 1525 1546 IF LEN(B$) => 254 THEN _ A$ = "Input too long!" : _ SUBROUTINE.PARAMETER = 5 : _ CALL TPUT : _ IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _ EXIT SUB _ ELSE GOTO 1500 B$ = B$ + _ Y$ GOTO 1525 1547 TURBO.KEY = FALSE ' Carriage Return Handler HIDDEN = FALSE IF NO.ADVANCE THEN _ NO.ADVANCE = FALSE : _ GOTO 1575 _ ELSE CALL LPRNT (CRLF$,0) : _ GOSUB 1551 : _ GOTO 1570 1550 IF LOGON.ACTIVE THEN _ ' KG101503 IF (Y$ = " " OR Y$ = ";") AND _ ' KG101503 RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _ ' KG101503 PARM = PARM + 1 : _ ' KG101503 LOGON.ACTIVE = (PARM < 3) : _ ' KG101503 HIDDEN = (PARM = 2) : _ ' KG101503 CALL LPRNT(X$,0) : _ ' KG101503 GOTO 1551 ' KG101503 'Was IF HIDDEN AND LOCAL.USER THEN..... IF HIDDEN THEN _ 'PE 11/04/88 X$ = "." ' KG101503 CALL LPRNT(X$,0) ' KG101503 1551 IF NOT SEND.REMOTE THEN _ RETURN 1553 CALL PUTCOM (X$) RETURN 1570 IF SEND.REMOTE THEN _ IF LINE.FEEDS THEN _ CALL PUTCOM (LINE.FEED$) 1575 IF LEN(B$) > 4000 THEN _ A$ = "Try again, " + _ FIRST.NAME$ : _ SUBROUTINE.PARAMETER = 5 : _ CALL TPUT : _ IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _ EXIT SUB _ ELSE GOTO 1500 IF PARSE.OFF THEN _ PARSE.OFF = FALSE : _ GOTO 1620 CALL PARSEIT IF Q = 1 THEN _ GOTO 1622 'KG012602 GOTO 1625 1620 B$(1) = B$ Q = 1 1622 IF B$ = "" THEN _ 'KG012602 Q = 0 : _ HIDDEN = FALSE : _ 'KG101502 EXIT SUB 1625 IF LEN(B$) < 4 THEN _ X$ = LEFT$(B$,3): _ CALL ALLCAPS (X$) : _ IF X$ = "Y" OR X$ = "YES" THEN _ YES = TRUE _ ELSE IF X$ = "N" OR X$ = "NO" OR X$ = "A" THEN _ NO = TRUE _ ELSE IF X$ = "RE" THEN _ REPLY = TRUE : _ EXIT SUB _ ELSE IF X$ = "K" THEN _ KILL.MESSAGE = TRUE : _ EXIT SUB IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _ NON.STOP = TRUE : _ B$(Q) = "" : _ IF Q > 1 THEN _ Q = Q-1 FORCE.KEYBOARD = FALSE HIDDEN = FALSE 'KG101503 EXIT SUB 1635 IF LEN(B$) = 0 THEN _ GOTO 1525 IF LOGON.ACTIVE THEN _ IF INSTR(" ;",RIGHT$(B$,1)) > 0 THEN _ PARM = PARM - 1 B$ = LEFT$(B$,LEN(B$)-1) CALL LPRNT(LOCAL.BACKSPACE$,0) IF SEND.REMOTE THEN _ CALL PUTCOM(BACKSPACE$) GOTO 1525 END SUB ' $SUBTITLE: 'RINGCALLER - subroutine to use sound + screen emphasis' ' $PAGE ' ' SUBROUTINE NAME -- RINGCALLER ' ' INPUT PARAMETERS -- PARAMETER MEANING ' A$ STRING TO EMPHASIZE ' ' OUTPUT PARAMETERS -- none ' ' SUBROUTINE PURPOSE -- Rings the users bell before and after string ' (but not snooping sysop) and adds emphasis around ' message sent. ' SUB RINGCALLER STATIC X$ = LEFT$(BELL.RINGER$,-LOCAL.USER) CALL PUTCOM (BELL.RINGER$) CALL LPRNT (X$,0) SUBROUTINE.PARAMETER = 2 A$ = EMPHASIZE.ON$ + A$ + EMPHASIZE.OFF$ CALL TPUT CALL PUTCOM (BELL.RINGER$) CALL LPRNT (X$,0) END SUB ' $SUBTITLE: 'PARSEIT - subroutine to parse a string' ' $PAGE ' ' SUBROUTINE NAME -- PARSEIT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' B$ STRING TO PARSE ' ' OUTPUT PARAMETERS -- Q NUMBER PARSED ' B$() PARSED STRINGS ' ' SUBROUTINE PURPOSE -- TO PARSE A STRING INTO PIECES. USES SEMICOLON ' IF EXISTS, OTHERWISE SPACE ' SUB PARSEIT STATIC A = INSTR(B$,";") IF A > 0 THEN _ PARSE.CHAR$ = ";" _ ELSE IF B$ <> SPACE$(LEN(B$)) THEN _ CALL TRIM (B$) : _ A = INSTR(B$," ") : _ WHILE A > 0 : _ B$ = LEFT$(B$,A - 1) + _ MID$(B$,A + 1) : _ A = INSTR(A,B$," ") : _ WEND : _ A = INSTR(B$," ") : _ PARSE.CHAR$ = " " IF A < 2 THEN _ B$(1) = B$ : _ EXIT SUB B$(1) = LEFT$(B$,A - 1) A = A + 1 1640 B = INSTR(A,B$,PARSE.CHAR$) C = B-A IF C < 1 THEN _ EOL = TRUE : _ C = 128 DF$ = MID$(B$,A,C) IF DF$ <> "" THEN _ Q = Q + 1 : _ B$(Q) = DF$ IF NOT EOL AND Q < 20 THEN _ 'KG120403 A = B + 1 : _ GOTO 1640 END SUB ' $SUBTITLE: 'SETBAUD - subroutine to set the baud rate in the RS232' ' $PAGE ' ' SUBROUTINE NAME -- SETBAUD ' ' INPUT PARAMETERS -- PARAMETER MEANING ' BAUD.RATE.DIVISOR NUMBER TO DIVIDE THE 8250 CHIP'S ' PROGRAMABLE CLOCK TO ADJUST THE ' BAUD RATE TO THE USER'S BAUD ' RATE (INDEPENDENT OF THE BAUD ' RATE USED TO OPEN THE COMM. PORT) ' ' DESIRED BAUD DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE ' RATE PCjr PC AND XT ' 50 2237 2304 ' 75 1491 1536 ' 110 1017 1047 ' 134.5 832 857 ' 150 746 768 ' 300 373 384 ' 600 186 192 ' 1200 93 96 ' 1800 62 64 ' 2000 56 58 ' 2400 47 48 ' 3600 31 32 ' 4800 23 24 ' 7200 not available 16 ' 9600 not available 12 ' 19200 not available 6 ' OUTPUT PARAMETERS -- BAUD RATE SET IN THE RS232 INTERFACE ' ' SUBROUTINE PURPOSE -- TO SET THE BAUD RATE IN THE RS232 INTERFACE ' INDEPENDENT OF THE BAUD RATE THE COMMUNICATIONS PORT ' WAS OPENED AT ' SUB SETBAUD STATIC 1654 IF KEEP.INIT.BAUD > -1 THEN _ ' WM042201 IF KEEP.INIT.BAUD = 0 OR BPS > -5 THEN _ ' WM042201 TALK.TO.MODEM.AT$ = MID$(" 300 450 1200 2400 4800 960019200", _ ' WM042201 (-5 * BPS),5) _ ' WM042201 ELSE TALK.TO.MODEM.AT$ = MODEM.INIT.BAUD$ CALL TRIM (TALK.TO.MODEM.AT$) IF LEN(TALK.TO.MODEM.AT$) < 5 THEN _ TALK.TO.MODEM.AT$ = SPACE$(4 - LEN(TALK.TO.MODEM.AT$)) + _ TALK.TO.MODEM.AT$ IF EIGHT.BIT 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 COMSPEED% = VAL(TALK.TO.MODEM.AT$) IF FOSSIL THEN _ CALL FOSSPEED(COMPORT%,COMSPEED%,PARITY%,DATABITS%,STOPBITS%) : _ EXIT SUB IF COMSPEED% = 300 THEN _ BAUD.RATE.DIVISOR = &H180 + (11 * (COMPUTER.TYPE = 2)) IF COMSPEED% = 450 THEN _ BAUD.RATE.DIVISOR = &H100 + (8 * (COMPUTER.TYPE = 2)) IF COMSPEED% = 1200 THEN _ BAUD.RATE.DIVISOR = &H60 + (3 * (COMPUTER.TYPE = 2)) IF COMSPEED% = 2400 THEN _ BAUD.RATE.DIVISOR = &H30 + (1 * (COMPUTER.TYPE = 2)) IF COMSPEED% = 4800 THEN _ BAUD.RATE.DIVISOR = &H18 IF COMSPEED% = 9600 THEN _ BAUD.RATE.DIVISOR = &HC IF COMSPEED% = 19200 THEN _ BAUD.RATE.DIVISOR = &H6 MOST.SIGNIFICANT.BYTE = FIX (BAUD.RATE.DIVISOR / 256) LEAST.SIGNIFICANT.BYTE = BAUD.RATE.DIVISOR - (MOST.SIGNIFICANT.BYTE * 256) LINE.CONTROL.STATUS = INP(LINE.CONTROL.REGISTER) MSB.SAVE = INP(MSB) OUT MSB,0 OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OR 128 OUT LSB,LEAST.SIGNIFICANT.BYTE OUT MSB,MOST.SIGNIFICANT.BYTE OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OUT MSB,MSB.SAVE END SUB ' $SUBTITLE: 'MSGTO - subroutine to get who a message is to' ' $PAGE ' ' SUBROUTINE NAME -- MSGTO ' ' INPUT PARAMETERS -- PARAMETER MEANING ' HIGHEST.USER.RECORD ' ' OUTPUT PARAMETERS -- MESSAGE.TO$ Who message is to ' RECEIVER.REC.NUM User record # of who to ' ' SUBROUTINE PURPOSE -- Asks who a message is to and determines if receiver ' exists ' SUB MSGTO (HIGHEST.USER.RECORD,MESSAGE.TO$,RECEIVER.REC.NUM,FOUND) STATIC 2020 IF MESSAGE.TO$ <> "" THEN _ GOTO 2032 A$ = "To [A]ll,S)ysop, or name" CALL SKIPLINE (1) GOSUB 2033 ' IF LEN (B$) < 3 THEN _ ' CALL QTPUT ("Must enter a valid user name ",1) : _ ' GOTO 2020 IF LEN(B$) > 30 THEN _ CALL QTPUT (CX$(6)+"30 Char. Max"+CX$(7),1) : _ GOTO 2020 2030 FOUND = TRUE IF Q = 0 THEN _ MESSAGE.TO$ = "ALL" _ ELSE CALL ALLCAPS (B$) : _ IF B$ = "A" THEN _ MESSAGE.TO$ = "ALL" : _ EXIT SUB _ ELSE IF B$ = "S" THEN _ MESSAGE.TO$ = "SYSOP" _ ELSE MESSAGE.TO$ = B$ 2032 IF MESSAGE.TO$ <> "ALL" THEN _ IF LEFT$(MESSAGE.TO$,4) <> "ALL " AND _ START.HASH = 1 AND (MESSAGE.TO$ = "SYSOP" OR _ INSTR(MESSAGE.TO$," ") > 0) THEN _ TEMP.HASH.VALUE$ = MESSAGE.TO$ : _ CALL WHOCHECK (TEMP.HASH.VALUE$,FOUND,RECEIVER.REC.NUM) : _ IF NOT FOUND THEN _ Q = 0 : _ RECEIVER.REC.NUM = 0 : _ ' KG011610 A$ = "[R]e-enter name, Q)uit, C)ontinue" : _ TURBO.KEY = -TURBO.KEY.USER : _ GOSUB 2033 : _ Z$ = B$(1) : _ CALL ALLCAPS (Z$) : _ IF Z$ <> "C" THEN _ MESSAGE.TO$ = "": _ IF Z$ <> "Q" THEN _ GOTO 2020 EXIT SUB 2033 SUBROUTINE.PARAMETER = 1 CALL TGET IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB RETURN END SUB ' $SUBTITLE: 'MSGPROT - gets protection wanted for a message' ' $PAGE ' ' SUBROUTINE NAME -- MSGPROT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' MESSAGE.TO$ ' FOUND ' ' OUTPUT PARAMETERS -- PASSWORD$ Protection desired ' ' SUBROUTINE PURPOSE -- Sets protection desired for a new message ' SUB MSGPROT (MESSAGE.TO$,FOUND,MESSAGE.PASSWORD$) STATIC IF MESSAGE.TO$ = "ALL" THEN _ ' JM110805 GOTO 2090 ' JM110805 2060 A$ = "Make message [P]ublic, p(R)ivate, (H)elp" GOSUB 2093 IF Q = 0 THEN _ B$(1) = "P" Z$ = LEFT$(B$(1),1) CALL ALLCAPS (Z$) ON INSTR("RPUH",Z$) GOTO 2075,2090,2075,2070 GOTO 2060 ' ' ** DISPLAY MESSAGE PROTECT HELP ** ' 2070 CALL BUFFILE (HELP$(3),X) GOTO 2060 ' ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) ** ' 2075 IF MESSAGE.TO$ = "ALL" THEN _ CALL QTPUT(CX$(2)+"Msg to"+CX$(5)+" ALL"+CX$(3)+" cannot be private",1) : _ GOTO 2060 IF Z$ = "U" THEN _ GOTO 2088 2077 IF NOT FOUND THEN _ IF ACTIVE.USER.NAME$ <> "SYSOP" THEN _ CALL QTPUT (CX$(1)+"Personal"+CX$(2)+" mail only to active users",1) : _ MESSAGE.PASSWORD$ = "" : _ EXIT SUB 2081 CALL QTPUT (CX$(3)+"Sending"+CX$(2)+" personal mail to "+CX$(4) + MESSAGE.TO$+CX$(7),1) 2084 MESSAGE.PASSWORD$ = "^READ^" EXIT SUB 2085 A$ = "Password" GOSUB 2094 IF Q = 0 THEN _ GOTO 2085 IF LEN(B$) > L THEN _ CALL QTPUT (STR$(L) + " Chars. max",1 ) : _ GOTO 2085 IF L = 15 AND LEFT$(B$,1) = "!" THEN _ CALL QTPUT ("Password can't begin with '!'",1) : _ GOTO 2085 RETURN ' ' ** PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) ** ' 2088 A$ = "Receiver(s) Must KNOW PASSWORD TO READ msg. Use password (Y/[N])" GOSUB 2093 IF NOT YES THEN _ GOTO 2070 L = 14 A1$ = "!" GOSUB 2085 CALL ALLCAPS (B$) GOTO 2092 ' ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) ** ' 2090 L = 15 A1$ = "" B$ = "^KILL^" 2092 MESSAGE.PASSWORD$ = A1$ + _ B$ EXIT SUB 2093 TURBO.KEY = -TURBO.KEY.USER 2094 SUBROUTINE.PARAMETER = 1 CALL TGET IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB RETURN END SUB ' $SUBTITLE: 'WHOCHECK - Checks whether user exists' ' $PAGE ' ' SUBROUTINE NAME -- WHOCHECK ' ' INPUT PARAMETERS -- PARAMETER MEANING ' WHO.FIND$ User to find ' ' OUTPUT PARAMETERS -- WHO.FOUND Whether user found ' USER.NUM.FOUND Record # of user ' ' SUBROUTINE PURPOSE -- Validate that user record exists. Sysop ' counted as found even if lack user record. ' 2250 SUB WHOCHECK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC USER.NUM.FOUND = 0 IF START.HASH <> 1 THEN _ 'KG101607 WHO.FOUND = TRUE : _ EXIT SUB WHO.FOUND = FALSE TO.SYSOP = (INSTR(WHO.FIND$,"SYSOP") > 0 OR _ INSTR(WHO.FIND$,SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$) > 0 ) CALL OPENUSER (HIGHEST.USER.RECORD) FIELD 5, 128 AS USER.RECORD$ IF TO.SYSOP THEN _ X$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _ ELSE X$ = WHO.FIND$ CALL FINDUSER (X$,"",START.HASH,LEN.HASH,_ ' KG101607 0,0,HIGHEST.USER.RECORD,WHO.FOUND,_ ' KG101607 USER.NUM.FOUND,SL) IF USER.FILE.INDEX > 0 THEN _ GET 5, USER.FILE.INDEX '********** Orig code ******* ' IF NOT WHO.FOUND THEN _ ' IF TO.SYSOP THEN _ ' WHO.FOUND = TRUE _ ' ELSE CALL QTPUT (CX$(5)+WHO.FIND$+CX$(6) + " not active user"+CX$(7),1) '****** ALIAS Changes next ************* IF NOT WHO.FOUND THEN _ IF TO.SYSOP THEN _ WHO.FOUND = TRUE _ ELSE CALL ALIASCHK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) : _ 'DGS-ALSMN IF NOT WHO.FOUND THEN _ 'DGS-ALSMN CALL QTPUT (WHO.FIND$ + " not active user",1) 'DGS-MNMOD END SUB ' $SUBTITLE: 'ALIASCHK - Checks whether ALIAS exists' ' $PAGE ' ' SUBROUTINE NAME -- ALIASCHK ' ' INPUT PARAMETERS -- PARAMETER MEANING ' WHO.FIND$ ALIAS to find ' ' OUTPUT PARAMETERS -- WHO.FOUND Whether ALIAS found ' USER.NUM.FOUND Record # of User ' ' SUBROUTINE PURPOSE -- Validate that ALIAS exists. Get User Record ' 2257 SUB ALIASCHK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC 'DGS-ALSMN CALL BRKFNAME (MAIN.USER.FILE$,DRV$,PREFIX$,EXT$,TRUE) ' DGS.TEMP = INSTR(GRN$," ") ' IF DGS.TEMP > 0 THEN _ ' DGS.FILE.NAME$ = DRV$ + LEFT$(GRN$,DGS.TEMP-1) + "A.DEF" _ ' ELSE DGS.FILE.NAME$ = DRV$ + GRN$ + "A.DEF" ' CALL FINDIT (DGS.FILE.NAME$) ' IF NOT OK THEN _ ' EXIT SUB ' OPEN "I", 7, DGS.FILE.NAME$ ' DGS.ALIAS$ = "" ' WHILE DGS.ALIAS$ = "" AND NOT EOF(7) ' INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$ ' IF DGS.TEMP.ALIAS$ = WHO.FIND$ THEN ' DGS.ALIAS$ = DGS.USER.NAME$ ' END IF ' WEND ' CLOSE 7 ' CALL OPENUSER (HIGHEST.USER.RECORD) ' FIELD 5, 128 AS USER.RECORD$ ' CALL FINDUSER (DGS.USER.NAME$,TEMP.INDIV.VALUE$,START.HASH,LEN.HASH,_ ' START.INDIV,LEN.INDIV,HIGHEST.USER.RECORD,WHO.FOUND,_ ' USER.NUM.FOUND,SL) ' END SUB ' $SUBTITLE: 'EDITALINE - Edits a line in a message' ' $PAGE ' ' SUBROUTINE NAME -- EDITALINE ' ' INPUT PARAMETERS -- PARAMETER MEANING ' L Line # to edit ' ' OUTPUT PARAMETERS -- A$(L) Edited line ' ' SUBROUTINE PURPOSE -- Edit a line in a message. ' SUB EDITALINE (L) STATIC 2620 A$ = "Line #" + _ STR$(L) + _ " is:" + _ RETURN.LINE.FEED$ + _ A$(L) SUBROUTINE.PARAMETER = 3 CALL TPUT GOSUB 2695 IF NOT EXPERT.USER THEN _ CALL QTPUT ("Search & replace",1) A$ = "Search for" + _ PRESS.ENTER.EXPERT$ PARSE.OFF = TRUE SUBROUTINE.PARAMETER = 1 GOSUB 2694 IF Q = 0 THEN _ EXIT SUB Y$ = LEFT$(B$,1) IF Y$ = RIGHT$(B$,1) THEN _ IF LEN(B$) > 2 THEN _ X = INSTR(2,B$,Y$) : _ IF X < LEN(B$) THEN _ IF Y$ < "0" OR (Y$ > "9" AND Y$ < "A") THEN _ B$ = MID$(B$,2,LEN(B$)-2) : _ X = X - 1 : _ GOTO 2622 X = INSTR(B$,";") 2622 IF X > 0 THEN _ X$ = LEFT$(B$,X-1) : _ Y$ = RIGHT$(B$,LEN(B$)-X) : _ GOTO 2660 X$ = B$ A$ = "And replace by" PARSE.OFF = TRUE SUBROUTINE.PARAMETER = 1 GOSUB 2694 Y$ = B$ 2660 X = INSTR(1,A$(L),X$) IF X = 0 THEN _ CALL QTPUT ("<" + X$ + "> not found in line" + STR$(L),1) : _ GOTO 2620 2670 FF = LEN(X$) JJ = LEN(Y$) IF FF = JJ THEN _ MID$(A$(L),X) = Y$ : _ GOTO 2620 2690 DF$ = LEFT$(A$(L),X - 1) A$(L) = DF$ + _ Y$ + _ MID$(A$(L),X + FF) GOTO 2620 2694 CALL TGET 2695 IF SUBROUTINE.PARAMETER > -1 THEN _ RETURN END SUB ' $SUBTITLE: 'LINEEDIT - subroutine to produce edited line' ' $PAGE ' ' SUBROUTINE NAME -- LINEEDIT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' BACK.ARROW$ ' BACKSPACE$ ' CARRIAGE.RETURN$ ' LINE.FEED$ ' LINEMES$ BUFFER SPACE TO USE FOR HOLDING LINE ' LOCAL.USER ' MAX.LEN MAXIMUM LENGTH OF STRING TO INPUT ' MESSAGE.LINE WHERE IN A$() TO PUT THE EDITED LINE ' RIGHT.MARGIN ' SNOOP ' STOP.INTERRUPTS ' WAIT.EXPIRED ' ' OUTPUT PARAMETERS -- A$(MESSAGE.LINE) EDITED LINE ' ' SUBROUTINE PURPOSE -- SUBROUTINE TO EDIT A LINE QUICKLY USING A MINIMUM OF ' STRING SPACE. ' SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC 3700 LSET LINEMES$ = A$(MESSAGE.LINE) COL = LEN(A$(MESSAGE.LINE)) STOP.INTERRUPTS = TRUE XXX = MAX.LEN - 3 WAIT.EXPIRED = FALSE 3720 COL = COL + 1 CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT) 3730 CALL FINDFUNC 'KG110801 IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB X$ = KEY.PRESSED$ IF X$ = "" THEN _ IF LOCAL.USER THEN _ GOTO 3730 _ ELSE GOTO 3732 IF X$ = ESCAPE$ THEN _ KEY.PRESSED$ = X$ : _ EXIT SUB SEND.REMOTE = TRUE Z = INSTR(LINEEDIT.CHK$,X$) IF Z < 1 THEN _ GOTO 3750 _ ELSE IF Z > 4 THEN _ GOTO 3870 IF LOCAL.USER THEN _ GOTO 3730 3732 IF COMMPORT.STACK$ <> "" THEN _ X$ = LEFT$(COMMPORT.STACK$,1) : _ COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _ GOTO 3738 CALL EOFCOMM (CHAR%) IF CHAR% <> -1 THEN _ GOTO 3736 CALL FINDTIME (TI!) IF TI! > AUTO.LOGOFF! THEN _ WAIT.EXPIRED = TRUE : _ EXIT SUB 3733 CALL CARRIER IF SUBROUTINE.PARAMETER THEN _ EXIT SUB GOTO 3730 3736 AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT 3737 CALL GETCOM (X$) 3738 SEND.REMOTE = REMOTE.ECHO 3740 ON INSTR(LINEEDIT.CHK$,X$) GOTO 3730,3730,3730,3730,3870,3870,3870,3870,3870 3750 IF SEND.REMOTE THEN _ CALL PUTCOM(X$) CALL LPRNT (X$, 0) IF X$ = CARRIAGE.RETURN$ THEN _ COL = COL - 1 : _ GOTO 3850 3770 IF COL > XXX THEN _ IF X$ = " " THEN _ CALL SKIPLINE (1) : _ GOTO 3860 3780 MID$(LINEMES$,COL) = X$ IF COL < MAX.LEN THEN _ GOTO 3720 Z = COL 3800 IF Z < 1 THEN _ Z = COL-1 : _ GOTO 3820 IF MID$(LINEMES$,Z,1) = " " THEN _ GOTO 3820 Z = Z - 1 GOTO 3800 3820 IF (NOT REMOTE.ECHO) AND (NOT LOCAL.USER) THEN _ CALL SKIPLINE (1) : _ GOTO 3860 COL = MAX.LEN - Z IF SNOOP THEN _ IF POS(0) > COL THEN _ LOCATE ,POS(0)-COL: _ CALL LPRNT(STRING$(COL,32),0) 3830 IF REMOTE.ECHO THEN _ CALL PUTCOM (STRING$(COL,8) + STRING$(COL,32)) 3840 A$(MESSAGE.LINE) = LEFT$(LINEMES$,Z) A$(MESSAGE.LINE + 1) = MID$(LINEMES$,Z + 1,COL) CALL SKIPLINE (1) GOTO 3891 3850 IF SEND.REMOTE AND LINE.FEEDS THEN _ CALL PUTCOM(LINE.FEED$) 3860 A$(MESSAGE.LINE) = LEFT$(LINEMES$,COL) GOTO 3891 3870 IF COL = 1 THEN _ GOTO 3730 COL = COL-2 3880 CALL LPRNT(LOCAL.BACKSPACE$,0) 3885 IF SEND.REMOTE THEN _ CALL PUTCOM (BACKSPACE$) 3890 GOTO 3720 3891 CALL CARRIER END SUB ' $SUBTITLE: 'KILLMSG - subroutine to delete messages' ' $PAGE ' ' SUBROUTINE NAME -- KILLMSG ' ' INPUT PARAMETERS -- PARAMETER MEANING ' MESSAGE.TO.KILL MESSAGE NUMBER TO KILL ' ACTIVE.MESSAGES NUMBER ACTIVE MESSAGES ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO KILL/DELETE OLD OR UNNECESSARY MESSAGES ' SUB KILLMSG (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) STATIC ' FIELD #1,128 AS MESSAGE.RECORD$ QX = 1 3955 IF QX > ACTIVE.MESSAGES THEN _ A$ = "No such msg #" + _ STR$(MESSAGE.TO.KILL) : _ GOTO 4031 IF M(QX,2) = MESSAGE.TO.KILL AND MESSAGE.TO.KILL => 1 THEN _ GOTO 3970 QX = QX + 1 GOTO 3955 3970 SUBROUTINE.PARAMETER = 3 CALL FILELOCK GET 1,M(QX,1) IF SYSOP THEN _ GOTO 4030 3980 Z$ = MID$(MESSAGE.RECORD$,101,15) CALL TRIM (Z$) IF LEN(Z$) = 0 THEN _ GOTO 4030 3990 IF Z$ = "^READ^" OR Z$ = "^KILL^" THEN _ IF INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) THEN _ GOTO 4030 _ ELSE MESSAGE.PASSWORD = TRUE : _ ATTEMPTS.ALLOWED = 0 : _ A$ = "Only sender & receiver can kill" : _ 'KG011804 GOTO 4031 4000 IF LEFT$(Z$,1) = "!" THEN _ Z$ = MID$(Z$,2) 4010 PASSWORD.SAVE$ = Z$ + _ SPACE$(15 - LEN(Z$)) ATTEMPTS.ALLOWED = 1 MESSAGE.PASSWORD = TRUE CALL PASSWRD IF PASSWORD.FAILED THEN _ GOTO 4031 4030 LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _ DELETED.MESSAGE$ + _ MID$(MESSAGE.RECORD$,117) PUT 1,LOC(1) A$ = CX$(1)+"Killed Msg # " +CX$(3)+ _ STR$(MESSAGE.TO.KILL)+CX$(7) CALL THREAD2 (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) 'PE 01/12/89 SUBROUTINE.PARAMETER = 4 CALL FILELOCK 'KG011804 SUBROUTINE.PARAMETER = 5 CALL TPUT EXIT SUB 4031 SUBROUTINE.PARAMETER = 5 CALL TPUT END SUB ' $SUBTITLE: 'SETTHREAD - Sets up the interface for threading' ' $PAGE ' ' SUBROUTINE NAME -- SETTHREAD ' ' INPUT PARAMETERS -- PARAMETER MEANING ' CURR.MSG.NUM Current message number ' CURR.SUBJ$ Current message subject ' ' OUTPUT PARAMETERS -- B$() Search msg by string ' Q 0 if thread cancelled ' ' SUBROUTINE PURPOSE -- Find out how the caller wants to thread - ' i.e. search messages by matching subject - ' forward from current, back from current, ' or forward from top of messages ' SUB SETTHREAD (CURR.MSG.NUM,CURR.SUBJ$) STATIC IF Q > 1 THEN _ Z$ = B$(2) : _ GOTO 4657 4656 A$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)" 'Pe 02/11/89 TURBO.KEY = -TURBO.KEY.USER SUBROUTINE.PARAMETER = 1 CALL TGET IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB Z$ = B$(1) 4657 Z$ = LEFT$(Z$,1) X = INSTR("+-1",Z$) IF X = 0 THEN _ GOTO 4656 B$(1) = "R" IF X = 1 THEN _ CURR.MSG.NUM = CURR.MSG.NUM + 1 _ ELSE IF X = 2 THEN _ CURR.MSG.NUM = CURR.MSG.NUM - 1 _ ELSE CURR.MSG.NUM = 1 : _ Z$ = "+" B$(3) = MID$(STR$(CURR.MSG.NUM),2) + Z$ IF LEN(CURR.SUBJ$) < 4 OR LEFT$(CURR.SUBJ$,3) <> "(R)" THEN _ B$(2) = CURR.SUBJ$ _ ELSE B$(2) = MID$(CURR.SUBJ$,4) B$(2) = CHR$(34) + B$(2) + CHR$(34) Q = 3 END SUB ' $SUBTITLE: 'SYSOPCHAT - chat with sysop' ' $PAGE ' ' SUBROUTINE NAME -- SYSOPCHAT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' OUTPUT PARAMETERS -- CM True if chat active ' ' SUBROUTINE PURPOSE -- Lets sysop chat interactively with caller ' SUB SYSOPCHAT STATIC ' KG102406 CM = TRUE ' KG102406 CALL FINDTIME (TIME.CHAT.STARTED!) ' KG102406 SUBROUTINE.PARAMETER = 1 ' KG102406 CALL LINE25 ' KG102406 A$(2) = "" ' KG102406 4775 CALL LINEEDIT (1,72) ' KG102406 IF KEY.PRESSED$ = ESCAPE$ OR _ ' KG102406 SUBROUTINE.PARAMETER < 0 THEN _ ' KG102406 GOTO 4777 ' KG102406 A$(1) = "" ' KG102406 IF A$(2) <> "" THEN _ ' KG102406 A$ = A$(2) : _ ' KG102406 A$(1) = A$(2) : _ ' KG102406 A$(2) = "" _ ' KG102406 ELSE A$ = "" ' KG102406 SUBROUTINE.PARAMETER = 4 ' KG102406 CALL TPUT ' KG102406 IF SUBROUTINE.PARAMETER > -1 THEN _ ' KG102406 GOTO 4775 ' KG102406 4777 CM = 0 ' KG102406 CALL FINDTIME (TI!) ' KG102406 ELAPSED! = FIX(TI! - TIME.CHAT.STARTED!) ' KG102406 IF ELAPSED! < 0 THEN _ ' KG102406 ELAPSED! = TI! + (86400! - TIME.CHAT.STARTED!) ' KG102406 SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + ELAPSED! ' KG102406 IF NOT LOCAL.USER THEN _ ' KG102406 AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT ' KG102406 CALL QTPUT(" Chat ended. Returning to normal operation",2) ' KG102406 END SUB ' KG102406 ' $SUBTITLE: 'REMNONALF - removes non-alpha characters from a string' ' $PAGE ' ' SUBROUTINE NAME -- REMNONALF ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRNG$ String to check ' MIN.CHAR Remove chars with this ' ASCII value or lower ' MAX.CHAR Remove chars with this ' ASCII value or higher ' ' OUTPUT PARAMETERS -- STRNG$ String returned ' SUBROUTINE PURPOSE -- CALCULATE THE ELASPED TIME A USER HAS BEEN ON ' 5100 SUB REMNONALF (STRNG$,MIN.CHAR,MAX.CHAR) STATIC LAST = LEN(STRNG$) J = 1 WHILE J <= LAST K = ASC(MID$(STRNG$,J)) IF K > MIN.CHAR AND K < MAX.CHAR THEN _ J = J + 1 _ ELSE STRNG$ = LEFT$(STRNG$,J - 1) + _ RIGHT$(STRNG$,LAST - J) : _ LAST = LAST - 1 WEND END SUB ' $SUBTITLE: 'PAGELEN - Sets lines per page' ' $PAGE ' ' SUBROUTINE NAME -- PAGELEN ' ' INPUT PARAMETERS -- PARAMETER MEANING ' PAGE.LENGTH Current page length ' ' OUTPUT PARAMETERS -- PAGE.LENGTH New page length ' ' SUBROUTINE PURPOSE -- Change default lines per page ' SUB PAGELEN STATIC 5202 A$ = "CHANGE page length from" + _ STR$(PAGE.LENGTH) + _ " TO (0-255, 0=continuous)" SUBROUTINE.PARMETER = 5 CALL TGET IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _ CALL QTPUT ("No change",1) : _ EXIT SUB 5230 CALL CHECKINT (B$(Q)) IF EC <> 0 THEN _ GOTO 5202 IF TESTED.INTEGER.VALUE < 0 OR _ TESTED.INTEGER.VALUE > 255 THEN _ GOTO 5202 PAGE.LENGTH = TESTED.INTEGER.VALUE CALL QTPUT ("Set to" + STR$(PAGE.LENGTH),1) END SUB ' $SUBTITLE: 'BAUD450 -- Changes 300 baud to 450' ' $PAGE ' SUBROUTINE NAME -- BAUD450 ' ' INPUT PARAMETERS -- PARAMETER MEANING ' BPS ' ' OUTPUT PARAMETERS -- BPS ' ' SUBROUTINE PURPOSE -- ALLOW 300 BAUD MODEMS TO BUMP UP TO 450 BAUD ' SUB BAUD450 STATIC 5507 5510 5530 5535 5536 5537 5540 END SUB ' $SUBTITLE: 'GETIME - subroutine to calculate elapsed time' ' $PAGE ' ' SUBROUTINE NAME -- GETIME ' ' INPUT PARAMETERS -- PARAMETER MEANING ' TIME.LOGGED.ON$ ' ' OUTPUT PARAMETERS -- HH NUMBER OF HOURS ON ' MM NUMBER OF MINUTES ON ' SS NUMBER OF SECONDS ON ' ' SUBROUTINE PURPOSE -- CALCULATE THE ELASPED TIME A USER HAS BEEN ON ' SUB GETIME STATIC 9140 H = VAL(MID$(TIME.LOGGED.ON$,1,2)) M = VAL(MID$(TIME.LOGGED.ON$,4,2)) S = VAL(MID$(TIME.LOGGED.ON$,7,2)) X$ = TIME$ HH = VAL(MID$(X$,1,2)) MM = VAL(MID$(X$,4,2)) JJ = VAL(MID$(X$,7,2)) IF S <= JJ THEN _ SSS = JJ - S _ ELSE SSS = 60 - (S - JJ) : _ M = M + 1 9150 IF M <= MM THEN _ MMM = MM - M _ ELSE MMM = 60 - (M - MM) : _ H = H + 1 9160 IF H <= HH THEN _ HHH = HH - H _ ELSE HHH = 24 - (H - HH) END SUB ' $SUBTITLE: 'DEFAULTU - subroutine to update user defauts' ' $PAGE ' ' SUBROUTINE NAME -- DEFAULTU ' ' INPUT PARAMETERS -- PARAMETER MEANING ' AUTODOWNLOAD.DESIRED ' BOLD.TEXT$ Ansi bold (0 no, 1 yes) ' CHECK.BULLETIN.LOGON ' EXPERT.USER ' GR ' LAST.MESSAGE.READ ' LINE.FEEDS ' NULLS ' PAGE.LENGTH ' PROMPT.BELL ' REG.DATE$ ' REQ.QUES.ANSWERED ' RIGHT.MARGIN ' SKIP.FILES.LOGON ' TIMES.LOGGED.ON ' UPPER.CASE ' USER.OPTIONS$ ' USER.TEXT.COLOR Ansi of color (31-37) ' USER.TRANSFER.DEFAULT$ ' ' OUTPUT PARAMETERS -- USER.OPTONS$ ' ' SUBROUTINE PURPOSE -- TO UPDATE THE USER'S RECORD WITH THEIR OPTIONS ' Meaning of graphics preference stored is as follows: where # is ' value stored for the color. E.g. if graphics perference for text ' files is color, and preference for normal text is light yellow, ' graphics preference stored is 38. Colors are Red, Green, Yellow, ' Blue, Purple, Cyan, and White. ' ' normal bold ' Graphics R G Y B P C W R G Y B P C W ' none 30 33 36 39 42 45 48 | 51 54 57 60 63 66 69 ' ansi 31 34 37 40 43 46 49 | 52 55 58 61 64 67 70 ' color 32 35 38 41 44 47 50 | 53 56 59 62 65 68 71 ' ' SUB DEFAULTU STATIC 9600 A = -PROMPT.BELL -2 * EXPERT.USER _ -4 * NULLS -8 * UPPER.CASE _ -16 * LINE.FEEDS -32 * CHECK.BULLETIN.LOGON _ -64 * SKIP.FILES.LOGON -128 * AUTODOWNLOAD.DESIRED _ -256 * REQ.QUES.ANSWERED -512 * MAIL.WAITING _ -1024 * (NOT HIGHLIGHT.OFF)-2048 * TURBO.KEY.USER X = 3 * USER.TEXT.COLOR - 63 + 21*VAL(BOLD.TEXT$) + GR IF X < 1 OR X > 255 THEN _ X = 48 LSET USER.OPTIONS$ = _ MKI$(TIMES.LOGGED.ON) + _ MKI$(LAST.MESSAGE.READ) + _ USER.TRANSFER.DEFAULT$ + _ CHR$(X) + _ MKI$(RIGHT.MARGIN) + _ MKI$(A) + _ REG.DATE$ + _ CHR$(PAGE.LENGTH) + _ ECHOER$ 'PRINT PROMPT.BELL 'PRINT A 'CALL DELAYIT(2) END SUB ' $SUBTITLE: 'WHOSON - subroutine to display who is on' ' $PAGE ' ' SUBROUTINE NAME -- WHOSON ' ' INPUT PARAMETERS -- PARAMETER MEANING ' NUM.NODES # of nodes to check ' ACTIVE.MESSAGE.FILE$ Current message file ' ORIG.MESSAGE.FILE$ Main msg file ' ' OUTPUT PARAMETERS -- None ' ' SUBROUTINE PURPOSE -- To display who is on each node. ' 9801 SUB WHOSON (NUM.NODES) STATIC A1$ = ACTIVE.MESSAGE.FILE$ ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$ CALL OPENMSG FIELD 1, 128 AS MESSAGE.RECORD$ FOR NODE.INDEX = 2 TO NUM.NODES + 1 GET 1,NODE.INDEX A$ = FG.1$ + "Node" + _ STR$(NODE.INDEX - 1) + FG.2$ REC.INDEX = VAL(MID$(MESSAGE.RECORD$,44,2)) IF REC.INDEX = 0 THEN _ REC.INDEX = -1 AX$ = MID$(" 300 450 1200 2400 4800 960019200",(-5 * REC.INDEX ),5) + _ " BAUD: " IF MID$(MESSAGE.RECORD$,55,2) = "-1" AND NOT SYSOP THEN _ Y$ = "SYSOP" + SPACE$(21) _ ELSE Y$ = MID$(MESSAGE.RECORD$,1,26) AX$ = AX$ + FG.3$ + Y$ IF MID$(MESSAGE.RECORD$,40,2) <> "-1" THEN _ AX$ = AX$ + FG.4$ + MID$(MESSAGE.RECORD$,93,22) IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _ A$ = A$ + " Online at " + _ AX$ _ ELSE IF NOT SYSOP THEN _ A$ = A$ + _ " Waiting for next caller" _ ELSE A$ = A$ + _ " Offline at " + _ AX$ CALL QTPUT (A$,1) NEXT ACTIVE.MESSAGE.FILE$ = A1$ END SUB ' $SUBTITLE: 'RECOVMSG - subroutine to recover deleted messages' ' $PAGE ' ' SUBROUTINE NAME -- RECOVMSG ' ' INPUT PARAMETERS -- PARAMETER MEANING ' MESSAGE.TO.RECOVER MESSAGE NUMBER TO RECOVER ' FIRST.MESSAGE.RECORD RECORD # FOR FIRST MSG ' ' OUTPUT PARAMETERS -- ACTION.FLAG SET TO 0 IF ERROR ' SET TO -1 IF NO ERROR ' ' SUBROUTINE PURPOSE -- TO RECOVER DELETED MESSAGES. NOTE THAT THIS IS ONLY ' POSSIBLE IF YOU HAVE NOT COMPRESSED YOUR MESSAGE FILE ' USING CONFIG. SUB RECOVMSG (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG,GRN$) STATIC 'pe/01/12/89 FIELD #1,128 AS MESSAGE.RECORD$ 10410 MESSAGE.RECORD = FIRST.MESSAGE.RECORD SUBROUTINE.PARAMETER = 5 CALL TPUT 10420 GET 1,MESSAGE.RECORD NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,117,4)) IF NUMBER.RECORDS.IN.MESSAGE < 1 THEN _ A$ = "USE CONFIG TO REPAIR YOUR MESSAGE FILE" : _ GOTO 10485 IF MESSAGE.RECORD => NEXT.MESSAGE.RECORD THEN _ A$ = "No Msg #" + _ STR$(MESSAGE.TO.RECOVER) : _ GOTO 10485 10440 IF VAL(MID$(MESSAGE.RECORD$,2,4)) <> MESSAGE.TO.RECOVER THEN _ MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE : _ GOTO 10420 10450 IF INSTR(MESSAGE.RECORD$,DELETED.MESSAGE$) <> 0 THEN _ SUBROUTINE.PARAMETER = 3 : _ CALL TPUT : _ LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _ ACTIVE.MESSAGE$ + _ MID$(MESSAGE.RECORD$,117) : _ PUT 1,LOC(1) : _ SUBROUTINE.PARAMETER = 4 : _ CALL TPUT : _ A$ = "Restored Msg #" + _ STR$(MESSAGE.TO.RECOVER) : _ ACTION.FLAG = TRUE : _ CALL THREAD4 (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG,GRN$) : _ GOTO 10485 10480 A$ = "Msg #" + _ STR$(MESSAGE.TO.RECOVER) + _ " not Dead" 10485 CALL QTPUT (A$,1) END SUB ' $SUBTITLE: 'UPDATEU -- Update the users record at logoff' ' $PAGE ' SUBROUTINE NAME -- UPDATEU ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ADJUSTED.SECURITY ' CURRENT.DATE$ ' DOWNLOADS ' ELAPSED.TIME ' LIST.DIRECTORY ' MAIN.USER.FILE.INDEX ' SECONDS.PER.SESSION! ' UPLOADS ' USER.SECURITY.LEVEL ' ' OUTPUT PARAMETERS -- ELAPSED.TIME$ ' LIST.NEW.DATE$ ' SECURITY.LEVEL$ ' USER.DOWNLOADS$ ' USER.UPLOADS$ ' ' SUBROUTINE PURPOSE -- UPDATE THE USER RECORD FOR THE USER WHEN THE USER ' EXITS RBBS-PC. ' SUB UPDATEU (LOGGING.OFF) STATIC IF ACTIVE.USER.NAME$ = "" OR FIRST.NAME$ = "" THEN _ EXIT SUB IF ACTIVE.USER.FILE$ = ORIG.USER.FILE$ THEN _ ' KG102004 UPLOADS = GLOBAL.UPLOADS : _ ' KG102004 DOWNLOADS = GLOBAL.DOWNLOADS : _ ' KG102004 DL.TODAY! = GLOBAL.DL.TODAY! : _ ' KG102004 BYTES.TODAY! = GLOBAL.BYTES.TODAY! : _ ' KG102004 DLBYTES! = GLOBAL.DLBYTES! : _ ' KG102004 ULBYTES! = GLOBAL.ULBYTES! ' KG102004 10600 CALL TIMEREMAIN (TIME.REMAINING!) Q! = ELAPSED.TIME + MINUTES.IN.DOORS + _ ((SECONDS.PER.SESSION! - TIME.CREDITS!)/ 60) - _ TIME.REMAINING! IF Q! < -32000 THEN _ Q! = -32000 _ ELSE IF Q! > 32000 THEN _ Q! = 32000 IF USER.FILE.INDEX < 1 THEN _ GOTO 10607 UPDATE.DEFAULTS = TRUE 10602 SUBROUTINE.PARAMETER = 6 CALL FILELOCK CALL OPENUSER (HIGHEST.USER.RECORD) 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$ 10604 GET 5,USER.FILE.INDEX IF UPDATE.DEFAULTS THEN _ CALL DEFAULTU IF LIST.DIRECTORY THEN _ LSET LIST.NEW.DATE$ = CHR$(VAL(MID$(CURRENT.DATE$,7,2))) + _ CHR$(VAL(MID$(CURRENT.DATE$,1,2))) + _ CHR$(VAL(MID$(CURRENT.DATE$,4,2))) 10605 LSET USER.DOWNLOADS$ = MKI$(DOWNLOADS) LSET USER.UPLOADS$ = MKI$(UPLOADS) LSET TODAY.DL$ = MKS$(DL.TODAY!) LSET TODAY.BYTES$ = MKS$(BYTES.TODAY!) LSET DL.BYTES$ = MKS$(DLBYTES!) LSET UL.BYTES$ = MKS$(ULBYTES!) LSET ELAPSED.TIME$ = MKI$(Q!) IF ADJUSTED.SECURITY THEN _ LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL) PUT 5,USER.FILE.INDEX SUBROUTINE.PARAMETER = 8 CALL FILELOCK IF ACTIVE.USER.FILE$ <> ORIG.USER.FILE$ AND LOGGING.OFF THEN _ 'KG102202 ACTIVE.USER.FILE$ = ORIG.USER.FILE$ : _ USER.FILE.INDEX = ORIG.USER.FILE.INDEX : _ UPDATE.DEFAULTS = FALSE : _ GOTO 10602 10607 IF EXIT.TO.DOORS OR NOT LOGGING.OFF THEN _ 'KG102202 EXIT SUB IF MAX.PER.DAY <= 0 THEN _ X = MINUTES.PER.SESSION! _ ELSE X = (MAX.PER.DAY - Q!) : _ X = -(X > 0) * X CALL QTPUT (CX$(3)+STR$(X)+CX$(6)+" min"+CX$(5)+" left for next call today",1) CALL QTPUT(CX$(6)+FIRST.NAME$ +CX$(2)+ ", Thanks for calling "+_ CX$(5)+RBBS.NAME$+CX$(3)+" and please call again!",1) IF NOT HIGHLIGHT.OFF THEN _ CALL QTPUT (COLOR.RESET$,1) CALL DELAYIT (8 + BPS) END SUB ' $SUBTITLE: 'DOSEXIT -- Setup to exit to DOS for SYSOP' ' $PAGE ' SUBROUTINE NAME -- DOSEXIT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' COM.PORT$ ' DOORS.TERMINAL.TYPE ' MULTI.LINK.PRESENT ' RBBS.BAT$ ' REDIRECT.IO.METHOD ' USE.DEVICE.DRIVER$ ' ' OUTPUT PARAMETERS -- Q NUMBER OF LINES TO WRITE OUT TO ' RCTTY.BAT$ ' B$() LINES TO WRITE OUT TO RCTTY.BAT$ ' ' SUBROUTINE PURPOSE -- SET UP B$() AND Q IN ORDER TO CALL "RBBSEXIT" AND ' EXIT TO DOS FOR THE REMOTE RBBS-PC SYSOP ' SUB DOSEXIT STATIC 10934 IF MULTI.LINK.PRESENT AND _ DOORS.TERMINAL.TYPE > 0 THEN _ FF = 0 : _ GOTO 10950 A$(1) = "ECHO OFF" IF USE.DEVICE.DRIVER$ <> "" THEN _ PORT$ = USE.DEVICE.DRIVER$ _ ELSE PORT$ = "COM" + RIGHT$(COM.PORT$,1) IF REDIRECT.IO.METHOD THEN _ FF = 5 : _ A$(2) = "CTTY " + _ PORT$ : _ A$(3) = DISK.FOR.DOS$ + _ "COMMAND" : _ A$(4) = "CTTY CON" : _ A$(5) = RBBS.BAT$ _ ELSE FF = 3 : _ A$(2) = DISK.FOR.DOS$ + _ "COMMAND >" + _ PORT$ + _ " <" + _ PORT$ : _ A$(3) = RBBS.BAT$ 10950 SUBROUTINE.PARAMETER = 1 CALL AMORPM CALL UPDTCALR ("Exited to DOS at " + TIM$,2) CALL QTPUT("RBBS-PC " + VERSION.ID$,1) CALL QTPUT("SYSOP in Remote Console Mode",1) CALL RBBSEXIT (A$(),FF) END SUB ' $SUBTITLE: 'WORDINFILE -- Searches a file to find a word' ' $PAGE ' SUBROUTINE NAME -- WORDINFILE ' ' INPUT PARAMETERS -- PARAMETER MEANING ' FILNAME$ FILE TO SEARCH IN ' STRNG$ STRING TO SEARCH FOR ' ' OUTPUT PARAMETERS -- INFILE WHETHER STRING FOUND IN FILE ' ' SUBROUTINE PURPOSE -- SEARCHES FOR "STRNG$" IN FILE "FILNAME$." USED TO ' LIMIT DOORS AND QUESTIONNAIRES TO THOSE SPECIFIED ' IN THEIR MENU FILES. THE "STRNG$" IS CAPITALIZED ' BUT NOT THE LINES IN THE FILE, SO MUST BE EXACT ' CASE-SENSITIVE MATCH TO BE FOUND. THE ONLY CHARACTER ' THAT CAN IMMEDIATELY PROCEED OR END A NAME TO BE ' FOUND MUST BE A BLANK. ' SUB WORDINFILE (FILNAME$,STRNG$,INFILE) STATIC 10976 INFILE = FALSE CALL FINDIT (FILNAME$) IF NOT OK THEN _ EXIT SUB X = 0 CALL ALLCAPS (STRNG$) WHILE NOT EOF(2) AND X < 1 LINE INPUT #2,A$ Y = 1 10978 X = INSTR(Y,A$,STRNG$) IF X < 1 THEN _ GOTO 10980 Y = X + 1 IF X > 1 THEN _ IF MID$(A$,X - 1,1) <> " " THEN _ X = 0 IF X > 0 THEN _ L = LEN(STRNG$) : _ IF LEN(A$) => (X + L) THEN _ IF MID$(A$,X + L,1) <> " " THEN _ X = 0 IF X = 0 THEN _ GOTO 10978 10980 WEND CLOSE 2 INFILE = (X > 0) END SUB ' $SUBTITLE: 'DOOREXIT -- Setup to exit to a "door"' ' $PAGE ' SUBROUTINE NAME -- DOOREXIT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' MULTI.LINK.PRESENT ' NODE.ID$ ' RBBS.BAT$ ' Z$ ' ' OUTPUT PARAMETERS -- Q NUMBER OF LINES TO WRITE OUT TO ' RCTTY.BAT$ ' B$() LINES TO WRITE OUT TO RCTTY.BAT$ ' ' SUBROUTINE PURPOSE -- SET UP B$() AND Q IN ORDER TO CALL "EXITRBBS" AND ' EXIT RBBS-PC TO INVOKE ANTOHER PROGRAM ' SUB DOOREXIT STATIC IF Z$ = "" OR _ Z$ = "NONE" THEN _ EXIT SUB CALL FINDIT (Z$) IF NOT OK THEN _ A$ = "Missing door program" : _ CALL UPDTCALR (A$ + " " + Z$,1) : _ SNOOP = TRUE : _ CALL LPRNT (A$,1) : _ EXIT SUB 10987 A$(1) = DISK.FOR.DOS$ + _ "COMMAND /C " + _ Z$ + _ " " + _ NODE.ID$ A$(2) = RBBS.BAT$ Z$ = LEFT$(Z$,LEN(Z$) - 4) IF TRANSFER.FUNCTION = 3 THEN _ Y$ = "Registration" : _ ELSE Y$ = Z$ A$ = Y$ + _ " door opened at " + _ TIME$ + _ " on " + _ DATE$ SUBROUTINE.PARAMETER = 5 CALL TPUT CALL UPDTCALR (Z$ + " door opened! "+ TIME$,2) CALL QTPUT (Cx$(5)+"Takes approx 30 - 40 seconds.....",2) CLOSE 2 DOORFILE$ = "DORINFO"+ NODE.FILE.ID$ + ".DEF" CALL KILLWORK (DOORFILE$) EC = 0 OPEN "O",2,"DORINFO" + _ NODE.FILE.ID$ + _ ".DEF" PRINT #2,RBBS.NAME$ PRINT #2,SYSOP.FIRST.NAME$ PRINT #2,SYSOP.LAST.NAME$ IF LOCAL.USER THEN _ ' KG120906 PRINT #2,"COM0" _ ' KG120906 ELSE PRINT #2,COM.PORT$ ' KG120906 B$ = MID$(BAUD.PARITY$,INSTR(BAUD.PARITY$," B")) PRINT #2,TALK.TO.MODEM.AT$;B$ PRINT #2,NETWORK.TYPE IF GLOBAL.SYSOP THEN _ PRINT #2,SYSOP.FIRST.NAME$ : _ ' KP101112 PRINT #2,SYSOP.LAST.NAME$ _ ELSE PRINT #2,ORIG.FIRST.NAME$ : _ PRINT #2,LAST.NAME$ PRINT #2,CITY.STATE$ PRINT #2,GR PRINT #2,USER.SECURITY.LEVEL CALL TIMEREMAIN (TIME.REMAINING!) PRINT #2,INT(TIME.REMAINING!) PRINT #2,FOSSIL CALL RBBSEXIT (A$(),2) END SUB ' $SUBTITLE: 'RBBSEXIT -- Setup to exit RBBS' ' $PAGE ' SUBROUTINE NAME -- RBBSEXIT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' LINE.ARA Array of lines to write to batch file ' NUM.LINES How many lines in array ' ' OUTPUT PARAMETERS -- RCTTY.BAT$ ' ' SUBROUTINE PURPOSE -- TO CREATE A BATCH FILE THAT CONTROL CAN BE PASSED TO ' AND TO EXIT RBBS-PC WHILE STILL KEEPING CARRIER UP ' SUB RBBSEXIT (LINE.ARA$(1),NUM.LINES) STATIC 10992 CLOSE 2 IF NUM.LINES = 0 THEN _ GOTO 10994 OPEN "O",2,RCTTY.BAT$ FOR I = 1 TO NUM.LINES IF LINE.ARA$(I) <> "" THEN _ PRINT #2,LINE.ARA$(I) NEXT CLOSE 2 10994 CLOSE 3 EXIT.TO.DOORS = TRUE IF NOT FOSSIL THEN _ OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1 IF NOT PRIVATE.DOOR THEN _ CALL MLINIT (2) 10996 CALL UPDATEU (TRUE) 'KG102202 CALL GETIME CALL SAVEPROF (1) IF NUM.LINES = 0 THEN _ EXIT SUB CALL DELAYIT (9 + BPS) IF FOSSIL THEN _ CALL FOSEXIT(COMPORT%) SYSTEM END SUB ' $SUBTITLE: 'SETSECT -- Setup section prompts' ' $PAGE ' SUBROUTINE NAME -- SETSECT Doug Azzarito ' ' INPUT PARAMETERS -- PARAMETER MEANING ' MENU.INDEX 2 = user is in MAIN section ' 3 = user is in FILE section ' 4 = user is in UTIL section ' 6 = user is in LIBR section ' ' OUTPUT PARAMETERS -- SECTION$ 4 character section name ' ACTIVE.MENU$ 1 character section name ' SECTION.PROMPT$ Section name (if SHOW.SECTION config) ' COMMAND.PROMPT$ Command input prompt string ' SECTION.OPTS$ List of options valid in this sect ' INVALID.OPTS$ List of options invalid in this sect ' SUB.SECTION Index into security array for section ' ' SUBROUTINE PURPOSE -- TO BUILD THE PROMPT STRINGS FOR THE CURRENT SECTION ' SUB SETSECT STATIC 12000 ON MENU.INDEX GOTO 12001, 12010,12005,12020,12001,12015 12001 EXIT SUB 12005 LSET SECTION$ = "FILE" SECTION.OPTS$ = FILE.OPTS$ INVALID.OPTS$ = INVALID.FILE.OPTS$ SUB.SECTION = BEG.FILE GOTO 12025 12010 LSET SECTION$ = "MAIN" SECTION.OPTS$ = MAIN.OPTS$ INVALID.OPTS$ = INVALID.MAIN.OPTS$ SUB.SECTION = BEG.MAIN GOTO 12025 12015 LSET SECTION$ = "LIBR" SECTION.OPTS$ = LIBRARY.OPTS$ INVALID.OPTS$ = INVALID.LIBRARY.OPTS$ SUB.SECTION = BEG.LIBRARY GOTO 12025 12020 LSET SECTION$ = "UTIL" SECTION.OPTS$ = UTIL.OPTS$ INVALID.OPTS$ = INVALID.UTIL.OPTS$ SUB.SECTION = BEG.UTIL 12025 ACTIVE.MENU$ = LEFT$(SECTION$,1) IF SHOW.SECTION THEN _ SECTION.PROMPT$ = SECTION$ _ ELSE SECTION.PROMPT$ = "Your" IF COMMANDS.IN.PROMPT=0 THEN _ SECTION.OPTS$ = "" COMMAND.PROMPT$ = SECTION.PROMPT$ + _ " command" + _ SECTION.OPTS$ END SUB ' $SUBTITLE: 'UNTILRIGHT - subroutine to ask question until answer okay' ' $PAGE ' ' SUBROUTINE NAME -- UNTILRIGHT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' QUES$ QUESTION TO BE ASKED THE USER ' ANS$ LOCATION TO STORE THE ANSWER ' MIN.LEN MINIMUM LENGTH OF ANSWER ' MAX.LEN MAX LENGTH OF ANSWER ' ' OUTPUT PARAMETERS -- ANS$ RESPONSE TO THE QUESTION WHICH THE ' CALLERS SAYS IS CORRECT ' ' SUBROUTINE PURPOSE -- SUBROUTINE TO ASK A USER A QUESTION UNTIL THE CALLER ' RESPONDS THAT THE ANSWER IS CORRECT ' SUB UNTILRIGHT (QUES$,ANS$,MIN.LEN,MAX.LEN) STATIC 12880 SUBROUTINE.PARAMETER = 1 A$ = QUES$ CALL TGET IF SUBROUTINE.PARAMETER = -1 THEN _ GOTO 12882 IF Q = 0 THEN _ GOTO 12880 IF LEN(B$(1)) > MAX.LEN THEN _ CALL QTPUT (STR$(MAX.LEN) + " chars max",1) : _ GOTO 12880_ ELSE IF LEN(B$(1)) < MIN.LEN THEN _ CALL QTPUT (STR$(MIN.LEN) + " chars min",1) : _ GOTO 12880 ANS$ = B$(1) A$ = B$(1) + _ ", right ([Y],N)" TURBO.KEY = -TURBO.KEY.USER SUBROUTINE.PARAMETER = 1 CALL TGET IF SUBROUTINE.PARAMETER = -1 THEN _ GOTO 12882 IF NO THEN _ GOTO 12880 CALL ALLCAPS (ANS$) EXIT SUB 12882 ANS$ = "GUEST" END SUB ' $SUBTITLE: 'LOGERROR - subroutine to log errors to CALLERS file' ' $PAGE ' ' SUBROUTINE NAME -- LOGERROR ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ERR ERROR NUMBER DETECTED BY BASIC ' ERL LAST LINE NUMBER ENCOUNTERED ' PRIOR TO ENCOUNTERNING ERROR ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO SET UP A STRING TO WRITE TO THE CALLERS LOG ' INDICATING THE DATE, TIME, ERROR, AND ERROR LINE ' SUB LOGERROR STATIC 13660 IX = ERR IF ERR < 1 THEN _ IX = EC CALL UPDTCALR("+++ Error " + _ STR$(IX) + _ " line " + _ STR$(ERL) + _ " at " + _ TIME$ + _ " on " + _ DATE$,2) END SUB ' ' $SUBTITLE: 'CHECKRATIO - subroutine to print ul/dl ratio' ' $PAGE ' ' SUBROUTINE NAME -- CHECKRATIO ' ' INPUT PARAMETERS -- PARAMETER MEANING ' TELL.USER TELL USER THEIR RATIO ' DOWNLOADS FILES DOWNLOADED ' DLBYTES! BYTES DOWNLOADED ' UPLOADS FILES UPLOADED ' ULBYTES! BYTES UPLOADED ' ' OUTPUT PARAMETERS -- OK - IF IT IS OK FOR THE USER TO DOWNLOAD ' ' SUBROUTINE PURPOSE -- TO PRINT THE USERS UPLOAD TO DOWNLOAD RATIO ' AND TO DETERMINE IF THE USERS HAS VIOLATED ' THEIR UPLOAD TO DOWNLOAD RESTRICTION ' ' SUB CHECKRATIO (TELL.USER) STATIC OK = TRUE 20096 'IF NOT ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _ ' GOTO 20110 ' IF RATIO.RESTRICTION# = 0 THEN _ ' GOTO 20110 ' ' DETERMINE METHOD OF RATIO CHECKING TO BE PERFORMED ' IF BYTE.METHOD = 1 OR BYTE.METHOD = 3 THEN _ METHOD$ = "Bytes" : _ UL.WORK# = ULBYTES! : _ DL.WORK# = DLBYTES! IF BYTE.METHOD = 0 OR BYTE.METHOD = 2 THEN _ METHOD$ = "Files" : _ UL.WORK# = UPLOADS : _ DL.WORK# = DOWNLOADS IF BYTE.METHOD = 2 THEN _ TODAY# = RATIO.RESTRICTION# - DL.TODAY! IF BYTE.METHOD = 3 THEN _ TODAY# = RATIO.RESTRICTION# - BYTES.TODAY! - NUM.DNLD.BYTS! ' RATIO# = INT(DL.WORK# / 1) RATIO.SUFFIX$ = ":0" IF UL.WORK# > 0 THEN _ RATIO# = INT(DL.WORK# / UL.WORK#) : _ RATIO.SUFFIX$ = ":1" IF BYTE.METHOD < 2 THEN _ A$ = CX$(3)+"Todays Downloaded Files: " + CX$(5)+STR$(DL.TODAY!)+CRLF$ + _ CX$(2)+ "Number of Bytes today : " + CX$(4)+STR$(BYTES.TODAY!) +CRLF$ :_ A$ = A$ + METHOD$ +CX$(1)+ " Downloaded: "+CX$(2) + STR$(DL.WORK#)+CRLF$+ _ CX$(5)+ "Uploaded : "+CX$(3) + _ STR$(UL.WORK#)+CRLF$ : _ A$ = A$ + CX$(6)+ "Ratio : " +CX$(1)+ _ STR$(RATIO#) + _ RATIO.SUFFIX$ +CX$(7)+CRLF$ : _ SUBROUTINE.PARAMETER = 5 : _ CALL TPUT IF BYTE.METHOD > 1 THEN _ A$ = "Today Downloaded Files: " + STR$(DL.TODAY!)+CRLF$ + _ "Bytes:" + STR$(BYTES.TODAY!)+CRLF$ : _ SUBROUTINE.PARAMETER = 5 : _ CALL TPUT : _ CALL SKIPLINE (1) IF RATIO.RESTRICTION# = 0 THEN _ GOTO 20110 ' ' CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION ' 20100 IF NOT (RATIO.RESTRICTION# > 0 AND TELL.USER) THEN _ EXIT SUB IF BYTE.METHOD <= 1 THEN _ GOTO 20105 IF TODAY# <= 0 THEN _ A$ = "Sorry, Daily download limit of" + _ STR$(RATIO.RESTRICTION#) + " " + _ METHOD$ + " Reached" : _ OK = FALSE _ ELSE A$ = "Download balance remaining:" + _ STR$(RATIO.RESTRICTION#) + _ " " + _ METHOD$ : _ OK = TRUE SUBROUTINE.PARAMETER = 5 CALL TPUT CALL SKIPLINE(1) EXIT SUB ' 20105 IF RATIO# >= RATIO.RESTRICTION# THEN _ OK = FALSE : _ A$ = "Sorry, DL/UL ratio of" + _ STR$(RATIO.RESTRICTION#) + _ ":1 " + _ METHOD$ + " exceeded" : _ SUBROUTINE.PARAMETER = 5 : _ CALL TPUT : _ A$ = "Minimum upload of" + _ STR$(INT(((DL.WORK# - (UL.WORK# * RATIO.RESTRICTION#)) _ / RATIO.RESTRICTION#) + 1)) + _ + " " + METHOD$ + " required before You may download" _ ELSE A$ = "Balance remaining before upload required:" + _ STR$(INT((UL.WORK# * RATIO.RESTRICTION#)-DL.WORK#)) + _ " " + METHOD$ SUBROUTINE.PARAMETER = 5 CALL TPUT CALL SKIPLINE (1) 20110 END SUB ' $SUBTITLE: 'GETARC - subroutine to get what files to verbose list' ' $PAGE ' ' SUBROUTINE NAME -- GETARC ' ' INPUT PARAMETERS -- PARAMETER MEANING ' Q NUMBER OF ENTRIES TYPED ' B$() ENTRIES TYPED ' ' OUTPUT PARAMETERS -- ' ' SUBROUTINE PURPOSE -- PROCESS THE V)ERBOSE ARC LIST COMMAND. ' TAKES WHAT USER TYPES AND TRIES TO LIST IT. ' SUB GETARC STATIC IF Q > 1 THEN _ B = 2 : _ GOTO 20142 20141 A$ = "Enter Compressed file(s) to list" SUBROUTINE.PARAMETER = 1 CALL TGET IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _ EXIT SUB B = 1 20142 LAST.INDEX = Q ANS.INDEX = B VIOLATION$ = "View ARC" FOR ARC.INDEX = ANS.INDEX TO LAST.INDEX GOSUB 20143 NEXT EXIT SUB '****************************** ROUTINE TO CHECK FILE TYPE ********** ' Depending on the File Extension we will decide what Comression utility ' to use...as of this date *.ZOO and *.DWC file are not supported but will ' be added here soon ! -Pete- ' 20143 Z$ = B$(ARC.INDEX) CALL ALLCAPS (Z$) CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE) IF EXT$ = "ARC"_ OR EXT$ = "PAK"_ OR EXT$ = "ZOO" _ OR EXT$ = "ZIP" _ OR EXT$ = "DWC" THEN _ ARK = TRUE ELSE _ CALL QTPUT ("Only ARC,PAK,ZOO,ZIP or DWC files can be viewed",1) : _ RETURN ' LAST.EXT$ = EXT$ FILE.NAME.HOLD$ = Z$ FILE.NAME$ = Z$ CALL BADFILE (PREFIX$,BAD.FILE.NAME.INDEX) ON BAD.FILE.NAME.INDEX GOTO 20144,20146,20147 20144 CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX) ON BAD.FILE.NAME.INDEX GOTO 20145,20146,20147 20145 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + (NOT SYSOP),TRUE) IF OK THEN _ GOTO 20148 20146 Z$ = B$(ARC.INDEX) + _ " not found!" CALL UPDTCALR (Z$,2) A$ = Z$ + _ " Type correct filename" + PRESS.ENTER.EXPERT$ SUBROUTINE.PARAMETER = 1 CALL TGET IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _ RETURN B$(ARC.INDEX) = B$(1) GOTO 20143 20147 CALL SVIOLATION IF DENY.ACCESS THEN _ EXIT SUB GOTO 20146 20148 CALL QTPUT(FILE.NAME.HOLD$ + " has these files",1) CALL VIEWARC ' This is in RBBSSUB4.BAS CALL VIEWTXT 'Pete Eibl RBBSSUB1.BAS ' CALL DLVIEWARC 'Pete Eibl RBBSSUB1.BAS IF SUBROUTINE.PARAMETER = -1 THEN _ ARC.INDEX = LAST.INDEX + 1 RETURN END SUB ' $SUBTITLE: 'BADNAME - subroutine to find bad file names' ' $PAGE ' ' SUBROUTINE NAME -- BADNAME ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ACTIVE.MESSAGE.FILE$ ' ACTIVE.USER.FILE$ ' CALLERS.FILE$ ' COMMENTS.FILE$ ' CONFIG.FILEANAME$ ' MAIN.MESSAGE.BACKUP$ ' MAIN.MESSAGE.FILE$ ' MAXIMUM.VIOLATIONS ' PASSWORDS.FILE$ ' RBBS.BAT$ ' RCTTY.BAT$ ' SUBDIR$() ' SUBDIR.INDEX ' VIOLATION$ ' VIOLATIONS.THIS.SESSION ' Z$ NAME OF FILE ' ' OUTPUT PARAMETERS -- BAD.FILE.NAME.INDEX 1 = FILE NAME IS OK ' 2 = SECURITY BREACH TRIED ' VIOLATIONS.THIS.SESSION NUMBER OF VIOLATIONS ' FILENAME$ NAME OF FILE ' ' SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES ' TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S ' SECURITY ' SUB BADNAME (BAD.FILE.NAME.INDEX) STATIC ' ' * ' * TEST FOR SYSTEM FILE ATTEMPT * ' * 20235 BAD.FILE.NAME.INDEX = 1 Z$ = FILE.NAME$ IF INSTR(3,FILE.NAME$,MID$(ACTIVE.MESSAGE.FILE$,3,(LEN(ACTIVE.MESSAGE.FILE$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$,3,(LEN(ACTIVE.USER.FILE$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(ACTIVE.USER.FILE$ + ".BAK",3,(LEN(ACTIVE.USER.FILE$ + ".BAK") - 2))) THEN _ GOTO 20236 IF LEN(CALLERS.FILE$) > 2 THEN _ IF INSTR(3,FILE.NAME$,MID$(CALLERS.FILE$,3,(LEN(CALLERS.FILE$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(COMMENTS.FILE$,3,(LEN(COMMENTS.FILE$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(FILESEC.FILE$,3,(LEN(FILESEC.FILE$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.BACKUP$,3,(LEN(MAIN.MESSAGE.BACKUP$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(MAIN.MESSAGE.FILE$,3,(LEN(MAIN.MESSAGE.FILE$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$,3,(LEN(MAIN.USER.FILE$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(MAIN.USER.FILE$ + ".BAK",3,(LEN(MAIN.USER.FILE$ + ".BAK") - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(PASSWORDS.FILE$,3,(LEN(PASSWORDS.FILE$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(RBBS.BAT$,3,(LEN(RBBS.BAT$) - 2))) THEN _ GOTO 20236 IF INSTR(3,FILE.NAME$,MID$(RCTTY.BAT$,3,(LEN(RCTTY.BAT$) - 2))) THEN _ GOTO 20236 CALL BRKFNAME (CONFIG.FILENAME$,DR$,PREFIX$,EXTENSION$,FALSE) IF INSTR(3,FILE.NAME$,MID$(CONFIG.FILENAME$,LEN(DR$) + 1)) THEN _ GOTO 20236 EXIT SUB 20236 BAD.FILE.NAME.INDEX = 2 END SUB ' $SUBTITLE: 'BRKFNAME - subroutine to split file name into components' ' $PAGE ' ' SUBROUTINE NAME -- BRKFNAME ' ' INPUT PARAMETERS -- PARAMETER MEANING ' FILENAME$ FULL NAME OF FILE ' FOR.JOINING TRUE IF WANT PARTS FORMATTED FOR ' FORMING FILE NAMES ' OUTPUT PARAMETERS -- DRVPATH$ DRIVE AND PATH ' PREFIX$ PREFIX OF FILE NAME ' EXTENSION$ EXTENSION OF FILE NAME ' ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH, ' "ARCE" AS PREFIX OF THE FILE NAME, AND ' "COM" AS THE EXTENSION OF THE FILE NAME. ' ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM ' ' SUBROUTINE PURPOSE -- TO BREAK A FILE NAME INTO ITS COMPONENT PARTS ' OF DRIVE/PATH, PREFIX, AND EXTENSION ' ' SUB BRKFNAME (FILENAME$,DRVPATH$,PREFIX$,EXTENSION$,FOR.JOINING) STATIC 20282 CALL ALLCAPS (FILENAME$) DRVPATH$ = "" PREFIX$ = "" EXTENSION$ = "" CALL TRIMTRAIL (FILENAME$,"\") L = LEN(FILENAME$) IF L < 1 THEN _ EXIT SUB CALL FINDLAST (FILENAME$,"\",X,Y) IF X < 1 THEN _ IF MID$(FILENAME$,2,1) = ":" THEN _ DRVPATH$ = LEFT$(FILENAME$,1) : _ S = 3 _ ELSE S = 1 _ ELSE DRVPATH$ = LEFT$(FILENAME$,X-1) : _ S = X + 1 X = INSTR(FILENAME$ + ".",".") IF X < L THEN _ EXTENSION$ = MID$(FILENAME$,X + 1,3) IF S <= L THEN _ IF X >= S THEN _ PREFIX$ = MID$(FILENAME$,S,X - S) IF NOT FOR.JOINING THEN _ EXIT SUB IF LEN(DRVPATH$) = 1 THEN _ DRVPATH$ = DRVPATH$ + _ ":" IF INSTR(DRVPATH$,"\") > 0 THEN _ DRVPATH$ = DRVPATH$ + _ "\" IF LEN(EXTENSION$) > 0 THEN _ EXTENSION$ = "." + _ EXTENSION$ END SUB ' $SUBTITLE: 'WILDCARD -- Matches string to a pattern' ' $PAGE ' SUBROUTINE NAME -- WILDCARD ' ' INPUT PARAMETERS -- PARAMETER MEANING ' PATTERN$ PATTERN TO CHECK ' STRNG$ STRING TO FIE ' ' OUTPUT PARAMETERS -- OK TRUE IF MATCH FOUND ' FALSE IF NO MATCH WAS FOUND ' ' SUBROUTINE PURPOSE DETERMINE WHETHER A STRING IS AN INSTANCE IN A PATTERN ' SUPPORTED PATTERNS ARE ONLY "?" WHICH REQUIRES A ' CHARACTER BUT CAN BE ANY, AND "*" WHICH MATCHES ANY- ' THING, INCLUDING A NULL STRING. ANYTHING ELSE IN A ' MUST BE AN EXACT MATCH. ' ' SUB WILDCARD (PATTERN$,STRNG$) STATIC 20285 OK = TRUE K = 0 L = LEN(STRNG$) 20286 K = K + 1 IF K > L THEN _ GOTO 20288 B$ = MID$(PATTERN$,K,1) IF B$ = "*" THEN _ EXIT SUB 20287 IF B$ <> "?" AND MID$(STRNG$,K,1) <> B$ THEN _ OK = FALSE : _ EXIT SUB GOTO 20286 20288 IF L < LEN(PATTERN$) AND MID$(PATTERN$,L + 1,1) <> "*" THEN _ OK = FALSE END SUB ' $SUBTITLE: 'ABORTLOGOFF -- RBBS-PC common routine to Abort Autologoff' ' $PAGE ' ' SUB ABORTLOGOFF STATIC ON SUBROUTINE.PARAMETER GOTO 20300,20326 ' ' * ' * COMMON INPUT ROUTINE * ' * ' 20300 CALL CARRIER IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB LINES.PRINTED = 0 DISPLAY.AS.UNIT = FALSE TOA! = FRE("A") IF AUTO.END =0 THEN _ 'pe 04/08/89 EXIT SUB TEMP! = AUTO.LOGOFF! AUTO.LOGOFF! = 25 CALL SETABORT (AUTO.LOGOFF!,15) AUTO.WARN! = AUTO.LOGOFF! - 30 A = 0 B = 0 C = 0 Q = 1 PARM = 0 EOL = FALSE YES = FALSE B$ = "" SLEEP.WARN = TRUE NO = FALSE CALL COLORPMT (A$) A$ = A$ + _ MID$("! ! ",2*TURBO.KEY+1,2) SUBROUTINE.PARAMETER = 4 STOP.SAVE = STOP.INTERRUPTS STOP.INTERRUPTS = TRUE CALL TPUT STOP.INTERRUPTS = STOP.SAVE IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB 20323 IF PROMPT.BELL THEN _ IF LOCAL.USER THEN _ BEEP_ ELSE CALL PUTCOM(BELL.RINGER$) 20325 CALL CARRIER IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB IF (NOT FORCE.KEYBOARD) AND LEN(COMMPORT.STACK$) > 0 THEN _ Y$ = LEFT$(COMMPORT.STACK$,1) : _ COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _ GOTO 20341 IF LOCAL.USER THEN _ CALL FINDFUNC: _ IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB _ ELSE GOTO 20326 CALL EOFCOMM (CHAR%) IF CHAR% <> -1 THEN _ CALL GETCOM(Y$) : _ IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB _ ELSE GOTO 20341 CALL FINDTIME (TI!) IF TI! > AUTO.WARN! THEN _ IF TI! > AUTO.LOGOFF! THEN _ CALL UPDTCALR ("Used AutoLogoff",1) :_ SUBROUTINE.PARAMETER = -1 : _ EXIT SUB _ ELSE IF SLEEP.WARN THEN _ SLEEP.WARN = FALSE : _ A$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _ CALL RINGCALLER CALL FINDFUNC IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB 20326 CALL QTPUT (".",0) Call DELAYIT (1) Y$ = KEY.PRESSED$ IF Y$ <> "" THEN _ GOTO 20345 SEND.REMOTE = TRUE CALL GOIDLE GOTO 20325 20341 SEND.REMOTE = REMOTE.ECHO IF TEST.PARITY THEN _ GOTO 20342 IF Y$ = CHR$(127) THEN _ GOTO 20435 GOTO 20345 20342 IF Y$ = "" THEN _ Y$ = " " IF ASC(Y$) = 141 THEN _ OUT LINE.CONTROL.REGISTER,&H1A : _ EIGHT.BIT = FALSE : _ TEST.PARITY = FALSE : _ GR = FALSE Y$ = CHR$(ASC(Y$) AND 127) 20345 X$ = Y$ 'KG101503 IF INSTR(LINEEDIT.CHK$,Y$) > 5 _ GOTO 20435 IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _ GOTO 20325 IF Y$ = "^" THEN _ GOTO 20325 IF Y$ = CARRIAGE.RETURN$ THEN _ GOTO 20347 _ ELSE GOSUB 20350 IF TURBO.KEY < 1 THEN _ GOTO 20346 IF Y$ = " " THEN _ Y$ = "" IF Y$ <> "/" THEN _ B$ = Y$ : _ Y$ = CARRIAGE.RETURN$ : _ X$ = Y$ : _ 'KG101601 GOTO 20347 TURBO.KEY = 0 GOTO 20325 20346 IF LEN(B$) => 254 THEN _ A$ = "Input too long!" : _ SUBROUTINE.PARAMETER = 5 : _ CALL TPUT : _ IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB _ ELSE GOTO 20300 B$ = B$ + _ Y$ GOTO 20325 20347 TURBO.KEY = FALSE ' Carriage Return Handler HIDDEN = FALSE IF NO.ADVANCE THEN _ NO.ADVANCE = FALSE : _ GOTO 20375 _ ELSE CALL LPRNT (CRLF$,0) : _ GOSUB 20351 : _ GOTO 20370 20350 IF LOGON.ACTIVE THEN _ ' KG101503 IF (Y$ = " " OR Y$ = ";") AND _ ' KG101503 RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _ ' KG101503 PARM = PARM + 1 : _ ' KG101503 LOGON.ACTIVE = (PARM < 3) : _ ' KG101503 HIDDEN = (PARM = 2) : _ ' KG101503 CALL LPRNT(X$,0) : _ ' KG101503 GOTO 20351 ' KG1020303 'Was IF HIDDEN AND LOCAL.USER THEN..... IF HIDDEN THEN _ 'PE 11/04/88 X$ = "." ' KG101503 CALL LPRNT(X$,0) ' KG101503 20351 IF NOT SEND.REMOTE THEN _ RETURN 20353 CALL PUTCOM (X$) RETURN 20370 IF SEND.REMOTE THEN _ IF LINE.FEEDS THEN _ CALL PUTCOM (LINE.FEED$) 20375 IF LEN(B$) > 4000 THEN _ A$ = "Try again, " + _ FIRST.NAME$ : _ SUBROUTINE.PARAMETER = 5 : _ CALL TPUT : _ IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB _ ELSE GOTO 20300 IF PARSE.OFF THEN _ PARSE.OFF = FALSE : _ GOTO 20420 CALL PARSEIT IF Q = 1 THEN _ GOTO 20422 'KG012602 GOTO 20425 20420 B$(1) = B$ Q = 1 20422 IF B$ = "" THEN _ 'KG012602 Q = 0 : _ HIDDEN = FALSE : _ 'KG101502 AUTO.LOGOFF! = TEMP! EXIT SUB 20425 IF LEN(B$) < 4 THEN _ X$ = LEFT$(B$,3): _ CALL ALLCAPS (X$) : _ IF X$ = "Y" OR X$ = "YES" THEN _ YES = TRUE _ ELSE IF X$ = "N" OR X$ = "NO" OR X$ = "A" THEN _ NO = TRUE _ ELSE IF X$ = "RE" THEN _ REPLY = TRUE : _ EXIT SUB _ ELSE IF X$ = "K" THEN _ KILL.MESSAGE = TRUE : _ EXIT SUB IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _ NON.STOP = TRUE : _ B$(Q) = "" : _ IF Q > 1 THEN _ Q = Q-1 FORCE.KEYBOARD = FALSE HIDDEN = FALSE 'KG101503 EXIT SUB 20435 IF LEN(B$) = 0 THEN _ GOTO 20325 IF LOGON.ACTIVE THEN _ IF INSTR(" ;",RIGHT$(B$,1)) > 0 THEN _ PARM = PARM - 1 B$ = LEFT$(B$,LEN(B$)-1) CALL LPRNT(LOCAL.BACKSPACE$,0) IF SEND.REMOTE THEN _ CALL PUTCOM(BACKSPACE$) GOTO 20325 AUTO.LOGOFF! = TEMP! END SUB