' $linesize:132 ' $title: 'RBBSSUB2.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack' ' Copyright 1989 by D. Thomas Mack, all rights reserved. ' Name ...............: RBBSSUB2.BAS ' Written by .........: D. Thomas Mack ' First Released .....: May 28, 1989 ' Subsequent Releases.: 07-30-89 ' Copyright ..........: 1986 - 1989 ' 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 RBBSSUB 2-5 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 ' ACHKMAC 1320 Check/execute macro ' ANSWERIT 200 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 ' 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 10983 Set up a .BAT file to exit RBBS-PC to a "door" ' DOSEXIT 10934 Set up a .BAT file to exit to DOS (second level) ' EDITALINE 2618 Edits a single line ' EDITDEF Edit configuration parameters ' FSECCHK 20240 Matches file name to a prefix & extension ' GETARC 20140 Handle request for verbose listing ' GETCOMND 101 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 3952 Delete old or unnecessary messages ' LINE25 945 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 8 Handle MultiLink initialization/de-initialization ' MSGPROT 2055 Sets protection for a message ' MSGTO 2018 Sets who a message is to ' PAGLEN 5200 Change page length ' PARSEIT 1637 Parses a string ' PASSWRD 660 Verify user & message passwords ' PSCRN 1483 Print to display ' QLPRNT 1482 Quickly writes count of blocks on file transfer ' QTPUT 1478 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 1636 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 4554 Set up request for threading thru messages ' SKIPLINE 1485 Write a # of blank lines to the communications port ' SRCHCMND 1238 Searches list of commands in RBBS for a request ' SVIOLATION 1380 Process a security violation ' SYSMENU 112 Displays sysop menu/status ' SYSOPCHAT 4773 Sysop and caller chat ' TESTREL 336 Tests for Reliable connect ' TGET 1498 Read a line from the communications port ' TPUT 1396 Write a line to the communications port ' TRIM 105 Strip leading and trailing blanks from a string ' TRIMTRAIL 107 Strip off specified string off end of another string ' UNTILRIGHT 12878 Ask a question until user says answer is right ' UPDATEU 10600 Updates the user record on loging off/exiting RBBS-PC ' VARINIT 109 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 ' WORDINFILE 10976 Find a whole word within a file/menu ' ' $INCLUDE: 'RBBS-VAR.BAS' ' 8 ' $SUBTITLE: 'MLINIT - MultiLink initialization/deinitialization' ' $PAGE ' ' NAME -- MLINIT ' ' INPUTS -- 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 ' ' OUTPUTS -- NONE ' ' 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 ' KG090102 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 90 ' $SUBTITLE: 'GOIDLE - release control when waiting' ' $PAGE ' ' NAME -- GOIDLE ' ' INPUTS -- MLCOM ' NETWORK.TYPE ' ' OUTPUTS -- NONE ' ' PURPOSE -- To relinquish control when RBBS-PC is waiting for ' input from the communications port ' SUB GOIDLE STATIC IF MLCOM OR NETWORK.TYPE = 1 THEN _ CALL MLINIT(5) : _ EXIT SUB CALL GIVEBACK END SUB 97 ' $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright' ' $PAGE ' ' NAME -- COPYWRIT ' ' INPUTS -- NONE ' ' OUTPUTS -- NONE ' ' PURPOSE -- To display RBBS-PC's copyright notice on the local screen ' SUB COPYWRIT STATIC A = (RECYCLE.TO.DOS OR DEBUG OR NODE.RECORD.INDEX > 2) IF A THEN _ EXIT SUB WIDTH 80 REDIM A$(11) A$(1) = "If you use RBBS-PC CPC17.2A, please consider contributing to" A$(2) = "" A$(3) = " Capital PC Software Exchange" A$(4) = " Post Office Box 6128" A$(5) = " Silver Spring, Maryland 20906" A$(6) = "" A$(7) = "You are free to copy and share RBBS-PC CPC17.2A provided" A$(08)= " 1. This program is distributed unmodified" A$(09)= " 2. No fee or consideration is charged for RBBS-PC itself" A$(10)= " 3. This notice is not bypassed or removed." CLS KEY OFF LOCATE ,,0 SNOOP = -1 LOCAL.USER = -1 CALL LPRNT(SPACE$(60) + "tm",1) CALL LPRNT(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1) CALL SKIPLINE(1) CALL LPRNT(SPACE$(17) + "Capital PC User Group User-Supported Software",1) CALL SKIPLINE (1) CALL LPRNT(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1) FOR I = 1 TO 10 CALL LPRNT(SPACE$(5) + CHR$(186) + " " + A$(I) + SPACE$(62 - LEN(A$(I))) + CHR$(186),1) NEXT CALL LPRNT(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1) CALL LPRNT(SPACE$(5) + "Copyright (c) 1983-88 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1) SNOOP = 0 END SUB 101 ' $SUBTITLE: 'GETCOMND - sub to get command from command line' ' $PAGE ' ' NAME -- GETCOMND ' ' INPUTS -- 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 /reliable ' ' 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. ' ' OUTPUTS -- 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) ' ' PURPOSE -- To get node id from command line and determine if rbbs ' is being run as a door ' 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 103 ' ' ' * 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 : _ SUBDIR$(A) = "" _ ' KGO81203 ELSE SUBDIR$(A) = SUBDIR$(A) + MID$(CMD.LINE$,X,1) ' KG081203 NEXT NETIME$ = SUBDIR$(1) ' KG081203 IF A > 1 THEN _ NETBAUD$ = SUBDIR$(2) ' KG081203 IF A > 2 THEN _ NETRELIABLE$ = SUBDIR$(3) ' KG081203 CALL TRIM(NETIME$) CALL TRIM(NETBAUD$) CALL TRIM(NETRELIABLE$) 103 A = INSTR(PM$,"DEBUG") IF A > 0 THEN _ DEBUG = -1 : _ PM$ = LEFT$(PM$,A - 1) + _ RIGHT$(PM$,LEN(PM$) - A - 4) PASSED.DEBUG = DEBUG A = INSTR(PM$,"LOCAL") IF A > 0 THEN _ COM.PORT$ = "COM0" : _ PM$ = LEFT$(PM$,A - 1) + _ RIGHT$(PM$,LEN(PM$) - A - 4) 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 _ 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 105 ' $SUBTITLE: 'TRIM - sub to eliminate leading/trailing blanks' ' $PAGE ' ' NAME -- TRIM ' ' INPUTS -- PARAMETER MEANING ' TRIM.PARM$ STRING THAT IS TO HAVE LEADING ' AND TRAILING BLANKS ELIMINATED FROM ' ' OUTPUTS -- TRIM.PARM$ STRING WITH NO LEADING OR TRAILING ' BLANKS ' ' PURPOSE -- To strip leading and trailing blanks ' SUB TRIM (TRIM.PARM$) STATIC 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 ' 107 ' $SUBTITLE: 'TRIMTRAIL - sub to trim off trailing characters' ' $PAGE ' ' NAME -- TRIMTRAIL ' ' INPUTS -- PARAMETER MEANING ' TRIM.PARM$ WHAT STRING TO TRIM FROM ' KG081003 ' TRIM.THIS$ WHAT CHARACTER TO TRIM OFF END ' ' OUTPUTS -- NONE ' ' PURPOSE -- To remove all occurences of a character from end of string ' KG081003 ' SUB TRIMTRAIL (TRIM.PARM$,TRIM.THIS$) STATIC IF RIGHT$(TRIM.PARM$, 1) <> TRIM.THIS$ THEN _ ' KG081003 EXIT SUB ' KG081003 J = LEN(TRIM.PARM$) - 1 ' KG081003 108 IF J > 0 THEN _ ' KG081003 IF MID$(TRIM.PARM$, J, 1) = TRIM.THIS$ THEN _ ' KG081003 J = J - 1 : _ ' KG081003 GOTO 108 ' KG081003 TRIM.PARM$ = LEFT$(TRIM.PARM$, J) ' KG081003 END SUB ' 109 ' $SUBTITLE: 'VARINIT - subroutine to initialize system variables' ' $PAGE ' ' NAME -- VARINIT ' ' INPUTS -- PARAMETER MEANING ' NONE ' ' OUTPUTS -- NONE ' ' PURPOSE -- To initialize system variable ' SUB VARINIT STATIC 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 LAST.COMMAND$ = "M " ' KG060701 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 FI" 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 ' 112 ' $SUBTITLE: 'SYSMENU - sub to display RBBS-PC SYSOP menu' ' $PAGE ' ' NAME -- SYSMENU ' ' INPUTS -- PARAMETER MEANING ' DELAY! TIME IN SECONDS AFTER MIDNIGHT TO WAIT ' BEFORE DISPLAYING ' ' OUTPUTS -- NONE ' ' PURPOSE -- TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN ' SUB SYSMENU STATIC DELAY! = 0 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 ' 120 ' $SUBTITLE: 'EDITDEF - sub to edit config parameters' ' $PAGE ' ' NAME -- EDITDEF ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- OUTPUT STRING ' ' PURPOSE -- Interpretes and adjusts stored configuration parameters ' 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$) 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") IF LOCAL.USER.MODE THEN _ RECYCLE.TO.DOS = TRUE ECHOER$ = DEFAULT.ECHOER$ IF LEN(SCREEN.OUT.MSG$) < 2 THEN _ SCREEN.OUT.MSG$ = START.OF.HEADER$ SMART.TEXT$ = CHR$(SMART.TEXT) IF MAX.WORK.VAR < 13 THEN _ MAX.WORK.VAR = 13 ' ' *** 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$ : _ 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 ' 129 ' $SUBTITLE: 'ASCCODES - subrotuine to allow any ASCII codes' ' $PAGE ' ' NAME -- ASCCODES ' ' INPUTS -- PARAMETER MEANING ' LEFT.PAREN$ MARKS BEGINNING OF # ' RIGHT.PAREN$ MARKS END OF # ' STRNG$ INPUT STRING ' ' OUTPUTS -- STRNG$ OUTPUT STRING ' ' 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. ' (e.g. "123[32]4" is interpreted as "123 4"). ' 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 200 ' $SUBTITLE: 'ANSWERIT - sub to establish connection' ' $PAGE ' ' NAME -- ANSWERIT ' ' INPUTS -- PARAMETER MEANING ' SUBROUTINE.PARAMETER = 1 WAIT FOR PHONE TO RING ' = 2 CONTINUE LOOKING FOR CONNECT ' = 3 RENTRY AFTER FUNCTION KEY ' = 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 ' ' OUTPUTSS -- 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. ' ' PURPOSE -- To detect incoming call and establish connection. ' 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 ' KG061103 ' ' ' * 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 CALL AMORPMTD ' KG061203 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$) : _ ' KG090102 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) ' RS060402 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$ = "" 247 IF INP(MODEM.STATUS.REGISTER) > 127 OR (NOT NO.CALL) THEN _ GOTO 274 CALL FINDFUNC IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB 250 IF KEY.PRESSED$ = ESCAPE$ THEN _ SUBROUTINE.PARAMETER = 3 : _ EXIT SUB IF KEY.PRESSED$ <> "" THEN _ GOTO 235 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 GOTO 247 274 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$) : _ ' KG090102 GOTO 327 IF INSTR(MODEM.RESPONSE$,"FAST") THEN _ BAUD.TEST! = 19200 : _ ' KG090102 GOTO 327 IF INSTR(MODEM.RESPONSE$,"ONNECT") THEN _ BAUD.TEST! = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONNECT") + 7)) : _ ' KGO90102 GOTO 327 IF INSTR(MODEM.RESPONSE$,"ONLINE") THEN _ BAUD.TEST! = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONLINE") + 7)) : _ ' KG090102 GOTO 327 GOTO 324 327 CALL TESTREL (MODEM.RESPONSE$) 328 IF BAUD.TEST! = 0 OR BAUD.TEST! = 300 THEN _ ' KG090102 BAUD.TEST! = 300 : _ ' KG090102 BPS = -1 : _ GOTO 331 IF BAUD.TEST! = 1200 OR BAUD.TEST! = 1275 THEN _ ' KG090102 BPS = -3 : _ GOTO 331 IF BAUD.TEST! = 2400 THEN _ ' KG090102 BPS = -4 : _ GOTO 331 IF BAUD.TEST! = 4800 OR BAUD.TEST! = 9600 THEN _ ' KG090102 BPS = -4-(BAUD.TEST! /4800) : _ ' KG090102 GOTO 331 IF BAUD.TEST! = 19200 THEN _ ' KG090102 BPS = -7 : _ GOTO 331 IF BAUD.TEST! = 38400 THEN _ ' KG090201 BPS = -8 : _ ' KG090102 GOTO 331 ' KG090102 GOTO 324 331 CALL SETBAUD SUBROUTINE.PARAMETER = 2 335 DONT.WRITE = 0 END SUB 336 ' $SUBTITLE: 'TESTREL - Test for Reliable mode connection' ' $PAGE ' ' NAME -- TESTREL ' ' INPUTS -- PARAMETER MEANING ' STRNG$ String to check for reliable ' ' OUTPUTS -- RELIABLE.MODE Reliable mode indicator ' ' PURPOSE -- To test for reliable connect ' 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 455 ' $SUBTITLE: 'BADCHAR - sub to check user names for bad characters' ' $PAGE ' ' NAME -- BADCHAR ' ' INPUTS -- PARAMETER MEANING ' PASSED.NAME$ USER NAME ' ' OUTPUTS -- PASSED.NAME$ USER NAME WILL CONTAIN "" ' IF BAD CHARACTERS FOUND ' ' 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 660 ' $SUBTITLE: 'PASSWRD - verify User and Message passwords' ' $PAGE ' ' NAME -- PASSWRD ' ' INPUTS -- PARAMETER MEANING ' SUBROUTINE.PARAMETER = 1 VERIFY USER PASSWORD ' = 2 VERIFY MESSAGE PASSWORD ' = 3 VERIFY MESSAGE PASSWORD ' = 4 VERIFY MESSAGE PASSWORD ' = 5 VERIFY MESSAGE PASSWORD ' ' OUTPUTS -- PASSWORD.FAILED SET TO 0 IF PASSED ' SET TO -1 IF FAILED ' ' 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 _ PASSWORD.FAILED = TRUE : _ EXIT SUB 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$ = "" : _ EXIT SUB 680 CALL QTPUT1 ("Wrong password ") IF NOT MESSAGE.PASSWORD THEN _ CALL UPDTCALR (ACTIVE.USER.NAME$+" PW fail: " + Z$,1) GOTO 670 END SUB 945 ' $SUBTITLE: 'LINE25 - sub to build/display RBBS-PCs line 25' ' $PAGE ' ' NAME -- LINE25 ' ' INPUTS -- 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 ' ' OUTPUTS -- CURSOR.LINE CURRENT LINE ON SCREEN ' CURSOR.ROW CURRENT ROW ON CURSOR.LINE ' ' 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 _ IF AUTODOWNLOAD.AVAILABLE THEN _ LOCK.STATUS$ = SPACE$(3) + _ "AD " + _ TIME.LOGGED.ON$ _ ELSE 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 1238 ' $SUBTITLE: 'SRCHCMND - sub to search command list' ' $PAGE ' ' NAME -- SRCHCMND ' ' INPUTS -- PARAMETER MEANING ' STRT.POS POSITION TO BEGIN SEARCH AT ' ALL.OPTS$ STRING TO SEARCH (COMMAND LIST) ' Z$ WHAT TO LOOK FOR ' ' OUTPUTS -- WHERE.FOUND POSITION OF Z$ IN ALL.OPTS$ ' 0 IF NOT FOUND ' ' 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 subsections. ' SUB SRCHCMND (STRT.POS,WHERE.FOUND) STATIC 1240 IF LEN(Z$) < 1 THEN _ WHERE.FOUND = 0 : _ EXIT SUB CALL ALLCAPS (Z$) 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 GOTO 1242 ' KG060701 IF MID$(ORIG.COMMANDS$,WHERE.FOUND,1) = "G" THEN _ GOTO 1242 ' ACCEPT GOODBYE/GRAPHICS ' KG060701 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 THEN _ ' KG060701 LSET LAST.COMMAND$ = ACTIVE.MENU$ + MID$(ORIG.COMMANDS$,WHERE.FOUND) : _ EXIT SUB ' KG060701 IF MACRO.ACTIVE OR LEN(Z$) <> 1 THEN _ ' KG060701 EXIT SUB CALL ACHKMAC (Z$,FOUND) IF FOUND THEN _ CALL FDMACEXE : _ Z$ = B$(1) : _ GOTO 1240 END SUB 1320 ' $SUBTITLE: 'CHKMACRO - sub to check if macro exists & process' ' $PAGE ' ' NAME -- CHKMACRO ' ' INPUTS -- PARAMETER MEANING ' STRNG$ STRING TO CHECK IF IS A MACRO ' MACRO.DRVPATH$ DRIVE/PATH WHERE MACROS ARE ' MACRO.EXTENSION$ EXTENSION OF MACROS ' MACRO.OFF FORCE NO MACRO TO BE FOUND ' ' OUTPUTS -- MACRO.FOUND WHETHER A MACRO WAS FOUND ' STRNG$ SUBSTITUTE FOR COMMANDS ' COMMPORT.STACK$ REST OF MACRO ' 0 IF NOT FOUND ' ' 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 IF MACRO.EXTENSION$ = "" THEN _ ' KG060701 EXIT SUB ' KG060701 IF LEN(STRNG$) < MACRO.MIN THEN _ MACRO.MIN = 1 : _ EXIT SUB IF LEN(STRNG$) = 1 THEN _ TEMP$ = STRNG$ : _ CALL ALLCAPS (TEMP$) : _ IF INSTR(ALL.OPTS$,TEMP$) > 0 THEN _ EXIT SUB CALL ACHKMAC (STRNG$,MACRO.FOUND) END SUB 1325 ' $SUBTITLE: 'ACHKMAC - check if macro exists & process' ' $PAGE ' ' NAME -- ACHKMAC ' ' INPUTS -- PARAMETER MEANING ' STRNG$ STRING TO CHECK IF IS A MACRO ' MACRO.DRVPATH$ DRIVE/PATH WHERE MACROS ARE ' MACRO.EXTENSION$ EXTENSION OF MACROS ' MACRO.OFF FORCE NO MACRO TO BE FOUND ' ' OUTPUTS -- MACRO.FOUND WHETHER A MACRO WAS FOUND ' STRNG$ SUBSTITUTE FOR COMMANDS ' COMMPORT.STACK$ REST OF MACRO ' 0 IF NOT FOUND ' ' PURPOSE -- Executes a macro if found. Does not check if macro ' letter uses a command. SUB ACHKMAC (STRNG$,MACRO.FOUND) STATIC MACRO.FOUND = FALSE ' KG081101 TEMP$ = STRNG$ CALL BRKFNAME (TEMP$,DF$,PREFX$,X$,FALSE) IF TEMP$ = PREFX$ THEN _ FILNAME$ = MACRO.DRVPATH$ + STRNG$ + MACRO.EXTENSION$ _ ELSE FILNAME$ = STRNG$ CALL BADFILE (FILNAME$,A) IF A > 1 THEN _ EXIT SUB CALL GRAPHICX (USER.GRAPHIC.DEFAULT$,FILNAME$,6) ' KG061001 IF NOT OK THEN _ EXIT SUB ' KG061001 CALL READDIR (6,1) IF EC > 0 THEN _ EXIT SUB CALL CHECKINT (A$) IF EC > 0 OR USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _ EXIT SUB A = INSTR(A$,"/") ' KG060701 IF A > 0 THEN _ ' Check macro contraint ' KG060701 X$ = RIGHT$(A$,LEN(A$)-A) : _ ' KG060701 IF LEFT$(LAST.COMMAND$,LEN(X$)) <> X$ THEN _ ' KG060701 EXIT SUB ' KG060701 MACRO.ACTIVE = TRUE MACRO.FOUND = TRUE MACRO.ECHO = TRUE END SUB 1330 ' $SUBTITLE: 'VIEWHELP - Processes requests for help' ' $PAGE ' ' NAME -- VIEWHELP ' ' INPUTS -- 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 ' ' OUTPUTS -- DISPLAYS HELP ' ' PURPOSE -- The main help processor for RBBS. Puts up the ' optional menu. Accepts help with individual commands. ' SUB VIEWHELP (SECTION,GRAPHIC.DEFAULT$,HELP.DEFAULT$) STATIC 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 QTPUT1 (A$) : _ 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$,FILE.NAME$) CALL BUFFILE (FILE.NAME$,X) RETURN END SUB 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations' ' $PAGE ' ' NAME -- SVIOLATION ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- CURSOR.LINE CURRENT LINE ON SCREEN ' CURSOR.ROW CURRENT ROW ON CURSOR.LINE ' ' PURPOSE -- Inform caller of security violation, augment count of ' violations and determine whether too many occurred. ' SUB SVIOLATION STATIC CALL BUFFILE (SECVIO.HLP$,X) IF NOT OK THEN _ CALL QTPUT1 ("Sorry, " + FIRST.NAME$ + ", Security to LOW for this Feature") CALL UPDTCALR ("SV!-" + VIOLATION$,2) ' CALL MUZAK (3) 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$ = "SECURITY VIOLATION! 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 1386 ' $SUBTITLE: 'DENYACCESS - sub to permanently deny access' ' $PAGE ' ' NAME -- DENYACCESS ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- (USER'S RECORD) ' ' PURPOSE -- Permanently resets user's security level when access denied ' SUB DENYACCESS STATIC 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 1396 ' $SUBTITLE: 'TPUT -- common routine to write to comm. port' ' $PAGE ' ' NAME -- TPUT (TERMINAL PUT) ' ' INPUTS -- PARAMETER MEANING ' A$ STRING TO WRITE TO THE ' COMMUNICATIONS PORT ' SUBROUTINE.PARAMETER = 1 SKIP A LINE BEFORE WRITING ' TO THE COMMUNICATIONS PORT ' = 2 SKIP A LINE BEFORE WRITING ' TO THE COMMUNICATIONS PORT ' AND THEN SKIP TWO LINES ' AFTER WRITING TO THE COMM- ' UNICATIONS PORT ' = 3 WRITE TO THE COMMUNICATIONS ' PORT AND THEN SKIP TWO LINES ' = 4 WRITE TO THE COMMUNICATIONS ' PORT WITHOUT A CR/LF ' = 5 WRITE TO THE COMMUNICATIONS ' PORT WITH A CR/LF ' = 6 RESET EVERYTHING FOR INPUT STRING ' = 7 RE-ENTRY AFTER HANDLING A ' FUNCTION KEY ' ' OUTPUTS -- SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED ' FUNCTION.KEY <> 0 FUNCTION KEY PRESSED ' ' 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 CHKCARRIER : _ ' KG061203 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) 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 NO = TRUE ' KG060401 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 1478 ' $SUBTITLE: 'QTPUT - subroutine to quickly write to terminal' ' $PAGE ' ' NAME -- QTPUT ' ' INPUTS -- PARAMETER MEANING ' STRNG$ STRING TO WRITE OUT ' NUM.RETURNS NUMBER OF CARRIAGE RETURNS ' ' OUTPUTS -- NONE ' ' PURPOSE -- Subroutine to quickly write to the terminal. This is ' different from "TPUT" in the things it doesn't do: ' A.) NO function key check, ' B.) NO conversion to upper case, ' C.) NO check for carrier present ' D.) NO check for imbedded carriage return in "STRNG$" ' E.) 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) CALL SKIPLINE (NUM.RETURNS) END SUB SUB QTPUT1 (STRNG$) STATIC CALL QTPUT (STRNG$,1) END SUB 1480 ' $SUBTITLE: 'LPRNT - subroutine to write to display' ' $PAGE ' ' NAME -- LPRNT ' ' INPUTS -- PARAMETER MEANING ' STRNG$ STRING TO WRITE OUT ' NUM.RETURNS NUMBER OF CARRIAGE RETURNS ' ' OUTPUTS -- NONE ' ' PURPOSE -- Subroutine to write to the display. ' SUB LPRNT (STRNG$,NUM.RETURNS) STATIC IF NOT SNOOP THEN _ EXIT SUB CALL PSCRN (STRNG$) ' IF VOICE.TYPE <> 0 AND TALK.ALL THEN _ ' CALL TALK (65,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 1482 ' $SUBTITLE: 'QLPRNT - subroutine to quickly write to display' ' $PAGE ' ' NAME -- QLPRNT ' ' INPUTS -- PARAMETER MEANING ' STRNG$ STRING TO WRITE OUT ' NUM NUMBER OF CARRIAGE RETURNS ' ' OUTPUTS -- NONE ' ' 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) END SUB 1483 ' $SUBTITLE: 'PSCRN - subroutine to print to the screen' ' $PAGE ' ' NAME -- PSCRN ' ' INPUTS -- PARAMETER MEANING ' STRNG$ STRING TO WRITE OUT ' ' OUTPUTS -- NONE ' ' PURPOSE -- Writes to local screen regardless of whether you have ' carrier. Assumes have positioned cursor where you want. ' SUB PSCRN (STRNG$) STATIC 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 1485 ' $SUBTITLE: 'SKIPLINE - sub to write a blank line to user' ' $PAGE ' ' NAME -- SKIPLINE ' ' INPUTS -- PARAMETER MEANING ' LOCAL.USER ' MODEM.STATUS.REGISTER ' NUM.RETURNS ' RETURN.LINE.FEED$ ' SNOOP ' ' OUTPUTS -- NONE ' ' PURPOSE -- Skip lines on the user's terminal ' SUB SKIPLINE (NUM.RETURNS) STATIC 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 1496 ' $SUBTITLE: 'SETCRLF -- sub to set up nulls/lf's for output' ' $PAGE ' ' NAME -- SETCRLF ' ' INPUTS -- PARAMETER MEANING ' CARRIAGE.RETURN$ CARRIAGE RETURN CHARACTER ' LINE.FEED$ LINE FEED CHARACTER ' LINE.FEEDS LINE FEED SWITCH ' NUL$ NULL CHARACTER ' ' OUTPUTS -- RETURN.LINE.FEED$ END-OF-LINE STRING ' ' PURPOSE -- Set up the necessary nulls/line feeds to end ' each output to the communications port with. ' SUB SETCRLF STATIC RETURN.LINE.FEED$ = _ MID$(CARRIAGE.RETURN$,1, - (NOT LOCAL.USER)) + _ NUL$ + _ MID$(LINE.FEED$,1, - (LINE.FEEDS <> 0)) END SUB 1498 ' $SUBTITLE: 'TGET -- ask a user a question and get reply' ' $PAGE ' ' NAME -- TGET ' ' INPUTS -- PARAMETER MEANING ' SUBROUTINE.PARAMETER = 1 STANDARD ENTRY ' = 2 ENTRY AFTER A FUNCTION KEY ' KG081201 ' HAS BEEN HANDLED ' KG081201 ' = 3 ENTRY AFTER STACKED COMMAND ' KG081201 ' 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. ' ' OUTPUTS -- 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,1538,1625 ' KG081201 ' ' ' * COMMON INPUT ROUTINE ' ' 1500 CALL CARRIER IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB ' KG061203 LINES.PRINTED = 0 DISPLAY.AS.UNIT = FALSE IN.STACK = FALSE TOA! = FRE("A") GOSUB 1580 ' KG071906 A = 0 B = 0 C = 0 Q = 1 STORE.PARSE.AT = 1 ' KG083101 PARM = 0 YES = FALSE B$ = "" SLEEP.WARN = TRUE NO = FALSE NON.STOP = (PAGE.LENGTH < 1) ' KG072603 IF A$ = "" THEN _ GOTO 1525 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 LEN(COMMPORT.STACK$) > 0 THEN _ ' KG072602 IN.STACK = TRUE : _ X = INSTR(COMMPORT.STACK$,CARRIAGE.RETURN$) : _ IF X > 0 THEN _ A$ = LEFT$(COMMPORT.STACK$,X-1) : _ COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-X) : _ GOTO 1534 _ ELSE Y$ = LEFT$(COMMPORT.STACK$,1) : _ COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _ GOTO 1541 IF (FORCE.KEYBOARD OR (NOT MACRO.ACTIVE) OR (MACRO.SAVE > 0)) THEN _ GOTO 1536 ' ' *** MACRO PROCESSING ' 1526 CALL READMACRO IF (DISTANT.TGET > 0 ) OR (MACRO.TEMPLATE$ <> "") OR (MACRO.SAVE > 0) OR (NOT MACRO.ACTIVE) THEN _ GOTO 1536 1534 B$ = A$ ' Not Macro command - pass to normal processing IF MACRO.ECHO THEN _ SUBROUTINE.PARAMETER = 4 : _ CALL TPUT Y$ = CARRIAGE.RETURN$ GOTO 1547 1536 IF LOCAL.USER THEN _ CALL FINDFUNC: _ IF SUBROUTINE.PARAMETER < 0 THEN _ EXIT SUB _ ELSE GOTO 1538 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 1538 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$ 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$ : _ GOTO 1547 TURBO.KEY = 0 GOTO 1525 1546 IF LEN(B$) => 512 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 _ IF (Y$ = " " OR Y$ = ";") AND _ RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _ PARM = PARM + 1 : _ LOGON.ACTIVE = (PARM < 3) : _ HIDDEN = (PARM = 2) : _ CALL LPRNT(X$,0) : _ GOTO 1551 IF HIDDEN THEN _ X$ = "." CALL LPRNT(X$,0) 1551 IF NOT SEND.REMOTE THEN _ RETURN IF HIDDEN THEN _ X$ = "." 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 GOTO 1625 1580 CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT) ' KG071905 AUTO.WARN! = AUTO.LOGOFF! - 30 ' KG071905 RETURN ' KG071905 1620 B$(1) = B$ Q = 1 1622 IF B$ = "" THEN _ Q = 0 : _ HIDDEN = FALSE : _ GOTO 1628 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 : _ GOTO 1628 _ ELSE IF X$ = "K" THEN _ KILL.MESSAGE = TRUE : _ GOTO 1628 ' KG090101 HIDDEN = FALSE 1628 FORCE.KEYBOARD = FALSE ' KG090101 IF MACRO.SAVE > 0 THEN _ ' KG090101 GSR.ARA$(MACRO.SAVE) = B$ : _ MACRO.SAVE = 0 : _ GOTO 1632 ' KG071905 IF (DISTANT.TGET > 0) OR (MACRO.TEMPLATE$ <> "") THEN _ CALL WIPELINE (38) : _ IF NOT NO THEN _ GOTO 1632 _ ' KG071905 ELSE Q = 0 : _ MACRO.TEMPLATE$ = "" : _ DISTANT.TGET = 0 : _ NO = FALSE : _ ' KG061001 GOTO 1633 ' KG071905 IF MACRO.ACTIVE OR ((NOT IN.STACK) AND INSTR(B$,".") > 0) THEN _ ' KG060189 EXIT SUB CALL NOPATH (B$(ANS.INDEX),FOUND) ' KG083101 IF FOUND THEN _ ' KG060801 EXIT SUB ' KG060801 CALL CHKMACRO (B$(ANS.INDEX),FOUND) ' KG083101 IF FOUND THEN _ STORE.PARSE.AT = ANS.INDEX : _ ' KG083101 GOTO 1525 EXIT SUB 1632 B$ = "" ' KG071905 FORCE.KEYBOARD = FALSE ' KG071905 1633 GOSUB 1580 ' KG071906 Q = 1 ' KG072601 GOTO 1525 ' KG071905 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 1636 ' $SUBTITLE: 'RINGCALLER - sub to use sound + screen emphasis' ' $PAGE ' ' NAME -- RINGCALLER ' ' INPUTS -- PARAMETER MEANING ' A$ STRING TO EMPHASIZE ' ' OUTPUTS -- none ' ' 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 1637 ' $SUBTITLE: 'PARSEIT - subroutine to parse a string' ' $PAGE ' ' NAME -- PARSEIT ' ' INPUTS -- PARAMETER MEANING ' B$ STRING TO PARSE ' ' OUTPUTS -- Q NUMBER PARSED ' B$() PARSED STRINGS ' ' PURPOSE -- To parse a string into pieces. Uses semicolon ' if exists, otherwise space, otherwise comma ' KG083103 ' SUB PARSEIT STATIC A = INSTR(B$,";") IF A > 0 THEN _ PARSE.CHAR$ = ";" _ ELSE IF B$ <> SPACE$(LEN(B$)) THEN _ CALL TRIM (B$) : _ X$ = B$ : _ ' KG060302 A = INSTR(B$," ") : _ WHILE A > 0 : _ B$ = LEFT$(B$,A - 1) + _ MID$(B$,A + 1) : _ A = INSTR(A,B$," ") : _ WEND : _ A = INSTR(B$," ") : _ IF A > 1 THEN _ PARSE.CHAR$ = " " _ ELSE A = INSTR(B$,",") : _ PARSE.CHAR$ = "," IF A < 2 THEN _ B$(STORE.PARSE.AT) = B$ : _ ' KG083101 DF$ = B$ : _ ' KG071903 CALL ALLCAPS (DF$) : _ ' KG071903 NON.STOP = NON.STOP OR (DF$ = "C") : _ ' KG071903 EXIT SUB B$(STORE.PARSE.AT) = LEFT$(B$,A - 1) ' KG083101 A = A + 1 EOL = FALSE 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 : _ STORE.PARSE.AT = STORE.PARSE.AT + 1 : _ ' KG083101 B$(STORE.PARSE.AT) = DF$ : _ ' KG083101 CALL ALLCAPS(DF$) : _ X = INSTR("NS;/G;C;",DF$+";") : _ ' KG072402 IF X > 0 THEN _ IF LEN(DF$) = 2 THEN _ Q = Q - 1 : _ STORE.PARSE.AT = STORE.PARSE.AT - 1 : _ ' KG083101 NON.STOP = NON.STOP OR (X = 1) : _ AUTO.LOGOFF = AUTO.LOGOFF OR (X = 4) _ ELSE IF LEN(DF$) = 1 THEN _ ' KG071903 NON.STOP = NON.STOP OR (X = 7) ' KG071903 IF NOT EOL AND Q < 50 THEN _ A = B + 1 : _ GOTO 1640 IF PARSE.CHAR$ <> ";" THEN _ ' KG060302 B$ = X$ ' KG060302 END SUB 1650 ' $SUBTITLE: 'POPCSTACK - prompt for value with command stack check ' KG081201 SUB POPCSTACK STATIC CALL CHKCARRIER ' KG082603 IF SUBROUTINE.PARAMETER = -1 THEN _ ' KG081201 LAST.INDEX = 0 : _ ' KG081201 Q = 0 : _ ' KG081201 EXIT SUB ' KG081201 Q = 1 ' KG081201 IF ANS.INDEX < LAST.INDEX THEN _ ' KG081201 ANS.INDEX = ANS.INDEX + 1 : _ ' KG081201 B$ = B$(ANS.INDEX) : _ ' KG081201 SUBROUTINE.PARAMETER = 3 : _ ' KG081201 CALL TGET : _ ' KG081201 EXIT SUB ' KG081201 LAST.INDEX = 0 ' KG081201 ANS.INDEX = 1 ' KG081201 SUBROUTINE.PARAMETER = 1 ' KG081201 SEARCHING.ALL = FALSE ' KG081201 CALL TGET ' KG081201 LAST.INDEX = Q ' KG081201 END SUB ' KG081201 1654 ' $SUBTITLE: 'SETBAUD - sub to set the baud rate in the RS232' ' $PAGE ' ' NAME -- SETBAUD ' ' INPUTS -- 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 ' 38400 " 3 ' KG090102 ' OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE ' ' PURPOSE -- To set the baud rate in the RS232 interface ' inpependent of the baud rate the communications port ' was opened at ' SUB SETBAUD STATIC 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 96001920038400", _ ' Pe 09/05/89 (-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$) ' KG090102 IF COMSPEED! > 19200 THEN _ ' KG090102 I = 19200 _ ' KG090102 ELSE I = COMSPEED! ' KG090102 IF FOSSIL THEN _ CALL FOSSPEED(COMPORT%,I,PARITY%,DATABITS%,STOPBITS%) : _ ' KG090102 EXIT SUB IF COMSPEED! = 2400 THEN _ ' KG090102 BAUD.RATE.DIVISOR = &H30 + (1 * (COMPUTER.TYPE = 2)) _ ' KG090102 ELSE IF COMSPEED! = 1200 THEN _ ' KG090102 BAUD.RATE.DIVISOR = &H60 + (3 * (COMPUTER.TYPE = 2)) _ ' KG090102 ELSE IF COMSPEED! = 9600 THEN _ ' KG090102 BAUD.RATE.DIVISOR = &HC _ ' KG090102 ELSE IF COMSPEED! = 300 THEN _ ' KG090102 BAUD.RATE.DIVISOR = &H180 + (11 * (COMPUTER.TYPE = 2)) _ ' KG090102 ELSE IF COMSPEED! = 450 THEN _ ' KG090102 BAUD.RATE.DIVISOR = &H100 + (8 * (COMPUTER.TYPE = 2)) _ ' KG090102 ELSE IF COMSPEED! = 4800 THEN _ ' KG090102 BAUD.RATE.DIVISOR = &H18 _ ' KG090102 ELSE IF COMSPEED! = 19200 THEN _ ' KG090102 BAUD.RATE.DIVISOR = &H6 _ ' KG090102 ELSE IF COMSPEED! = 38400 THEN _ ' KG090102 BAUD.RATE.DIVISOR = &H3 ' KG090102 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 2018 ' $SUBTITLE: 'MSGTO - subroutine to get who a message is to' ' $PAGE ' ' NAME -- MSGTO ' ' INPUTS -- PARAMETER MEANING ' HIGHEST.USER.RECORD ' ' OUTPUTS -- MESSAGE.TO$ Who message is to ' RECEIVER.REC.NUM User record # of who to ' ' 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) PARSE.OFF = TRUE ' KG082602 CALL POPCSTACK ' KG081201 IF SUBROUTINE.PARAMETER < 0 THEN _ ' KG081201 EXIT SUB ' KGO81201 IF LEN(B$) > 30 THEN _ CALL QTPUT1 (CX$(6) +"30 Char. Max" +CX$(7)) : _ 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) THEN _ ' KP061602 TEMP.HASH.VALUE$ = MESSAGE.TO$ : _ CALL WHOCHECK (TEMP.HASH.VALUE$,FOUND,RECEIVER.REC.NUM) : _ IF NOT FOUND THEN _ LAST.INDEX = 0 : _ ' KGO81201 RECEIVER.REC.NUM = 0 : _ 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 2055 ' $SUBTITLE: 'MSGPROT - gets protection wanted for a message' ' $PAGE ' ' NAME -- MSGPROT ' ' INPUTS -- PARAMETER MEANING ' MESSAGE.TO$ ' FOUND ' ' OUTPUTS -- PASSWORD$ Protection desired ' ' PURPOSE -- Sets protection desired for a new message ' SUB MSGPROT (MESSAGE.TO$,FOUND,MESSAGE.PASSWORD$) STATIC IF MESSAGE.TO$ = "ALL" THEN _ GOTO 2090 2060 A$ = "Make message [P]ublic, p(R)ivate, (H)elp" TURBO.KEY = -TURBO.KEY.USER ' KG081201 GOSUB 2096 ' KG081201 IF Q = 0 THEN _ B$(ANS.INDEX) = "P" Z$ = LEFT$(B$(ANS.INDEX),1) ' KG081201 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 QTPUT1 ("Msg to ALL cannot be private") : _ GOTO 2060 IF Z$ = "U" THEN _ GOTO 2088 2081 CALL QTPUT1 ("Sending personal mail to " + MESSAGE.TO$) 2084 MESSAGE.PASSWORD$ = "^READ^" EXIT SUB 2085 A$ = "Password" GOSUB 2096 ' KG081201 IF Q = 0 THEN _ GOTO 2085 IF LEN(B$) > L THEN _ CALL QTPUT1 (STR$(L) + " Chars. max") : _ GOTO 2085 IF L = 15 AND LEFT$(B$,1) = "!" THEN _ CALL QTPUT1 ("Password can't begin with '!'") : _ 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 2095 IF SUBROUTINE.PARAMETER = -1 THEN _ ' KG081201 EXIT SUB RETURN 2096 CALL POPCSTACK ' KG081201 GOTO 2095 ' KG081201 END SUB 2250 ' $SUBTITLE: 'WHOCHECK - Checks whether user exists' ' $PAGE ' ' NAME -- WHOCHECK ' ' INPUTS -- PARAMETER MEANING ' WHO.FIND$ User to find ' ' OUTPUTS -- WHO.FOUND Whether user found ' USER.NUM.FOUND Record # of user ' ' PURPOSE -- Validate that user record exists. Sysop ' counted as found even if lack user record. ' SUB WHOCHECK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC USER.NUM.FOUND = 0 IF START.HASH <> 1 THEN _ WHO.FOUND = TRUE : _ EXIT SUB WORK.128$ = USER.RECORD$ ' KG080401 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$ IF LEN(X$) > 1 THEN _ ' KG073001 CALL FINDUSER (X$,"",START.HASH,LEN.HASH,_ ' KG073001 0,0,HIGHEST.USER.RECORD,WHO.FOUND,_ USER.NUM.FOUND,SL) LSET USER.RECORD$ = WORK.128$ ' KG080401 ' IF NOT WHO.FOUND THEN _ ' IF TO.SYSOP THEN _ ' WHO.FOUND = TRUE _ ' ELSE CALL QTPUT1 (WHO.FIND$ + " not active user") '****** 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 ' IF DGS.ALIAS$ = "" THEN _ 'Pe 06/19/89 EXIT SUB 'Pe 06/19/89 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 2618 ' $SUBTITLE: 'EDITALINE - Edits a line in a message' ' $PAGE ' ' NAME -- EDITALINE ' ' INPUTS -- PARAMETER MEANING ' L Line # to edit ' ' OUTPUTS -- A$(L) Edited line ' ' 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 QTPUT1 ("Search & replace") A$ = "Search for" + _ PRESS.ENTER.EXPERT$ MACRO.MIN = 99 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 QTPUT1 ("<" + X$ + "> not found in line" + STR$(L)) : _ 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) IF LEN(A$(L)) > RIGHT.MARGIN THEN _ CALL WORDWRAP (RIGHT.MARGIN, LINES.IN.MESSAGE, A$()) GOTO 2620 2694 CALL TGET 2695 IF SUBROUTINE.PARAMETER > -1 THEN _ RETURN END SUB 3700 ' $SUBTITLE: 'LINEEDIT - subroutine to produce edited line' ' $PAGE ' ' NAME -- LINEEDIT ' ' INPUTS -- 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 ' ' OUTPUTS -- A$(MESSAGE.LINE) EDITED LINE ' ' PURPOSE -- Subroutine to edit a line quickly using a minimum of ' string space. ' SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC LSET LINEMES$ = A$(MESSAGE.LINE) COL = LEN(A$(MESSAGE.LINE)) STOP.INTERRUPTS = TRUE XXX = MAX.LEN - 3 WAIT.EXPIRED = FALSE GOTO 3782 3720 COL = COL + 1 CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT) 3730 CALL FINDFUNC 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$ 3782 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) AND (COL > 0) 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 3952 ' $SUBTITLE: 'KILLMSG - subroutine to delete messages' ' $PAGE ' ' NAME -- KILLMSG ' ' INPUTS -- PARAMETER MEANING ' MESSAGE.TO.KILL MESSAGE NUMBER TO KILL ' ACTIVE.MESSAGES NUMBER ACTIVE MESSAGES ' ' OUTPUTS -- NONE ' ' 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 USER.SECURITY.LEVEL >= SEC.KILL.ANY 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$) > 0 _ OR USER.SECURITY.LEVEL >= SEC.KILL.ANY) THEN _ GOTO 4030 _ ELSE MESSAGE.PASSWORD = TRUE : _ ATTEMPTS.ALLOWED = 0 : _ A$ = "Only sender & receiver can kill" : _ 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 MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$ PUT 1,LOC(1) SUBROUTINE.PARAMETER = 4 CALL FILELOCK A$ = "Killed Msg # " + _ STR$(MESSAGE.TO.KILL) CALL THREAD2 (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) 'PE 01/12/89 CALL UPDTCALR (A$,1) 4031 SUBROUTINE.PARAMETER = 5 CALL TPUT END SUB 4554 ' $SUBTITLE: 'SETTHREAD - Sets up the interface for threading' ' $PAGE ' ' NAME -- SETTHREAD ' ' INPUTS -- PARAMETER MEANING ' CURR.MSG.NUM Current message number ' CURR.SUBJ$ Current message subject ' ' OUTPUTS -- B$() Search msg by string ' Q 0 if thread cancelled ' ' 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)" 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) LAST.INDEX = 3 ' KG082504 ANS.INDEX = 1 ' KG082504 Q = 3 END SUB 4773 ' $SUBTITLE: 'SYSOPCHAT - chat with sysop' ' $PAGE ' ' NAME -- SYSOPCHAT ' ' INPUTS -- PARAMETER MEANING ' OUTPUTS -- CM True if chat active ' ' PURPOSE -- Lets sysop chat interactively with caller ' SUB SYSOPCHAT STATIC CM = TRUE CALL FINDTIME (TIME.CHAT.STARTED!) SUBROUTINE.PARAMETER = 1 CALL LINE25 A$(2) = "" 4775 CALL LINEEDIT (1,72) IF KEY.PRESSED$ = ESCAPE$ OR _ SUBROUTINE.PARAMETER < 0 THEN _ GOTO 4777 A$(1) = "" IF A$(2) <> "" THEN _ A$ = A$(2) : _ A$(1) = A$(2) : _ A$(2) = "" _ ELSE A$ = "" SUBROUTINE.PARAMETER = 4 CALL TPUT IF SUBROUTINE.PARAMETER > -1 THEN _ GOTO 4775 4777 CM = 0 CALL FINDTIME (TI!) ELAPSED! = FIX(TI! - TIME.CHAT.STARTED!) IF ELAPSED! < 0 THEN _ ELAPSED! = TI! + (86400! - TIME.CHAT.STARTED!) SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + ELAPSED! IF NOT LOCAL.USER THEN _ AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT CALL QTPUT(" Chat ended. Returning to normal operation",2) END SUB 5100 ' $SUBTITLE: 'REMNONALF - removes non-alpha chars from a string' ' $PAGE ' ' NAME -- REMNONALF ' ' INPUTS -- 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 ' ' OUTPUTS -- STRNG$ String returned ' PURPOSE -- CALCULATE THE ELASPED TIME A USER HAS BEEN ON ' 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 5200 ' $SUBTITLE: 'PAGELEN - Sets lines per page' ' $PAGE ' ' NAME -- PAGELEN ' ' INPUTS -- PARAMETER MEANING ' PAGE.LENGTH Current page length ' ' OUTPUTS -- PAGE.LENGTH New page length ' ' PURPOSE -- Change default lines per page ' SUB PAGELEN STATIC 5202 A$ = "CHANGE page length from" + _ STR$(PAGE.LENGTH) + _ " TO (0-255, 0=continuous)" CALL POPCSTACK ' KG081201 IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _ CALL QTPUT1 ("No change") : _ EXIT SUB 5230 CALL CHECKINT (B$(ANS.INDEX)) ' KG081201 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 QTPUT1 ("Page Length Set to" + STR$(PAGE.LENGTH)) ' KG081201 END SUB 5507 ' $SUBTITLE: 'BAUD450 -- Changes 300 baud to 450' ' $PAGE ' NAME -- BAUD450 ' ' INPUTS -- PARAMETER MEANING ' BPS ' ' OUTPUTS -- BPS ' ' PURPOSE -- Allow 300 baud modems to bump up to 450 baud ' SUB BAUD450 STATIC IF BPS <> -1 THEN _ CALL QTPUT1 ("Sorry, only 300 baud can change speed") : _ EXIT SUB IF FOSSIL THEN _ CALL QTPUT1 ("Sorry, 450 baud NOT supported under FOSSIL") : _ EXIT SUB A$ = "Change to 450 baud (Y,[N])" TURBO.KEY = -TURBO.KEY.USER SUBROUTINE.PARAMETER = 1 CALL TGET IF SUBROUTINE.PARAMETER = -1 OR NOT YES THEN _ EXIT SUB 5510 CALL QTPUT1 ("Change your baud rate to 450") CALL DELAYIT (9) C = 0 BPS = -2 CALL SETBAUD A$ = " and then press [ENTER] until I respond" SUBROUTINE.PARAMETER = 9 CALL TGET 5530 C = C + 1 CALL CARRIER IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB IF C = 20 THEN _ CALL UPDTCALR ("Baud change failed",1) : _ BPS = -1 : _ CALL SETBAUD : _ EXIT SUB CALL DELAYIT (1) 5535 CALL EOFCOMM (CHAR%) IF CHAR% = -1 THEN _ GOTO 5530 5536 CALL PUTCOM(A$) IF A$ = "" THEN _ A$ = " " IF ASC(A$) = 13 THEN _ GOTO 5540 IF SUBROUTINE.PARAMETER = -1 THEN _ EXIT SUB 5537 GOTO 5530 5540 A$ = "Changed to 450 baud" CALL QTPUT1 (A$) CALL UPDTCALR (A$,1) BPS = -2 A$ = "" END SUB 9140 ' $SUBTITLE: 'GETIME - subroutine to calculate elapsed time' ' $PAGE ' ' NAME -- GETIME ' ' INPUTS -- PARAMETER MEANING ' TIME.LOGGED.ON$ ' ' OUTPUTS -- HH NUMBER OF HOURS ON ' MM NUMBER OF MINUTES ON ' SS NUMBER OF SECONDS ON ' ' PURPOSE -- Calculate the elapsed time a user has been on ' SUB GETIME STATIC 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 9600 ' $SUBTITLE: 'DEFAULTU - subroutine to update user defauts' ' $PAGE ' ' NAME -- DEFAULTU ' ' INPUTS -- 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$ ' ' OUTPUTS-- USER.OPTONS$ ' ' 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 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$ END SUB 9801 ' $SUBTITLE: 'WHOSON - subroutine to display who is on' ' $PAGE ' ' NAME -- WHOSON ' ' INPUTS -- PARAMETER MEANING ' NUM.NODES # of nodes to check ' ACTIVE.MESSAGE.FILE$ Current message file ' ORIG.MESSAGE.FILE$ Main msg file ' ' OUTPUTS -- None ' ' PURPOSE -- To display who is on each node. ' 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 QTPUT1 (A$) CALL ASKMORE ("",TRUE,TRUE,ANS.INDEX,FALSE) ' KG081201 IF NO THEN _ ' BK080901 NODE.INDEX = NUM.NODES + 2 ' BK080901 NEXT ' BK080901 ACTIVE.MESSAGE.FILE$ = A1$ CALL QTPUT (EMPHASIZE.OFF$,0) ' MZ060303 END SUB 10410 ' $SUBTITLE: 'RECOVMSG - sub to recover deleted messages' ' $PAGE ' ' NAME -- RECOVMSG ' ' INPUTS -- PARAMETER MEANING ' MESSAGE.TO.RECOVER MESSAGE NUMBER TO RECOVER ' FIRST.MESSAGE.RECORD RECORD # FOR FIRST MSG ' ' OUTPUTS -- ACTION.FLAG SET TO 0 IF ERROR ' SET TO -1 IF NO ERROR ' ' 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 FIELD #1,128 AS MESSAGE.RECORD$ 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 QTPUT1 (A$) END SUB 10600 ' $SUBTITLE: 'UPDATEU -- Update the users record at logoff' ' $PAGE ' NAME -- UPDATEU ' ' INPUTS -- PARAMETER MEANING ' ADJUSTED.SECURITY ' CURRENT.DATE$ ' DOWNLOADS ' ELAPSED.TIME ' LIST.DIRECTORY ' MAIN.USER.FILE.INDEX ' SECONDS.PER.SESSION! ' UPLOADS ' USER.SECURITY.LEVEL ' ' OUTPUTS -- ELAPSED.TIME$ ' LIST.NEW.DATE$ ' SECURITY.LEVEL$ ' USER.DOWNLOADS$ ' USER.UPLOADS$ ' ' 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 _ UPLOADS = GLOBAL.UPLOADS : _ DOWNLOADS = GLOBAL.DOWNLOADS : _ DL.TODAY! = GLOBAL.DL.TODAY! : _ BYTES.TODAY! = GLOBAL.BYTES.TODAY! : _ DLBYTES! = GLOBAL.DLBYTES! : _ ULBYTES! = GLOBAL.ULBYTES! CALL TIMEREMAIN (TIME.REMAINING!) Q! = ELAPSED.TIME + _ ' KP061804 ((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 _ 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 _ 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 QTPUT1 (COLOR.RESET$) CALL DELAYIT (8 + BPS) END SUB 10935 ' $SUBTITLE: 'DOSEXIT -- Setup to exit to DOS for SYSOP' ' $PAGE ' NAME -- DOSEXIT ' ' INPUTS -- PARAMETER MEANING ' COM.PORT$ ' DOORS.TERMINAL.TYPE ' MULTI.LINK.PRESENT ' RBBS.BAT$ ' REDIRECT.IO.METHOD ' USE.DEVICE.DRIVER$ ' ' OUTPUTS -- Q NUMBER OF LINES TO WRITE OUT TO ' RCTTY.BAT$ ' B$() LINES TO WRITE OUT TO RCTTY.BAT$ ' ' PURPOSE -- Set up B$() and Q in order to call "RBBSEXIT" and ' exit to DOS for the remote RBBS-PC sysop ' SUB DOSEXIT STATIC 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$ = "GATE" + RIGHT$(COM.PORT$,1) 'pe Gateway Mod 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 CALL AMORPMTD ' KG061203 CALL UPDTCALR ("Exited to DOS at " + TIM$,2) CALL QTPUT1 ("RBBS-PC " + VERSION.ID$) CALL QTPUT1 ("SYSOP in Remote Console Mode") CALL RBBSEXIT (A$(),FF) END SUB 10976 ' $SUBTITLE: 'WORDINFILE -- Searches a file to find a word' ' $PAGE ' NAME -- WORDINFILE ' ' INPUTS -- PARAMETER MEANING ' FILNAME$ FILE TO SEARCH IN ' STRNG$ STRING TO SEARCH FOR ' ' OUTPUTS -- INFILE WHETHER STRING FOUND IN FILE ' ' 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 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 10983 ' $SUBTITLE: 'DOOREXIT -- Setup to exit to a "door"' ' $PAGE ' NAME -- DOOREXIT ' ' INPUTS -- PARAMETER MEANING ' MULTI.LINK.PRESENT ' NODE.ID$ ' RBBS.BAT$ ' Z$ ' ' OUTPUTS -- Q NUMBER OF LINES TO WRITE OUT TO ' RCTTY.BAT$ ' B$() LINES TO WRITE OUT TO RCTTY.BAT$ ' ' PURPOSE -- Set up B$() and Q in order to call "EXITRBBS" and ' exit RBBS-PC to invoke another program ' SUB DOOREXIT STATIC IF Z$ = "" OR _ Z$ = "NONE" THEN _ EXIT SUB CALL FINDIT (Z$) IF NOT OK THEN _ GOTO 10986 EXIT.TO$ = LEFT$(Z$,LEN(Z$) - 4) EXIT.METHOD$ = "" DOORED.TO$ = EXIT.TO$ CALL FINDIT (DOORS.DEF$) IF NOT OK THEN _ EXIT.TO$ = EXIT.TO$ + " " + NODE.ID$ : _ GOTO 10989 10985 CALL READPARMS (A$(),8,1) IF EC > 0 THEN _ EXIT.TO$ = EXIT.TO$ + " " + NODE.ID$ : _ GOTO 10989 IF EXIT.TO$ <> A$(1) THEN _ GOTO 10985 CALL CHECKINT (A$(2)) IF EC > 0 THEN _ EC = 0 : _ GOTO 10985 IF USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _ CALL QTPUT1 ("Insufficient security for door") : _ EXIT SUB X$ = LEFT$(A$(5),INSTR(A$(5)+" "," ")-1) CALL FINDIT (X$) IF NOT OK THEN _ GOTO 10986 FILE.NAME$ = A$(3) EXIT.METHOD$ = A$(4) EXIT.TEMPLATE$ = A$(5) DOOR.DISPLAY$ = A$(7) DOOR.TIME$ = A$(8) CALL ASKUSERS CALL SMARTTXT (EXIT.TEMPLATE$,FALSE,FALSE) ' CS062802 CALL METAGSR (EXIT.TEMPLATE$,FALSE) EXIT.TO$ = EXIT.TEMPLATE$ GOTO 10989 10986 A$ = "Missing door program" CALL UPDTCALR (A$ + " " + Z$,1) SNOOP = TRUE CALL LPRNT (A$,1) EXIT SUB 10989 IF TRANSFER.FUNCTION = 3 THEN _ Y$ = "Registration" _ ELSE Y$ = DOORED.TO$ A$ = Y$ + _ " door opened at " + _ TIME$ + _ " on " + _ DATE$ SUBROUTINE.PARAMETER = 5 CALL TPUT CALL UPDTCALR (DOORED.TO$ + " door opened!",2) CALL QTPUT (Cx$(5)+"Takes approx 30 - 40 seconds.....",2) CLOSE 2 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 _ PRINT #2,"COM0" _ ELSE PRINT #2,COM.PORT$ 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" : _ PRINT #2,"" _ ELSE PRINT #2,FIRST.NAME$ : _ PRINT #2,LAST.NAME$ PRINT #2,CITY.STATE$ PRINT #2,GR PRINT #2,USER.SECURITY.LEVEL CALL TIMEREMAIN (TIME.REMAINING!) CALL CHECKINT (DOOR.TIME$) IF EC = 0 AND TESTED.INTEGER.VALUE > 0 THEN _ ' KG080201 IF TIME.REMAINING! > TESTED.INTEGER.VALUE THEN _ ' KG080301 TIME.REMAINING! = TESTED.INTEGER.VALUE ' KG080301 PRINT #2,INT(TIME.REMAINING!) PRINT #2,FOSSIL IF EXIT.METHOD$ = "S" THEN _ CALL SHELLEXIT (EXIT.TEMPLATE$) : _ EXIT.TO.DOORS = TRUE : _ CALL BUFFILE (DOOR.DISPLAY$,X) : _ CALL DOORRTN _ ELSE A$(1) = DISK.FOR.DOS$ + _ "COMMAND /C " + _ EXIT.TO$ : _ A$(2) = RBBS.BAT$ : _ CALL RBBSEXIT (A$(),2) END SUB 10992 ' $SUBTITLE: 'RBBSEXIT -- Setup to exit RBBS' ' $PAGE ' NAME -- RBBSEXIT ' ' INPUTS -- PARAMETER MEANING ' LINE.ARA Array of lines to write to batch file ' NUM.LINES How many lines in array ' ' OUTPUTS -- RCTTY.BAT$ ' ' 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 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) 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 12000 ' $SUBTITLE: 'SETSECT -- Setup section prompts' ' $PAGE ' NAME -- SETSECT Doug Azzarito ' ' INPUTS -- 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 ' ' OUTPUTS -- 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 ' ' PURPOSE -- To build the prompt strings for the current section ' SUB SETSECT STATIC 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) LSET LAST.COMMAND$ = ACTIVE.MENU$ + " " ' KG060701 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 12878 ' $SUBTITLE: 'UNTILRIGHT - asks question until answer okay' ' $PAGE ' ' NAME -- UNTILRIGHT ' ' INPUTS -- 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 ' ' OUTPUTS -- ANS$ RESPONSE TO THE QUESTION WHICH THE ' CALLERS SAYS IS CORRECT ' ' 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 QTPUT1 (STR$(MAX.LEN) + " chars max") : _ GOTO 12880_ ELSE IF LEN(B$(1)) < MIN.LEN THEN _ CALL QTPUT1 (STR$(MIN.LEN) + " chars min") : _ 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 13660 ' $SUBTITLE: 'LOGERROR - sub to log errors to CALLERS file' ' $PAGE ' ' NAME -- LOGERROR ' ' INPUTS -- PARAMETER MEANING ' ERR ERROR NUMBER DETECTED BY BASIC ' ERL LAST LINE NUMBER ENCOUNTERED ' PRIOR TO ENCOUNTERNING ERROR ' ' OUTPUTS -- NONE ' ' PURPOSE -- To set up a string to write to the callers log ' indicating the date, time, error, and error line ' SUB LOGERROR STATIC IX = ERR IF ERR < 1 THEN _ IX = EC CALL UPDTCALR("+++ Error " + _ STR$(IX) + _ " line " + _ STR$(ERL) + _ " at " + _ TIME$ + _ " on " + _ DATE$,2) END SUB ' 20096 ' $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 '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 20140 ' $SUBTITLE: 'GETARC - sub to get what files to verbose list' ' $PAGE ' ' NAME -- GETARC ' ' INPUTS -- PARAMETER MEANING ' Q NUMBER OF ENTRIES TYPED ' B$() ENTRIES TYPED ' ' OUTPUTS -- ' ' PURPOSE -- Process the V)erbose list command. ' Takes what user types and tries to list it. ' SUB GETARC STATIC ' KG081201 20141 IF ANS.INDEX >= LAST.INDEX THEN _ ' KG081201 CALL QTPUT1 ("Default extension is "+DEFAULT.EXTENSION$) ' KG081201 A$ = "What compressed file(s)" + PRESS.ENTER.EXPERT$ ' KG081201 CALL POPCSTACK ' KG081201 IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _ EXIT SUB ' KG081201 20142 VIOLATION$ = "View ARC" ' KG081201 X = ANS.INDEX ' KG081201 FOR ANS.INDEX = X TO LAST.INDEX ' KG081201 GOSUB 20143 IF SUBROUTINE.PARAMETER < 0 THEN _ ANS.INDEX = LAST.INDEX + 1 ' KG081201 NEXT IF LAST.INDEX > 1 THEN _ EXIT SUB _ ELSE GOTO 20141 20143 Z$ = B$(ANS.INDEX) ' KG081201 CALL ALLCAPS (Z$) CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE) IF EXT$ = "" THEN _ EXT$ = DEFAULT.EXTENSION$ : _ Z$ = Z$ + "." + DEFAULT.EXTENSION$ IF EXT$ = "ARC" _ OR EXT$ = "LZH" _ OR EXT$ = "PAK" _ OR EXT$ = "ZOO" _ OR EXT$ = "ZIP" _ OR EXT$ = "DWC" THEN _ ARK = TRUE ELSE _ CALL QTPUT1 ("Only ARC,LZH,PAK,ZOO,ZIP or DWC files can be viewed") : _ 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$(ANS.INDEX) + _ ' KG081201 " 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$(ANS.INDEX) = B$(1) ' KG081201 GOTO 20143 20147 CALL SVIOLATION IF DENY.ACCESS THEN _ EXIT SUB GOTO 20146 20148 CALL QTPUT1 (FILE.NAME.HOLD$ + " has these files") CALL VIEWARC ' This is in RBBSSUB4.BAS CALL VIEWTXT 'Pete Eibl RBBSSUB1.BAS RETURN END SUB 20235 ' $SUBTITLE: 'BADNAME - subroutine to find bad file names' ' $PAGE ' ' NAME -- BADNAME ' ' INPUTS -- 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 ' ' OUTPUTS -- BAD.FILE.NAME.INDEX 1 = FILE NAME IS OK ' 2 = SECURITY BREACH TRIED ' VIOLATIONS.THIS.SESSION NUMBER OF VIOLATIONS ' FILENAME$ NAME OF FILE ' ' 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 ' BAD.FILE.NAME.INDEX = 2 Z$ = FILE.NAME$ CALL BRKFNAME (FILE.NAME$,DR$,PREFIX$,EXTENSION$,FALSE) IF LEN(EXTENSION$) = 3 THEN _ IF INSTR("DEF,MNU,OLD,PUI,BAK,",EXTENSION$+",") > 0 THEN _ EXIT SUB OK = 0 CALL FSECCHK (ACTIVE.MESSAGE.FILE$,PREFIX$,EXTENSION$) CALL FSECCHK (ACTIVE.USER.FILE$,PREFIX$,EXTENSION$) CALL FSECCHK (CALLERS.FILE$,PREFIX$,EXTENSION$) CALL FSECCHK (COMMENTS.FILE$,PREFIX$,EXTENSION$) CALL FSECCHK (FILESEC.FILE$,PREFIX$,EXTENSION$) CALL FSECCHK (MAIN.MESSAGE.BACKUP$,PREFIX$,EXTENSION$) CALL FSECCHK (ORIG.MESSAGE.FILE$,PREFIX$,EXTENSION$) CALL FSECCHK (ORIG.USER.FILE$,PREFIX$,EXTENSION$) CALL FSECCHK (PASSWORDS.FILE$,PREFIX$,EXTENSION$) CALL FSECCHK (RBBS.BAT$,PREFIX$,EXTENSION$) CALL FSECCHK (RCTTY.BAT$,PREFIX$,EXTENSION$) CALL FSECCHK (CONFIG.FILENAME$,PREFIX$,EXTENSION$) IF OK > 0 THEN _ EXIT SUB BAD.FILE.NAME.INDEX = 1 END SUB 20240 ' $SUBTITLE: 'FSECCHK - checks file match except for drive' ' $PAGE ' ' NAME -- FSECCHK ' ' INPUTS -- PARAMETER MEANING ' CHECK.THIS$ Name of file to check ' PREF2$ Prefix to match against ' EXT2$ Extension to match against ' ' OUTPUTS -- OK 1 if got match ' ' PURPOSE -- Checks for match on both prefix and extension of a file ' name. Used to catch match on system files not to be ' downloaded. ' SUB FSECCHK (CHECK.THIS$,PREF2$,EXT2$) STATIC IF OK > 0 THEN _ EXIT SUB CALL BRKFNAME (CHECK.THIS$,DR$,PREF1$,EXT1$,FALSE) IF PREF1$ = PREF2$ THEN _ IF EXT1$ = EXT2$ THEN _ OK = 1 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 IN.STACK = 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",2) :_ 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