10 ' ---> RBBS Version 3.7 15 ' 20 ' RBBS37 "Remote Bulletin Board System" 25 ' 30 ' Written by Dennis Recla November 21, 1984 32 ' Lost Island RBBS-RCP/M (214) 681-4789 34 ' GARLAND, TEXAS 35 ' 40 ' Revised from Vers. 3.5 & Vers. 3.1 41 ' (A version 3.6 was released by an unknown person, it 42 ' was a 'hacked up' copy of 3.5 but supplied as a .OBJ 43 ' file with an uncommented .ASC file incorrectly named 44 ' RBBS36.BAS as it was an ASCII file. 45 ' 46 ' NOTE: This is an expanded version and it will require 50 ' a disk based linker to link the REL file created 55 ' by BASCOM. Use LD80 or PLINK. 56 ' 58 ' AND:--> This version is so large that in most cases it 59 ' will not even run under MBASIC unless you have 60 ' a very large TPA in excess of 56K 65 ' (Or remove all the comments) 70 ' 75 ' The following area is provided for updates and changes to 80 ' be documented from the original version. 85 ' 90 ' ---------------------------------------------------------------------- 95 ' Updates: 99 ' 100 ' 11/21/84 101 ' This is a special version of RBBS that has been modified so 102 ' all necessary files are available as external password files. 103 ' This allows the program to be distributed as a compiled and 104 ' linked .COM file. Modifications can be made to the source 105 ' file in BASIC, but it is necessary to have the LD80 or some 106 ' disk based linker to link the large file. 116 ' 117 ' This will be MY last update to the RBBS program written in 118 ' MBASIC, unless there are bugs found in this version which 119 ' need to be corrected. All the special features I feel are 120 ' necessary have been included. I would suggest that any future 121 ' revisions go along the route of breaking this program into 122 ' an ENTRY program, the RBBS program, and an EXIT program. 123 ' It is just too DAMN big. 124 ' 125 '----------------------------------------------------------------------- 140 ' 145 ' This is the un-official start of the program 146 ' ( And here we go.... Lets set up all the variables) 147 ' 150 DEFINT A-Z 160 DIM A$(25),M(200,2) 170 ' 180 ' Local Mods section and Default Values (See Exit at line 4410) 190 ' 200 VERS1$=" Lost Island RBBS vers. 3.7" 205 ' 210 VERS2$=" From Lillypond Software 1984 " 212 ' 220 SYS1$="DENNIS" 'Name of SYSOP, so that when you log in RBBS 222 ' 225 SYS2$="RECLA" 'will check for mail to SYSOP and SYS1$,SYS2$ 226 ' 230 SYS3$="SYSOP" 'This is the FIRST NAME for SYSOP entry to system. 232 ' 235 P2$="LETMEIN?" 'This is the LAST NAME for SYSOP entry to system. 236 ' 240 P1$="GO2CPM" 'This is the FIRST NAME for direct entry to CP/M 241 ' 245 P3$="DDT" 'DEFAULT User CP/M entry password 246 ' 250 VAP$="PASSWORD" 'Password for use of Validation Software by SYSOP 251 ' 255 PC$="What is the Digital Research CP/M 2.2 De-bugger? " 256 ' 260 DSK$="A:" 'Drive to first look for non DSK2$ or DSK3$ files. 261 ' 265 DSK2$="A:" 'If no PWDS File default to Drive A: 266 ' 267 DSK3$="A:" 'Additional Drive area for files 268 ' 270 ANS1$=" >> You must be a validated user for access << " 271 ' 272 NSP$=" Please do not use spaces in your name " 273 ' 275 TWIT$=" " 'If no PWDS File default to no TWITS 276 ' 277 DATIM$="N" ' No external date time function 278 ' 280 BEEP=20000 'If no PWDS File default to 20,000 counts 281 ' 285 SIZE=24 'If no PWDS File default to 24 line messages 286 ' 290 ERS$=CHR$(8)+" "+CHR$(8) 295 BSL$=CHR$(8)+"/"+CHR$(8) 296 ' 300 MSYS=1 'Enter number of SYSOPS on system 302 ' 305 SCAN$="N" 'Allow Scan of private messages 308 ' 310 NNUM=0 'Default number of NEWS files. 311 ' 315 HNUM=0 'Default number of HELP files. 316 ' 317 SKIP=1 'Skip over "your last message" message 318 ' 319 LMSG=-1 'Not allow new user to leave messages 320 ' 321 GOCPM=1 'Allow new users to go to CP/M 322 ' 323 ' This is the Official start of the program 324 ' 325 ' 330 POKE 0,&HCD ' Change the JUMP (C3) at 0 to a CALL (CD) 335 ' This prevents the system from rebooting 336 ' 340 INC=1 350 ON ERROR GOTO 5300 360 RFLG=PEEK(&H5D):POKE &H5D,&H20 370 RTNOKFLG=PEEK(&H5B):POKE &H5B,120 'Legal return flag. 380 ' 390 ' SIGNON FUNCTIONS 400 ' 410 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1:NW=0 415 BK=0:GOSUB 5040 416 ' 417 ' Original File Loaded with Passwords 418 ' 420 OPEN "I",1,DSK$+"BOOTPWD":IF EOF(1) THEN 430 421 ' 424 ' 425 INPUT #1,DSK2$,DSK3$,SYS1$,SYS2$,VERS1$,TWIT$,DATIM$ 426 ' 430 CLOSE #1 432 ' 434 A$=VERS1$:N=1:GOSUB 5040 'Print Name of system 435 ' 436 GOSUB 5040:GOSUB 5040 'Put a space between VERS1 & VERS2 437 ' 438 ' Second Passwords File loaded 439 ' 440 OPEN "I",1,DSK2$+"pwds":IF EOF(1) THEN 450 441 ' 445 INPUT #1,P1$,P2$,P3$,PC$,VAP$,SCAN$ 446 INPUT #1,BEEP,SIZE,MSYS,NNUM,HNUM,SKIP,LMSG,GOCPM 450 CLOSE #1 451 ' 475 ' 480 BEL=-1:XPR=0 'INITIAL BELL ON, NOT EXPERT 485 NEWUSER=1 'This is not a new user calling 490 A$=VERS2$:N=1:GOSUB 5040 'Print the Version number etc. 492 ' 495 GOSUB 5040:GOSUB 5040:SAV$="" 500 IF RFLG<>ASC("P") THEN 600 510 IF RTNOKFLG<>ASC("x") THEN 600 520 V=0:INC=0 ' SO CALLER NUMBER SAYS SAME 530 OPEN "I",1,DSK3$+"LASTCALR":INPUT #1,N$,O$,D$:CLOSE 540 A$="Welcome back, " 550 IF N$<>SYS3$ THEN 570 560 CN$=N$:O$="":CO$=O$:A$=A$+N$+".":GOSUB 5040:GOSUB 5040:V=1:GOTO 960 570 GOSUB 7360:V=1 580 A$=A$+CN$+" "+CO$+".":GOSUB 5040:GOSUB 5040 590 T01$=N$:T02$=O$:GOSUB 6710:MF$=MFJ$:GOTO 960 600 GOSUB 1830:IF NOT BK THEN NW=1:GOSUB 1790'REM PRINT INFO, THEN BULLETINS 610 GOSUB 5040:BK=0 620 GOSUB 5040 630 A1$="Enter your FIRST Name: ":N=1:GOSUB 5040 640 C=1:GOSUB 5170:N$=B$:IF N$="" THEN 630 650 IF N$=P1$ THEN POKE &H5B,0:GOTO 1750 ' DIRECT CPM EXIT 660 IF N$<"A" OR LEN(N$)=1 THEN 630 661 ' 662 ' Check for spaces in the Callers First name 663 ' 665 CK=INSTR(N$," "):IF CK>0 THEN A1$=NSP$:N=1:GOSUB 5040:GOSUB 5040:GOTO 630 667 ' 670 A1$="Enter your LAST Name: ":N=1:GOSUB 5040 680 C=1:IF N$=SYS3$ THEN C=2 690 GOSUB 5170:O$=B$:IF O$="" THEN 630 700 IF O$<"A" OR LEN(O$)=1 THEN 630 705 ' 710 IF N$=SYS3$ AND O$=P2$ THEN GOSUB 8000:GOTO 910 ' This must be a SYSOP 715 ' 720 IF N$=SYS3$ THEN 630 721 ' 722 ' Check for spaces in last name of caller. 723 ' 725 CK=INSTR(O$," "):IF CK>0 THEN A1$=NSP$:N=1:GOSUB 5040:GOSUB 5040:GOTO 670 728 ' 730 A$="Checking User File...":GOSUB 5040 740 V=0:T01$=N$:T02$=O$:OK=0:GOSUB 6710:IF OK THEN MF$=MFJ$:GOTO 750 ELSE 790 750 T=0 760 T=T+1:IF T=4 THEN 4390 ELSE A1$="Enter your PASSWORD: " 770 N=1:GOSUB 5040:C=2:GOSUB 5170:UPW$=B$:IF UPW$="" THEN 760 780 IF UPW$=S04$ THEN 910 ELSE 760 790 A1$="You must be a New User ? ":GOSUB 6940 800 IF NOT OK THEN A$="REALLY, let's try again.":GOSUB 5040:GOTO 630 810 V=1:GOSUB 6520 'GET USER TO SET HIS OWN PASSWORD 820 A1$="Enter YOUR City, State: ":N=1:GOSUB 5040 830 C=1:GOSUB 5170:S03$=B$:IF S03$="" THEN 820 840 GOSUB 7360 850 A$="Hello "+CN$+" "+CO$+" from "+S03$:GOSUB 5040 860 A1$="Is anything misspelled? ":GOSUB 6940:IF OK THEN 630 870 HM=0:S05$=STR$(HM):S$=" "+N$+";"+O$+";"+S03$+";"+S04$+";"+S05$ 880 OPEN "R",1,DSK3$+"USERS",62:FIELD#1,62 AS RR$ 890 RL=62:GOSUB 5450:NU=NU+1:PUT#1,NU+1:S$=STR$(NU):GOSUB 5450:PUT#1,1:CLOSE 895 ' 900 FIL$="NEWCOM":GOSUB 5680:MF$=" ":NEWUSER=-1 'Flag messages for newuser 905 ' 910 A$="Writing to User file...":GOSUB 5040:RE=1 912 ' 915 IF N$=SYS3$ THEN GOTO 950 'Don't put the SYSOP in Callers file 917 ' 920 OPEN "R",1,DSK3$+"CALLERS",60:FIELD#1,60 AS RR$:GET#1,1:RE=VAL(RR$)+1 930 S$=STR$(RE):RL=60:GOSUB 5450:PUT#1,1:RE=RE+1 940 S$=N$+" "+O$+" "+S03$:GOSUB 5450:PUT#1,RE:CLOSE#1 942 ' 944 IF DATIM$="Y" THEN GOSUB 9070 ' GET DATE TIME FROM FILE 946 ' 950 OPEN "O",1,DSK3$+"LASTCALR":PRINT #1,N$;",";O$;",";D$:CLOSE 955 ' 956 ' Put callers name in the LASTCALR file 957 ' 960 PRINT 961 ' 962 ' CHECK THIS CALLERS STATUS 963 ' 964 IF MF$="#" THEN GOSUB 5600 'SUPER user gets Xpert status 965 IF MF$<>"*" GOTO 970 'If it is * then you have a TWIT 966 IF TWIT$="*" THEN GOTO 7800 'If TWIT$=* then Log the dummy off 967 ' 'But first tell him to go away 968 ' 970 IF V=0 THEN IF N$<>SYS3$ THEN GOSUB 7360 990 BK=0:GOSUB 5040:CN=1:M=0:U=0 1000 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD#1,5 AS RR$ 1010 GET#1,CALLS:IF N$=SYS3$ THEN CN=VAL(RR$) ELSE CN=VAL(RR$)+INC 1020 GET#1,MSGS:M=VAL(RR$) 1030 GET#1,MNUM:U=VAL(RR$) 1040 A$="You are caller number: ":N=1:GOSUB 5040 1050 A$=STR$(CN):LSET RR$=A$ 1060 A$=SPACE$(4-LEN(STR$(CN)))+STR$(CN):GOSUB 5040:PUT#1,CALLS:GOSUB 5040 1070 A$="Number of Active Messages: ":N=1:GOSUB 5040 1080 A$=SPACE$(4-LEN(STR$(M)))+STR$(M):GOSUB 5040 1090 A$="Last System Message Number: ":N=1:GOSUB 5040 1100 A$=SPACE$(4-LEN(STR$(U)))+STR$(U):GOSUB 5040:CLOSE 1102 ' 1104 ' 1105 IF N$=SYS3$ THEN GOTO 1140 'No need to tell SYSOP this 1106 IF SKIP=1 THEN GOTO 1140 'Skip over all of this too. 1110 IF HM=0 THEN 1140 'If callers last message was zero 1112 ' then skip the next message. 1115 ' 1120 A$="Your last message number : ":N=1:GOSUB 5040 1121 ' 1125 A$=SPACE$(4-LEN(STR$(HM)))+STR$(HM):GOSUB 5040 1126 ' 1128 ' 1130 GOSUB 5040 1132 ' 1135 IF MF$="#" THEN A$="System SUPER User...":N=1:GOSUB 5040 1137 ' 1140 GOSUB 5040:A$=" ":GOSUB 5040:IHM=HM 1150 ' 1160 ' LOOK FOR MSGS FOR THIS CALLER 1170 ' AND BUILD MESSAGE INDEX 1180 ' 1190 FT=-1:MX=0:MZ=0:IU=0:CNT=0:G=0 1200 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD#1,28 AS RR$ 1210 BK=0:GET#1,RE:IF EOF(1) THEN 1350 1220 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 1340 ' G=0 =DELETED 1230 IF IU=0 THEN IU=G 1240 IF G>9998 THEN MZ=MZ-1:GOTO 1350 1250 GET#1,RE+3:GOSUB 5500 1260 I=INSTR(S$," "):IF I=0 THEN S1$=S$:S2$="":GOTO 1280 1270 S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1) 1280 IF S1$=N$ AND S2$=O$ THEN 1310 1290 IF N$<>SYS3$ THEN 1340 1300 IF S1$=SYS1$ AND S2$=SYS2$ THEN 1310 ELSE 1340 1310 IF NOT FT THEN 1330 1320 GOSUB 5040:A$=CN$+", you have mail:":GOSUB 5040:GOSUB 5040:FT=0 1330 RX=RE:GOSUB 3900:RE=RX:CNT=CNT+1 1340 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 1210 1350 IF CNT=0 THEN 1390 ELSE GOSUB 5040:A$="Please Retrieve and Kill " 1360 IF CNT=1 THEN A$=A$+"this message." 1370 IF CNT>1 THEN A$=A$+"these messages." 1380 GOSUB 5040:GOSUB 5040 1390 CLOSE 1392 ' 1395 IF NEWUSER=-1 THEN GOSUB 1900 'Print the MENU for newusers 1400 ' 1410 ' *** MAIN COMMAND ACCEPTOR/DISPATCHER *** 1420 ' 1430 A1$=CN$+"? Your Command: " 1440 IF NOT XPR THEN A1$=A1$+"B,E,F,R,S,K,L,G,H,W,J,U,T,X,P,C,N ( or ? ): " 1450 N=1:GOSUB 5040:C=1:GOSUB 5170 1460 IF B$="" THEN 1430 1470 FF=INSTR("BER?SKGWJUTXP",B$):GOSUB 1480:GOTO 1430 1480 IF FF=0 THEN 1500 1490 ON FF GOTO 1790,1910,3130,1870,3640,4460,4120,1830,1570,4820,5640,5600,6610 1495 ' 1496 ' SPECIAL ADDED FUNCTIONS 1497 ' 1500 IF B$="C" THEN GOTO 7380 'Chat with the SYSOP 1502 ' 1504 IF B$="F" THEN GOSUB 4270:RETURN 'Leave FEEDBACK for SYSOP 1508 ' 1510 IF B$="N" THEN GOSUB 7670:RETURN 'View the NEWS files 1512 ' 1515 IF B$="UALL" THEN GOTO 4820 'Special way to see all users 1516 ' 1520 IF B$="L" THEN GOSUB 5770:RETURN 'Look at the Lastcallers 1524 ' 1525 IF B$="H" THEN GOTO 7900 'Print the HELPFILE file 1526 ' 1527 ' Special SYSOP Functions 1528 ' 1529 ' Print Comments File 1530 IF B$="Z" AND N$=SYS3$ THEN GOSUB 6100:RETURN 1531 ' 1532 ' Print XMODEM.LOG file 1533 ' 1535 IF B$="XL" AND N$=SYS3$ THEN GOSUB 7830:RETURN 1537 ' 1540 GOSUB 5040 1550 A$="I don't understand '"+B$+"', "+CN$+".":GOSUB 5040:GOSUB 5040 1560 SAV$="":RETURN 1570 REM 1580 REM ***EXIT TO CP/M*** 1590 REM 1600 GOSUB 5040:T=0 1610 IF N$=SYS3$ THEN 1760 'This is the SYSOP let him thru 1612 IF MF$="#" THEN 1680 'Let a SUPER user get to CP/M 1614 ' 1615 IF GOCPM=-1 THEN 1630 'No one can go to CP/M except SYSOP & Super 1616 ' 1617 ' Let all users enter CP/M with a Password 1618 ' 1620 IF MF$<>"*" AND GOCPM=0 THEN 1640 1621 ' 1625 IF MF$="!" THEN 1640 'Let validated users go to CP/M 1626 ' 1627 ' Tell caller he needs to be validated 1628 ' 1630 A$=ANS1$:GOSUB 5040:SAV$="":RETURN 1634 ' 1635 ' If NOPASS then a password is not needed 1636 ' 1640 IF P3$="NOPASS" THEN 1680 1645 ' 1650 T=T+1:IF T=2 THEN GOSUB 5040:GOSUB 5040:RETURN 1660 A1$=PC$:N=1:GOSUB 5040:C=2:GOSUB 5170 1670 IF B$="" OR B$<>P3$ THEN 1650 1680 IF XPR THEN 1740 1690 REM 1700 REM ***DISPLAY ENTERCPM*** 1710 REM 1720 GOSUB 5040:FIL$="ENTERCPM":NW=1:GOSUB 5680:GOSUB 5040 1730 REM 1740 IF IHM<>HM THEN MFJ$=MF$:GOSUB 6910 'Update the USER file 1750 GOSUB 4200 1760 POKE 4,0 'Set up for User area 0 1765 ' 1770 A$="Entering CP/M...":GOSUB 5040 1771 ' 1780 POKE 0,&HC3:SYSTEM ' Change the CALL (CD) at 0 back to a 1785 ' JUMP (C3) Restores system 1790 ' 1800 ' DISPLAY BULLETINS 1810 ' 1820 FIL$="BULLETIN":GOSUB 5680:RETURN 1830 REM 1840 REM ***DISPLAY WELCOME MESSAGE*** 1850 REM 1860 FIL$="INFO":GOSUB 5680:RETURN 1870 REM 1880 REM *** DISPLAY MENU OF FUNCTIONS *** 1890 REM 1900 FIL$="MENURBBS":GOSUB 5680:GOSUB 5040:RETURN 1910 REM 1920 REM **** ENTER A NEW MESSAGE ***** 1930 REM 1940 IF N$=SYS3$ THEN 1970 'This guy is the SYSOP 1941 ' 1942 IF LMSG=1 THEN 1970 'Allow any user to leave a msg. 1943 ' 1945 IF MF$="#" OR MF$="!" THEN 1970 'Let these callers leave a msg. 1946 ' 1950 GOSUB 5040:GOSUB 5040 1960 A$=ANS1$:GOSUB 5040:GOSUB 5040:SAV$="":RETURN 1970 F=0:GOSUB 5040:V=0 1980 OPEN "R",1,DSK2$+"COUNTERS",5 1990 FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$) 2000 A$="Msg # will be ":N=1:GOSUB 5040 2010 A$=STR$(V+1):GOSUB 5040:CLOSE 2020 GOSUB 5040 2025 ' 2030 GOSUB 9000 'Get the date and time information 2040 ' 2060 A1$="To (RETURN for ALL): ":N=1:GOSUB 5040 2070 C=1:GOSUB 5170:IF B$="" THEN T$="ALL" ELSE T$=B$ 2080 GOSUB 7180:IF NOT OK THEN 2060 2090 GOSUB 7290 2100 A1$="Subject: ":N=1:GOSUB 5040 2110 C=0:GOSUB 5170:IF B$="" THEN 2100 ELSE K$=B$: 2115 IF LEN(K$)>26 THEN PRINT "To long... 25 character limit":GOTO 2100 2120 A1$="Password ('*' for Private): ":N=1:GOSUB 5040 2130 C=1:GOSUB 5170:PW$=B$ 2140 IF T$<>"ALL" OR LEFT$(PW$,1)<>"*" THEN 2160 2150 A$="Cannot use '*' with ALL.":GOSUB 5040:GOTO 2120 2160 IF XPR THEN 2200 2170 GOSUB 5040 2175 SIZE$=STR$(SIZE) 2180 A$="Enter up to"+SIZE$+" lines of text (NO semicolons).":GOSUB 5040 2190 A$="When finished, hit two RETURNs in a row.":GOSUB 5040 2200 GOSUB 5040:F=0 2210 IF F=SIZE THEN A$="Message full.":GOSUB 5040:GOTO 2280 2220 F=F+1 2230 A1$=SPACE$(3-LEN(STR$(F)))+STR$(F)+"> ":N=1:GOSUB 5040 2240 GOSUB 5170:IF B$="" THEN F=F-1:IF F=0 THEN 2500 ELSE 2280 2250 IF F=SIZE-2 THEN PRINT "(2 lines left)" 2260 IF F=SIZE-1 THEN PRINT "(Last line)" 2270 A$(F)=B$+" ":GOTO 2210 2280 GOSUB 5040 2290 A1$="Select: (H)eader, (L)ist, (E)dit, (A)bort, (C)ontinue, (S)ave: " 2300 IF XPR THEN A1$="H,L,E,A,C,S: " 2310 N=1:GOSUB 5040:C=1:GOSUB 5170 2320 IF B$="" THEN 2290 2330 FF=INSTR("HLEACS",B$):IF FF=0 THEN 2290 2340 ON FF GOTO 2540,2380,2700,2500,2210,2800 2350 REM 2360 REM LIST MESSAGE ENTERED 2370 REM 2380 GOSUB 5020:GOSUB 5040 2390 A$="Date/Time: "+D$:GOSUB 5040 2400 A$="To: "+TX$:GOSUB 5040 2410 A$="Re: "+K$:GOSUB 5040 2420 A$="PW: "+PW$:GOSUB 5040 2430 GOSUB 5080 2440 FOR L=1 TO F:A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L) 2450 IF BK THEN 2280 ELSE GOSUB 5040:NEXT L 2460 GOSUB 5040:GOTO 2280 2470 REM 2480 REM ABORT MESSAGE ENTRY 2490 REM 2500 GOSUB 5040:A$="Aborted":GOSUB 5040:GOSUB 5040:RETURN 2510 REM 2520 REM EDIT HEADER 2530 REM 2540 GOSUB 5040:A$="Enter replacement or RETURN for no change.":GOSUB 5040 2550 A1$="Date: "+D$+": ":N=1:GOSUB 5040:GOSUB 5170 2560 IF B$<>"" THEN D$=B$ 2570 A1$="To: "+TX$+": ":N=1:GOSUB 5040:C=1:GOSUB 5170 2580 IF B$="" THEN 2610 2590 TSV$=T$:T$=B$:GOSUB 7180:IF NOT OK THEN T$=TSV$:GOTO 2570 2600 GOSUB 7290 2610 A1$="Re: "+K$+": ":N=1:GOSUB 5040:C=0:GOSUB 5170 2620 IF B$<>"" THEN K$=B$ 2630 A1$="PW: "+PW$+": ":N=1:GOSUB 5040:C=1:GOSUB 5170 2640 IF B$="" THEN 2280 2650 IF T$<>"ALL" OR LEFT$(B$,1)<>"*" THEN PW$=B$:GOTO 2280 2660 A$="Cannot use '*' with ALL.":GOSUB 5040:GOTO 2630 2670 REM 2680 REM EDIT DRAFT MESSAGE 2690 REM 2700 IF XPR THEN 2740 2710 GOSUB 5040 2720 A$="Enter Line Number to change (RETURN or 0 to end).":GOSUB 5040 2730 A$="Then enter replacement or RETURN for no change.":GOSUB 5040 2740 GOSUB 5040:A1$="Line Number: ":N=1:GOSUB 5040:C=3:GOSUB 5170 2750 L=VAL(B$):IF L=0 OR L>F THEN GOSUB 5040:GOTO 2280 2760 A$=" was:":GOSUB 5040 2770 A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L):GOSUB 5040 2780 A1$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": ":N=1:GOSUB 5040:GOSUB 5170 2790 IF B$="" THEN 2740 ELSE A$(L)=B$+" ":GOTO 2740 2800 REM 2810 REM SAVE NEW MESSAGE 2820 REM 2830 IF PW$<>"" THEN PW$=";"+PW$ 2840 A$="Updating Summary file, ":N=1:GOSUB 5040 2850 OPEN "R",1,DSK2$+"SUMMARY",30 2860 RE=1:FIELD#1,30 AS RR$:RL=30 2870 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 5450:PUT#1,RE 2880 RE=RE+1:S$=D$:GOSUB 5450:PUT#1,RE 2890 RE=RE+1:S$=N$+" "+O$:GOSUB 5450:PUT#1,RE 2900 RE=RE+1:S$=T$:GOSUB 5450:PUT#1,RE 2910 RE=RE+1:S$=K$:GOSUB 5450:PUT#1,RE 2920 RE=RE+1:S$=STR$(F):GOSUB 5450:PUT#1,RE 2930 RE=RE+1:S$=" 9999":GOSUB 5450:PUT#1,RE 2940 CLOSE#1 2950 A$="Next Message #, ":N=1:GOSUB 5040:VV=0 2960 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MNUM 2970 LSET RR$=STR$(V+1):PUT#1,MNUM 2980 A$="Active Messages, ":N=1:GOSUB 5040 2990 GET#1,MSGS:VV=VAL(RR$) 3000 LSET RR$=STR$(VV+1):PUT#1,MSGS:CLOSE#1 3010 A$="and Message file.":N=1:GOSUB 5040 3020 OPEN "R",1,DSK2$+"MESSAGES",65 3030 RL=65:FIELD#1,65 AS RR$:RE=MX+1 3040 S$=STR$(V+1)+PW$:GOSUB 5450:PUT#1,RE 3050 RE=RE+1:S$=D$:GOSUB 5450:PUT#1,RE 3060 RE=RE+1:S$=N$+" "+O$:GOSUB 5450:PUT#1,RE 3070 RE=RE+1:S$=T$:GOSUB 5450:PUT#1,RE 3080 RE=RE+1:S$=K$:GOSUB 5450:PUT#1,RE 3090 RE=RE+1:S$=STR$(F):GOSUB 5450:PUT#1,RE 3100 RE=RE+1 3110 FOR P=1 TO F:S$=A$(P):GOSUB 5450:PUT#1,RE:RE=RE+1:NEXT P:SS$=" 9999":GOSUB 5450:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F 3120 GOSUB 5040:GOSUB 5040:U=U+1:RETURN 3130 REM 3140 REM ***RETRIEVE MESSAGE*** 3150 REM 3155 FLG=0 'Tag as a message retrieve and not a SCAN 3160 FT=-1:G=0 3170 GOSUB 5040 3180 A2$="Retrieve":GOSUB 3580 3190 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$) 3200 IF M<1 THEN GOSUB 5040:RETURN 3210 IF M>U THEN GOSUB 7010:GOTO 3170 3220 OPEN "R",1,DSK2$+"MESSAGES",65 3230 RE=1:FIELD#1,65 AS RR$:MI=0 3240 MI=MI+1:IF (MI>MZ) OR BK THEN 3530 ELSE G=M(MI,1) 3250 IF GM THEN 3480 3270 GOSUB 5990:IF OK OR NOT PERS THEN 3280 ELSE RE=RE+M(MI,2):GOTO 3240 3280 RE=RE+1:GET#1,RE:GOSUB 5500:D$=S$ 3290 RE=RE+1:GET#1,RE:GOSUB 5500:NO$=S$ 3300 RE=RE+1:GET#1,RE:GOSUB 5500:T$=S$ 3310 RE=RE+1:GET#1,RE:GOSUB 5500:GOSUB 6080:K$=S$ 3320 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 5040 3330 IF FT THEN GOSUB 5020:GOSUB 5040:FT=0 3340 A$="Msg #:"+STR$(G):GOSUB 5040 3350 A$="Date/Time: "+D$:GOSUB 5040 3360 T01$=NO$:T02$="":TX$=NO$ 3370 I=INSTR(NO$," "):IF I>0 THEN T01$=LEFT$(NO$,I-1):T02$=MID$(NO$,I+1) 3380 IF T01$<>SYS3$ THEN GOSUB 7330 3390 A$="From: "+TX$:GOSUB 5040 3400 T01$=T$:T02$="":TX$=T$ 3410 I=INSTR(T$," "):IF I>0 THEN T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1) 3420 GOSUB 7290 3430 A$="To: "+TX$:GOSUB 5040 3440 A$="Re: "+K$:GOSUB 5040:GOSUB 5040 3450 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 5500:A$=S$:GOSUB 5040 3460 IF BK THEN BK=0:GOTO 3480 3470 RE=RE+1:NEXT P:GOSUB 5040 3480 IF RIGHT$(B$,1)="+" THEN 3510 3490 IF G>HM THEN HM=G 3500 CLOSE:GOTO 3170 3510 M=M+1:MI=0:RE=1 3520 IF M<=U AND NOT BK THEN 3240 3530 IF G>HM THEN HM=G 3540 CLOSE:A$="End of Messages.":GOSUB 5040:GOSUB 5040:D$="":NO$="":RETURN 3550 REM 3560 REM COMMON MESSAGE NUMBER PROMPT 3570 REM 3580 A1$="Message Number: ("+STR$(IU)+"-"+STR$(U)+")" 3590 IF NOT XPR THEN A1$=A1$+" to "+A2$+" (RETURN to quit)" 3600 A1$=A1$+" : ":N=1:GOSUB 5040:GOSUB 5170:GOSUB 5040:RETURN 3610 REM 3620 REM ***SUMMARIZE MESSAGES*** 3630 REM 3640 GOSUB 5040 3645 FLG=1 'Flag this as being a Summary check 3650 A2$="Start":GOSUB 3580 3660 IF LEN(B$)=0 THEN M=0:GOSUB 5040:RETURN ELSE M=VAL(B$):GOSUB 5150 3670 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 3720 3680 IF LEN(B$)<3 THEN RETURN 3690 IF MID$(B$,2,1)<>"=" THEN RETURN 3700 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$) 3710 IF ST=0 THEN RETURN 3720 IF M<1 THEN RETURN 3730 IF M>U THEN GOSUB 7010:RETURN 3740 GOSUB 5020:GOSUB 5040 3750 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD #1,28 AS RR$ 3760 GET #1,RE 3770 IF EOF(1) OR BK THEN 3870 ELSE G=VAL(RR$) 3780 IF G>9998 THEN 3870 3790 IF G0 THEN S$=MID$(S$,I+1) 4000 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8) 4010 IF S$<>SYS3$ THEN CX$=S$:GOSUB 7020:S$=CX$ 4020 A$=A$+S$+SPACE$(8-LEN(S$))+" to => " 4030 RE=RE+1:GET #1,RE:GOSUB 5500 ' To 4040 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1) 4050 IF S$<>SYS3$ AND S$<>"ALL" THEN CX$=S$:GOSUB 7020:S$=CX$ 4060 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8) 4070 A$=A$+S$+SPACE$(8-LEN(S$))+" " 4080 RE=RE+1:GET #1,RE:GOSUB 5500 ' Subject 4090 GOSUB 6080 4100 A$=A$+S$:GOSUB 5040 4110 RETURN 4120 REM 4130 REM ***GOODBYE*** 4140 REM 4150 BK=0:GOSUB 4200:IF BK THEN 1400 4155 IF MF$="*" THEN A$=N$+", Don't call back Again ! ":GOSUB 5040:GOTO 4180 4160 A$=CN$+", thanks for calling...":GOSUB 5040 4170 A$="Please call again! Bye...":GOSUB 5040 4172 ' 4173 ' Go update the users file if needed 4174 ' 4175 IF N$=SYS3$ GOTO 4410 'No need to log if you are SYSOP 4176 ' 4180 GOSUB 5040:GOSUB 5040:IF IHM<>HM THEN MFJ$=MF$:GOSUB 6910 4190 GOTO 4410 4200 ' 4210 ' COMMENTS or FEEDBACK for the SYSOP 4220 ' 4230 IF N$=SYS3$ THEN RETURN 4240 GOSUB 5040 4250 A1$="Enter confidential comments for the SYSOP ":GOSUB 6940 4260 IF NOT OK THEN 4360 4270 RE=2:RL=65:OPEN "R",1,DSK2$+"COMMENTS",65:FIELD#1,65 AS RR$ 4280 GET#1,1:RE=VAL(RR$)+1:IF RE=1 THEN RE=2 4290 S$=" ":GOSUB 5450:PUT#1,RE:RE=RE+1 4300 S$="From: "+CN$+" "+CO$:GOSUB 5450:PUT#1,RE 4310 A$="Enter text; type two RETURNs to exit":GOSUB 5040 4320 GOSUB 5040 4330 A1$="> ":N=1:GOSUB 5040:GOSUB 5170 4340 IF B$<>"" THEN RE=RE+1:S$=B$:RL=65:GOSUB 5450:PUT#1,RE:GOTO 4330 4345 A1$="Done ":GOSUB 6940 4346 IF NOT OK THEN GOTO 4330 4350 S$=STR$(RE):RL=65:GOSUB 5450:PUT#1,1:CLOSE 4360 GOSUB 5040 4380 GOSUB 5040:RETURN 4390 A1$="Sorry, too many errors. Try again another time. Bye..." 4400 GOSUB 5040:GOSUB 5040 4410 ' 4423 ' 4430 POKE 0,&HC3 '<--- Restore jump instruction at WBOOT. 4440 POKE &H5B,0 '<--- Prevent "RBBS P" until next signin. 4441 ' 4444 ' 4445 RUN "BYE.COM" 4447 ' 4448 ' 4450 SYSTEM 'Return back to the operating system. 4455 ' 4460 ' 4470 ' ===> KILL A MESSAGE 4480 ' 4490 IF N$=SYS3$ GOTO 4530 'Hey! this guy is the SYSOP 4495 IF MF$="!" OR MF$="#" THEN GOTO 4530 'No it's really a Valid user 4496 ' 4500 GOSUB 5040:GOSUB 5040 4510 A$=ANS1$:GOSUB 5040:GOSUB 5040:SAV$="":RETURN 4520 REM 4530 GOSUB 5040 4540 A2$="Kill":GOSUB 3580 4550 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$) 4560 IF M<1 THEN GOSUB 5040:RETURN 4570 IF M>U THEN GOSUB 7010:GOTO 4520 4580 A$="Scanning Summary file...":N=1:GOSUB 5040 4590 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30 4600 GET#1,RE 4610 IF EOF(1) THEN 4800 ELSE G=VAL(RR$) 4620 IF G>9998 THEN 4800 4630 IF GM THEN 4800 4650 GOSUB 5960:IF OK OR NOT PERS THEN 4660 ELSE 4800 4660 GET#1,RE:GOSUB 5500:PW=INSTR(S$,";"):PW$="" 4670 IF PW=0 OR N$=SYS3$ OR PERS OR OK THEN PERS=0:GOTO 4700 4680 PW$=MID$(S$,PW+1):GOSUB 5040:A1$="Password: ":N=1:GOSUB 5040 4690 C=1:GOSUB 5170:IF B$<>PW$ THEN A$="Incorrect.":GOTO 4810 4700 S$=" 0"+":"+STR$(G):GOSUB 5450:PUT#1,RE:CLOSE 4710 A$="Updating Message file...":N=1:GOSUB 5040 4720 OPEN "R",1,DSK2$+"MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0 4730 MI=MI+1:IF MI>MZ THEN 4800 ELSE G=M(MI,1) 4740 IF G"" AND A1$<>"" THEN A1$="":RETURN 5080 IF A1$<>"" THEN A$=A1$:A1$="" 5090 IF N=1 THEN PRINT A$;:PP$=A$:GOTO 5140 5100 BI=ASC(INKEY$+" ") 5110 IF BI=&H13 OR BI=&H53 OR BI=&H73 THEN BI=ASC(INPUT$(1)):GOTO 5130 5120 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN BK=-1:GOTO 5150 5130 PRINT A$ 5140 A=A+LEN(A$) 5150 A$="":N=0 5160 RETURN 5170 REM 5180 REM ***ACCEPT STRING INTO B$ FROM CONSOLE*** 5190 REM 5200 IF BEL AND SAV$="" THEN PRINT CHR$(7); 5210 B$="":BK=0 5220 IF SAV$="" THEN GOSUB 6210:IF C<>3 THEN PRINT 5230 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 5250 5240 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1) 5250 IF LEN(B$)=0 THEN C=0:RETURN 5260 IF C=0 THEN 5280 5270 CY$=B$:GOSUB 7100:B$=CY$ 5280 D=D+LEN(B$):C=0 5290 RETURN 5300 REM 5310 REM ***ON ERROR HANDLER*** 5315 IF ERL=420 THEN RESUME 430 5320 IF ERL=440 THEN RESUME 450 5330 IF ERL=920 THEN RE=0:RESUME 930 5340 IF ERL=1000 THEN RESUME 1040 5350 IF ERL=1200 THEN RESUME 1350 5360 IF ERL=1980 THEN RESUME 2000 5370 IF ERL=2960 THEN RESUME 2970 5380 IF ERL=2990 THEN RESUME 3000 5390 IF ERL=3220 THEN RESUME 3540 5400 IF ERL=3750 THEN RESUME 3870 5410 IF ERL=4270 THEN RESUME 4300 5420 IF ERL=5710 THEN RESUME 5760 5430 IF ERL=6740 THEN RESUME 6850 5435 IF ERL=9070 THEN RESUME 9090 5440 RESUME NEXT 5450 REM 5460 REM FILL AND STORE DISK RECORD 5470 REM 5480 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10) 5490 RETURN 5500 REM 5510 REM UNPACK DISK RECORD 5520 REM 5530 ZZ=LEN(RR$)-2 5540 WHILE MID$(RR$,ZZ,1)=" " 5550 ZZ=ZZ-1:IF ZZ=1 THEN 5570 5560 WEND 5570 S$=LEFT$(RR$,ZZ) 5580 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" " 5590 RETURN 5600 REM 5610 REM *** TOGGLE EXPERT USER MODE 5620 REM 5630 XPR=NOT XPR:RETURN 5640 REM 5650 REM *** TOGGLE BELL PROMPT 5660 REM 5670 BEL=NOT BEL:RETURN 5680 REM 5690 REM SUBROUTINE TO PRINT A FILE 5700 REM 5710 OPEN "I",1,DSK$+FIL$:BK=0:IF EOF(1) THEN 5760 5720 IF NW=0 THEN GOSUB 5020 ELSE NW=0 5730 GOSUB 5040 5740 IF EOF(1) OR BK THEN 5760 ELSE LINE INPUT #1,A$:GOSUB 5040:GOTO 5740 5750 GOSUB 5040 5760 CLOSE #1:RETURN 5770 REM 5780 REM PRINT "CALLERS" FILE 5790 REM 5800 IF N$=SYS3$ GOTO 5840 'This is the SYSOP let him on 5805 IF MF$="#" OR MF$="!" THEN GOTO 5840 'This is a Good guy 5810 GOSUB 5040 5820 A$=ANS1$:GOSUB 5040:GOSUB 5040:RETURN 5830 REM 5840 GOSUB 5040 5850 A$="Hit Ctrl K to Abort listing":GOSUB 5040 5860 GOSUB 5040 5870 OPEN "R",1,DSK3$+"CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$) 5880 CA=CN 5890 FOR CNT=SIZ+1 TO 2 STEP -1 5900 GET #1,CNT:GOSUB 5500 5910 A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 5040:IF BK THEN 5940 5920 CA=CA-1 5930 NEXT CNT 5940 CLOSE:GOSUB 5040 5950 A$="*** End of CALLERS ***":GOSUB 5040:GOSUB 5040:RETURN 5960 REM 5970 REM TEST FOR PERSONAL MESSAGES 5980 REM 5990 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")<>0 THEN PERS=-1 6000 IF N$=SYS3$ THEN 6030 'This is the SYSOP let him read anything 6001 ' 6002 ' The next checks to see if SUPER users and allow only viewing 6003 ' of personal messages in the SCAN MODE 6004 ' 6005 IF MF$="#" AND FLG=1 THEN 6030 'Super and in SCAN mode 6006 ' 6008 IF FLG=1 AND MF$>" " AND SCAN$="Y" THEN 6030 'Let valid users see 6009 ' 6010 GET #1,RE+3:GOSUB 6050:IF OK THEN 6030 6020 GET #1,RE+2:GOSUB 6050 6030 RETURN 6040 REM TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME 6050 GOSUB 5500:I=INSTR(S$," "):S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1) 6060 IF S1$=N$ AND S2$=O$ THEN OK=-1 ELSE OK=0 6070 RETURN 6080 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0 6090 RETURN 6100 REM 6110 REM PRINT COMMENTS FILE FOR SYSOP (Z COMMAND) 6120 REM 6130 GOSUB 5040:OPEN "R",1,DSK2$+"COMMENTS",65:RE=1:FIELD#1,65 AS RR$ 6140 GET#1,RE:RE=RE+1:IF EOF(1) THEN 6160 6150 GOSUB 5500:A$=S$:GOSUB 5040:GOTO 6140 6160 CLOSE:GOSUB 5040:IF RE=2 THEN RETURN 6170 A$="*** End of COMMENTS ***":GOSUB 5040:GOSUB 5040 6180 IF RE>3 THEN 6190 ELSE RETURN 6190 A1$="Delete COMMENTS file? ":GOSUB 6940:IF OK THEN KILL DSK2$+"COMMENTS" 6200 RETURN 6210 REM 6220 REM CHARACTER-AT-A-TIME LINE INPUT WITH EDITING (IF C=2, NO ECHO) 6230 REM 6240 CHC=0: SAV$="":DC=0:IC=&H30 6250 NCH=ASC(INPUT$(1)) 6260 IF NCH=13 THEN RETURN 'CR 6270 IF NCH=127 THEN 6350 6280 IF NCH<32 THEN 6370 6290 IF CHC>=63 THEN PRINT CHR$(7);:GOTO 6250 6300 SAV$=SAV$+CHR$(NCH): CHC=CHC+1 :IC=IC+1:IF IC=&H3A THEN IC=&H30 6310 IF DC THEN PRINT CHR$(10); 6320 IF C<>2 THEN PRINT CHR$(NCH); ELSE PRINT CHR$(IC); 6330 IF CHC=55 THEN PRINT CHR$(7); 6340 DC=0:GOTO 6250 6350 IF CHC=0 THEN 6250 ELSE PRINT BSL$;:DC=-1 6360 CHC=CHC-1:IC=IC-1: SAV$=LEFT$(SAV$,CHC): GOTO 6250 6370 IF CHC=0 THEN 6250 6380 IF NCH=8 THEN PRINT ERS$;:DC=0:GOTO 6360 'BS 6390 IF NCH=12 THEN GOSUB 6450:GOTO 6460 '^L 6400 IF NCH=18 THEN PRINT:PRINT PP$;:GOTO 6460 '^Retype 6410 IF NCH=21 THEN PRINT " #": PRINT PP$;:DC=0:GOTO 6240 '^U 6420 IF NCH<>24 THEN 6250 '^X 6430 GOSUB 6450 6440 GOTO 6240 6450 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: RETURN 6460 IF C<>2 THEN PRINT SAV$;: GOTO 6480 6462 ' 6465 ' Print numbers to hide Password 6468 ' 6470 IC=&H30:FOR BCC=1 TO CHC: IC=IC+1: PRINT CHR$(IC);: NEXT BCC 6480 DC=0:GOTO 6250 6490 REM 6500 REM NEW USER PASSWORD PROMPT 6510 REM 6520 GOSUB 5040 6530 A$="Enter at least six alphanumeric characters":GOSUB 5040 6540 A1$="for your PASSWORD: " 6550 N=1:GOSUB 5040:C=2:GOSUB 5170:S04$=B$:IF S04$="" THEN 6520 6560 IF LEN(S04$)<6 THEN 6520 6570 A1$="Now enter it again: " 6580 N=1:GOSUB 5040:C=2:GOSUB 5170 6590 IF S04$<>B$ THEN A1$="No match. Try again.":GOSUB 5040:GOTO 6520 6600 A$="OK, now please remember it.":GOSUB 5040:GOSUB 5040:RETURN 6610 REM 6620 REM USER PASSWORD CHANGE ROUTINE 6630 REM 6640 IF N$<>SYS3$ THEN 6860 6650 A1$="User's FIRST Name: ":N=1:GOSUB 5040 6660 C=1:GOSUB 5170:T01$=B$:IF T01$="" THEN RETURN 6670 A1$="User's LAST Name: ":N=1:GOSUB 5040 6680 C=1:GOSUB 5170:T02$=B$:IF T02$="" THEN RETURN 6690 OK=0:GOSUB 6710:IF OK THEN GOSUB 7550:GOTO 6650 6700 A$="Not found.":GOSUB 5040:GOTO 6650 6710 REM 6720 REM CHECK USERS FILE 6730 REM 6740 OPEN "R",1,DSK3$+"USERS",62:FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$) 6750 FOR J=2 TO NU+1:GET#1,J:GOSUB 5500:S00$=MID$(S$,3) 6760 I=INSTR(S00$,";"): S01$=LEFT$(S00$,I-1):S02$=MID$(S00$,I+1) 6770 I=INSTR(S02$,";"): S03$=MID$(S02$,I+1):S02$=LEFT$(S02$,I-1) 6780 I=INSTR(S03$,";"): S04$=MID$(S03$,I+1):S03$=LEFT$(S03$,I-1) 6790 I=INSTR(S04$,";"): IF I=0 THEN S05$="0":GOTO 6810 6800 S05$=MID$(S04$,I+1):S04$=LEFT$(S04$,I-1) 6810 HM=VAL(S05$) 6820 IF T01$<>S01$ OR T02$<>S02$ THEN 6840 6830 MFJ$=LEFT$(S$,1):GOSUB 5040:UJ=J:OK=-1:CLOSE:RETURN 6840 NEXT J 6850 CLOSE:RETURN 6860 REM 6870 REM UPDATE USERS FILE 6880 REM 6890 MFJ$=MF$ 6900 GOSUB 6490 6910 OPEN "R",1,DSK3$+"USERS",62:FIELD#1,62 AS RR$ 6920 S$=MFJ$+" "+S01$+";"+S02$+";"+S03$+";"+S04$+";"+STR$(HM) 6930 RL=62:GOSUB 5450:PUT#1,UJ:CLOSE:RETURN 6935 ' 6940 'Prompt for YES or NO answer 6960 ' 6970 A2$=A1$:OK=0 6980 A1$=A2$:N=1:GOSUB 5040:C=1:GOSUB 5170:ANS$=LEFT$(B$,1) 6990 IF ANS$="" THEN 6980 ELSE IF ANS$="Y" THEN OK=-1:RETURN 7000 IF ANS$="N" THEN RETURN 7005 A$="":GOSUB 5040:GOTO 6940 7008 ' 7009 ' 7010 A$="That's an invalid message number, "+CN$+".":GOSUB 5040:SAV$="":RETURN 7020 ' 7030 ' CAPITALIZE STRING CX$ (e.g., FRANK -> Frank) 7040 ' 7050 FOR ZZ=2 TO LEN(CX$) 7060 ZA=ASC(MID$(CX$,ZZ,1)):IF ZA<&H41 OR ZA>&H5A THEN 7080 7070 MID$(CX$,ZZ,1)=CHR$(ZA+&H20) 7080 NEXT ZZ 7090 RETURN 7100 REM 7110 REM UPPERCASE STRING CY$ (e.g., frank -> FRANK) 7120 REM 7130 FOR ZZ=1 TO LEN(CY$) 7140 ZA=ASC(MID$(CY$,ZZ,1)):IF ZA<&H61 OR ZA>&H7A THEN 7160 7150 MID$(CY$,ZZ,1)=CHR$(ZA-&H20) 7160 NEXT ZZ 7170 RETURN 7180 REM 7190 REM CHECK FOR EXISTING USER (FOR "TO:") 7200 REM 7210 T01$=T$:T02$="" 7220 IF T$=SYS3$ OR T$="ALL" THEN OK=-1:RETURN 7230 U01$=S01$:U02$=S02$:U03$=S03$:U04$=S04$:SHM=HM:SUJ=UJ:SMF$=MF$ 7240 I=INSTR(T$," "): IF I=0 THEN OK=0:GOTO 7270 7250 T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1):OK=0:GOSUB 6710 7260 S01$=U01$:S02$=U02$:S03$=U03$:S04$=U04$:HM=SHM:UJ=SUJ:MF$=SMF$ 7270 IF NOT OK THEN A1$="Not a currently known User. OK? ":GOSUB 6940 7280 RETURN 7290 REM 7300 REM CAPITALIZE "TO:" FOR MESSAGE ENTRY DISPLAY 7310 REM 7320 IF T$=SYS3$ OR T$="ALL" THEN TX$=T$:RETURN 7330 CX$=T01$:GOSUB 7020:T01$=CX$:CX$=T02$:GOSUB 7020:T02$=CX$ 7340 TX$=T01$+" "+T02$ 7350 RETURN 7360 CX$=N$:GOSUB 7020:CN$=CX$:CX$=O$:GOSUB 7020:CO$=CX$:RETURN 7370 REM 7380 A$=" ":GOSUB 5040:GOSUB 5040:GOSUB 5040 7390 A$="> "+CN$+" "+CO$+" <...You have entered the CHAT mode":GOSUB 5040 7400 A1$="Shall I page the SYSOP ":GOSUB 6940 7410 IF NOT OK THEN RETURN 7420 FOR T1=1 TO 5 7430 PRINT CHR$(7); 7440 FOR T2=1 TO BEEP:NEXT T2 7450 NEXT T1 7460 GOSUB 5040:GOSUB 5040 7470 A$="Type /EX to Exit the CHAT mode":GOSUB 5040 7480 A$="":GOSUB 5040 7490 BELS=BEL:BEL=0 'NO BELL DURING CHAT BUT SAVE ORIG. VALUE 7500 A1$=">":N=1:GOSUB 5040:GOSUB 5170 7510 IF B$="/EX" OR B$="/ex" THEN BEL=BELS:RETURN 7520 GOTO 7500 7530 GOTO 1420 'GO BACK TO BEGINNING JUST IN CASE 7540 REM 7550 REM Program area to validate users by SYSOP 7560 REM 7570 IF N$<>SYS3$ THEN GOTO 1420 'DOUBLE CHECK IF SYSOP 7571 GOSUB 5040 7572 A$=S01$+" "+S02$+" "+" password-> "+S04$+" < ====>> ":N=1:GOSUB 5040 7573 IF MFJ$=" " THEN A$="Unvalidated User":GOTO 7578 7574 IF MFJ$="!" THEN A$="Validated User":GOTO 7578 7575 IF MFJ$="#" THEN A$="SUPER User":GOTO 7578 7576 IF MFJ$="*" THEN A$="TWIT Status":GOTO 7578 7577 A$="User log ERROR" 7578 N=1:GOSUB 5040 7579 GOSUB 5040:A$=" ":GOSUB 5040 7580 A1$="Change

assword or alidate this user ->":N=1:GOSUB 5040 7585 C=1:GOSUB 5170:IF B$="P" THEN GOTO 6900 7590 IF B$="V" THEN 7600 7595 B$="":GOTO 6650 7600 GOSUB 5040 7610 A1$="Enter validation authorization Password ->":N=1:GOSUB 5040 7620 C=2:GOSUB 5170:IF B$=VAP$ THEN 7640 7630 GOTO 6650 'GO BACK AND TRY AGAIN 7640 A1$="wit, alid user or uper user ->":N=1:GOSUB 5040 7650 C=1:GOSUB 5170 7652 IF B$="T" THEN MFJ$="*":GOTO 7660 'Tag this guy as a TWIT 7654 IF B$="S" THEN MFJ$="#":GOTO 7660 'Tag him as a SUPER user 7655 MFJ$="!" 'Just a plain ole VALID user 7660 GOTO 6910 'GO ADD IT TO THE FILE 7670 REM 7680 REM **** DISPLAY NEWS FILES **** 7690 REM 7700 FIL$="NEWS":NW=0:GOSUB 5680 ' Bring up NEWS menu file 7705 IF NNUM=0 THEN RETURN ' If no news files then return 7710 A1$="News file number 1 -" 7715 A1$=A1$+STR$(NNUM)+", "+STR$(NNUM+1)+" to Exit --> " 7720 N=1:GOSUB 5040:C=1:GOSUB 5170 7730 IF B$="" THEN 7710 7740 FQ=VAL(B$):IF FQ<1 OR FQ>NNUM THEN RETURN 7750 FIL$="NEWS"+MID$(STR$(FQ),2):NW=0:GOSUB 5680:GOTO 7700 7760 'End of routine. 7770 ' 7771 ' Leave a TWIT a Message From SYSOP 7772 ' 7800 FIL$="TWIT":NW=1:GOSUB 5680 7810 GOTO 4130 7820 ' 7825 ' 7826 ' View the XMODEM.LOG file from RBBS 7827 ' 7830 FIL$="XMODEM.LOG":NW=0:GOSUB 5680: RETURN 7831 ' 7835 ' 7840 ' HERE IS THE HELP FILE SECTION 7850 ' 7900 FIL$="HELP":NW=0:GOSUB 5680 7905 IF HNUM=0 THEN RETURN 'If no HELP files then return 7910 A1$="HELP File number 1 -" 7915 A1$=A1$+STR$(HNUM)+", "+STR$(HNUM+1)+" to exit -->" 7920 N=1:GOSUB 5040:C=1:GOSUB 5170 7930 IF B$="" THEN 7910 7940 FQ=VAL(B$):IF FQ<1 OR FQ>HNUM THEN RETURN 7950 FIL$="HELP"+MID$(STR$(FQ),2):NW=0:GOSUB 5680:GOTO 7900 7960 ' 7965 ' 7970 ' Special Sub-routine for multi SYSOP function 7975 ' 8000 IF MSYS=1 THEN O$="":GOTO 8030 'Only one SYSOP 8002 ' 8005 GOSUB 5040:A1$="Which SYSOP are you -> ":N=1:GOSUB 5040 8010 C=1:GOSUB 5170:IF B$="" THEN 8005 8020 O$=B$ 8030 CN$=N$:CO$=O$:GOSUB 5600:RETURN 8040 ' 8095 ' THE FOLLOWING AREA WAS MOVED TO ALLOW FOR ENTRY OF ROUTINES 8096 ' WHEN THERE IS A REAL TIME CLOCK IN THE SYSTEM 8098 ' 9000 ' Come here to get date and time information 9002 ' 9005 IF DATIM$="Y" THEN GOTO 9070 'If external date/time file 9010 ' 9030 A1$="Today's Date/Time (MM/DD|HH:MM) ":N=1:GOSUB 5040:GOSUB 5170 9040 IF B$="" THEN 9030 ELSE D$=B$ 9050 IF LEN(D$) >11 THEN PRINT "Please use correct format":GOTO 9030 9060 RETURN 9070 OPEN "I",1,DSK$+"DATETIME.DAT" 9080 INPUT #1,D$ 'Get the date/time information 9090 CLOSE #1 9095 RETURN 9999 ' THE REAL END OF THE PROGRAM