1  ' Remote Bulletin Board System V 3.8A  (7/30/85)
2  ' 
4  ' Revised from RBBS V. 3.7  &  3.8
5  '
6  ' By Dennis Recla  Lillypond Softwares  
8  '                    Garland, Texas  
9  '
10 DEFINT A-Z
20 ' 
30 DIM A$(25),M(200,2)
40 ' 
60 ' 
70 ' Local mods section and default values
80 ' 
90 VERS1$="RBBS v 3.8 without (BOOTPWD) and (pwds) files."
100 ' 
110 VERS2$="Lillypond Software RBBS v 3.8A (07/30/85)"
120 ' 
130 SYS1$="dennis"	' name of SYSOP so that when you log in RBBS
140 ' 
150 SYS2$="recla"	' will check for mail to SYSOP and SYS1$,SYS2$
160 ' 
170 SYS3$="SYSOP"	' this is the FIRST NAME for SYSOP entry to system
180 ' 
190 P2$="supersysop"	' this is the LAST NAME for SYSOP entry to system
200 ' 
210 P1$="goto-cpm"	' this is the FIRST NAME for direct entry to CP/M
220 ' 
230 P3$="ddt"		' CP/M entry password
240 ' 
250 VAP$="password"	' password for use of validation software by SYSOP
260 ' 
270 PC$="What is the DRI debugger? " ' CP/M entry password prompt
280 ' 
290 DSK$="A:"		' drive to first look for non DSK2$ or DSK3$ files. 
300 ' 
310 DSK2$="A:"		' if no PWDS file default to drive A:
320 ' 
330 DSK3$="A:"		' additional drive area for files
340 ' 
350 DSK4$="A:"		' location for HELP files
360 ' 
370 DSK5$="A:"		' location for NEWS files
375 ' 
380 DSK6$=DSK$		' store DSK$
385 '
390 DFIL$="DUMMY"	' file to run from 'D' command
395 '
400 EPRG$="NOFILE"	' Name of file to run on EXIT to CP/M
405 ' 
410 ANS1$=" >> You can not do that << "
415 ' 
420 NSP$="No spaces."
425 '
430 EXIT$="BYE.COM"	' program to run on exit 
435 '
440 ERS$=CHR$(8)+" "+CHR$(8)
445 ' 
450 BSL$=CHR$(8)+"/"+CHR$(8)
455 '
460 TWIT=-1		' logout TWITs
465 ' 
470 DATIM=0		' no external clock
480 ' 
490 BEEP=20000		' 20,000 counts for CHAT
500 ' 
510 SIZE=15		' 15 line messages
520 ' 
530 WHEEL=0		' Do not set WHEEL on SYSOP exit
560 ' 
570 MSYS=0		' not multi-SYSOPs
600 ' 
610 NNUM=0		' number of NEWS files
620 ' 
630 HNUM=0		' number of HELP files
640 ' 
650 SEC=-1		' secure mode
660 ' 
670 SKIP=-1		' skip "highest message read" info
680 ' 
690 LMSG=3		' only SUPER users can enter messages
700 ' 
710 GOCPM=3		' only SUPER users can go to CP/M
720 ' 
730 SHOLOC=0		' do not store CALLERS or show USERS locations
740 ' 
750 LOGALL=0		' do not put unvalidated in CALLERS file
760 ' 
770 SHOALL=0		' do not show unvalidated in USERS file
780 ' 
790 ' This is the official start of the program
800 ' 
810 POKE 0,&HCD		' change the JUMP (C3) at 0 to a CALL (CD)
820 '                   this prevents the system from rebooting
830 ' 
840 INC=1
850 ON ERROR GOTO 7390
860 RFLG=PEEK(&H5D):POKE &H5D,&H20
870 RTNOKFLG=PEEK(&H5B):POKE &H5B,120	' legal return flag.
880 ' 
890 ' Signon functions
900 ' 
910 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1:NW=0
920 BK=0:GOSUB 7130
930 ' 
940 ' Original file loaded with passwords
950 ' 
960 OPEN "I",1,DSK$+"BOOTPWD":IF EOF(1) THEN 1000
970 ' 
980 INPUT #1,DSK2$,DSK3$,DSK4$,DSK5$,SYS1$,SYS2$,VERS1$,TWIT
985 INPUT #1,DATIM,SEC,SHOLOC,DFIL$,EPRG$,WHEEL 
990 ' 
1000 CLOSE #1
1010 ' 
1020 PRINT VERS1$	' print name of system
1030 ' 
1040 GOSUB 7130:GOSUB 7130  ' put a space between VERS1 & VERS2
1050 ' 
1060 ' Second passwords file loaded
1070 ' 
1080 OPEN "I",1,DSK2$+"pwds":IF EOF(1) THEN 1130
1090 ' 
1100 INPUT #1,P1$,P2$,P3$,PC$,VAP$,EXIT$,LOGALL,SHOALL
1110 INPUT #1,BEEP,SIZE,MSYS,NNUM,HNUM,SKIP,LMSG,GOCPM
1120 ' 
1130 CLOSE #1
1140 ' 
1150 BEL=-1:XPR=0	' initial bell on, not expert
1155 '
1160 NEWUSER=0
1165 ' 
1170 PRINT VERS2$	' print the program id
1180 ' 
1190 GOSUB 7130:GOSUB 7130:SAV$=""
1200 IF RFLG<>ASC("P") THEN 1300
1210 IF RTNOKFLG<>ASC("x") THEN 1300
1220 V=0:INC=0		' so caller number says same
1230 OPEN "I",1,DSK3$+"LASTCALR":INPUT #1,N$,O$,D$:CLOSE
1240 A$="Welcome back, "
1250 IF N$<>SYS3$ THEN 1270
1260 CN$=N$:O$="":CO$=O$:A$=A$+N$+".":GOSUB 7130:GOSUB 7130:V=1:GOTO 2160
1270 GOSUB 9450:V=1
1280 A$=A$+CN$+" "+CO$+".":GOSUB 7130:GOSUB 7130
1290 T01$=N$:T02$=O$:GOSUB 8800:MF$=MFJ$:GOTO 2160
1300 GOSUB 3580:IF NOT BK THEN NW=1:GOSUB 3540                          ' print INFO, then BULLETIN
1310 GOSUB 7130:BK=0
1320 ' 
1330 R=0                		' only give them three
1340 S=0:IF R=3 THEN 1690 ELSE 1360     ' chances to get it right
1350 ' 
1360 S=S+1:A1$="Enter your FIRST Name: ":N=1:GOSUB 7130
1370 C=1:GOSUB 7260:N$=B$:IF N$="" THEN 1360
1380 IF P1$="NOPASS" THEN 1400                                          ' skip past the following
1390 IF N$=P1$ AND P1$<>"NOPASS" THEN POKE &H5B,0:GOTO 3440             ' direct CP/M exit
1400 IF N$<"A" OR LEN(N$)=1 THEN 1360
1410 ' 
1420 ' Check for spaces in the callers first name
1430 ' 
1440 IF INSTR(N$," ")>0 THEN A1$=NSP$:N=1:GOSUB 7130:GOSUB 7130:GOTO 1360
1450 ' 
1460 A1$="Enter your LAST Name:  ":N=1:GOSUB 7130
1470 C=1:IF N$=SYS3$ THEN C=2
1480 GOSUB 7260:O$=B$:IF O$="" THEN 1360
1490 IF O$<"A" OR LEN(O$)=1 THEN 1360
1500 ' 
1510 IF N$=SYS3$ AND O$=P2$ THEN GOSUB 10310:GOTO 1820                  ' this must be a SYSOP
1520 ' 
1530 IF N$=SYS3$ THEN GOSUB 7130:A1$="Not the SYSOP!":GOSUB 7130:GOTO 6370
1540 ' 
1550 ' Check for spaces in the callers last name
1560 ' 
1570 IF INSTR(O$," ")>0 THEN A1$=NSP$:N=1:GOSUB 7130:GOSUB 7130:GOTO 1460
1580 ' 
1590 GOSUB 7130:A$="Checking File...":GOSUB 7130
1600 V=0:T01$=N$:T02$=O$:OK=0:GOSUB 8800:IF OK THEN MF$=MFJ$:GOTO 1610 ELSE 1650
1610 T=0
1620 T=T+1:IF T=4 THEN 1690 ELSE A1$="Enter your PASSWORD: "
1630 N=1:GOSUB 7130:C=2:GOSUB 7260:UPW$=B$:IF UPW$="" THEN 1620
1640 IF UPW$=S04$ THEN 1820 ELSE 1620
1650 IF S=3 THEN 1690 ELSE:GOSUB 7130:A1$="First time caller? (Y/N) ":GOSUB 9030
1660 IF NOT OK THEN A$="Try again.":GOSUB 7130:GOSUB 7130:GOTO 1360
1670 IF NOT SEC THEN 1700                                               ' not in secure mode
1680 GOSUB 7130:A$="Private system!":GOSUB 7130:GOTO 6370
1690 GOSUB 7130:A1$="Too many errors!":GOSUB 7130:GOTO 6370
1700 V=1:GOSUB 8560                                                     ' get caller to set their own password
1710 A1$="Enter your LOCATION (City, State): ":N=1:GOSUB 7130
1720 C=1:GOSUB 7260:S03$=B$:IF S03$="" THEN 1710
1730 GOSUB 9450
1740 GOSUB 7130:A$=CN$+" "+CO$+" from "+S03$:GOSUB 7130
1750 R=R+1:A1$="All Correct? (Y/N) ":GOSUB 9030:IF NOT OK THEN 1340
1760 HM=0:S05$=STR$(HM):S$="  "+N$+";"+O$+";"+S03$+";"+S04$+";"+S05$
1770 OPEN "R",1,DSK3$+"USERS",62:FIELD #1,62 AS RR$
1780 RL=62:GOSUB 7580:NU=NU+1:PUT #1,NU+1:S$=STR$(NU):GOSUB 7580:PUT #1,1:CLOSE
1790 ' 
1800 FIL$="NEWCOM":NW=1:GOSUB 7810:MF$=" ":NEWUSER=-1                   ' flag NEWCOM for new user
1810 ' 
1820 GOSUB 7130:A$="Logging to disk...":GOSUB 7130:GOSUB 7130:RE=1
1830 ' 
1840 ' Prompt caller for correct date
1850 ' 
1860 OPEN "I",1,DSK$+"DATE.DAT":IF EOF(1) THEN 1910
1870 INPUT #1,D$
1880 IF DATIM THEN 1950
1885 IF MF$=" " OR MF$="*" THEN CLOSE #1:GOTO 1990 
1890 A1$="Is "+D$+" todays date? (Y/N) ":GOSUB 9030:IF NOT OK THEN 1910
1900 CLOSE #1:GOTO 1990
1910 A1$="Enter todays date: (MM/DD/YY) ":N=1:GOSUB 7130
1920 C=1:GOSUB 7260:IF B$="" OR LEN(B$)<>8 THEN 1910
1930 CLOSE #1:OPEN "O",1,DSK$+"DATE.DAT":PRINT #1,B$
1940 D$=B$
1950 CLOSE #1
1980 ' 
1990 IF N$=SYS3$ THEN 2140                                              ' do not log SYSOP
2000 ' 
2010 IF MF$="*" THEN 2140                                               ' do not log TWITS
2020 ' 
2030 IF MF$=" " AND NOT LOGALL THEN 2140                                ' log UNVALIDATED if LOGALL
2040 ' 
2050 OPEN "R",1,DSK3$+"CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:RE=VAL(RR$)+1
2060 S$=STR$(RE):RL=60:GOSUB 7580:PUT #1,1:RE=RE+1
2070 IF SHOLOC THEN LOC$=S03$ ELSE LOC$=" "				' store location in CALLERS file
2100 S$=N$+" "+O$+" "+LOC$+" "+D$:GOSUB 7580:PUT #1,RE:CLOSE #1
2110 ' 
2120 ' Put callers name and date/time in the LASTCALR file
2130 ' 
2140 OPEN "O",1,DSK3$+"LASTCALR":PRINT #1,N$;",";O$;",";D$:CLOSE
2150 ' 
2160 PRINT
2170 ' 
2180 ' Check this callers status
2185 '
2190 IF MF$="#" THEN GOSUB 7730:GOSUB 7770 				' SUPER user is XPERT and no bell
2195 '
2200 IF MF$="*" AND TWIT THEN 10090                                     ' if it is * then you have a TWIT
2220			                                                ' if TWIT then log the dummy off
2230 '                                                                    but first tell him to go away
2240 ' 
2250 IF V=0 THEN IF N$<>SYS3$ THEN GOSUB 9450
2260 BK=0:CN=1:M=0:U=0
2270 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD #1,5 AS RR$
2280 GET #1,CALLS:IF N$=SYS3$ THEN CN=VAL(RR$) ELSE CN=VAL(RR$)+INC
2290 GET #1,MSGS:M=VAL(RR$)
2300 GET #1,MNUM:U=VAL(RR$)
2310 A$="Caller number:          ":N=1:GOSUB 7130
2320 A$=STR$(CN):LSET RR$=A$
2330 A$=SPACE$(4-LEN(STR$(CN)))+STR$(CN):PUT #1,CALLS:GOSUB 7130
2340 A$="Active messages:        ":N=1:GOSUB 7130
2350 A$=SPACE$(4-LEN(STR$(M)))+STR$(M):GOSUB 7130
2360 A$="Highest message number: ":N=1:GOSUB 7130
2370 A$=SPACE$(4-LEN(STR$(U)))+STR$(U):GOSUB 7130:CLOSE
2380 ' 
2390 IF N$=SYS3$ THEN 2500                                              ' no need to tell SYSOP this
2400 ' 
2410 IF SKIP THEN 2500                                                  ' skip over all of this too.
2420 ' 
2430 IF HM=0 THEN 2500                                                  ' if callers last message was zero
2435 '
2440 IF HM<=U THEN 2460 ELSE HM=0
2445 A$="Messages have been renumbered: ":N=1:GOSUB 7130:GOTO 2500  
2450 '                                                                    then skip the next message
2455 ' 
2460 A$="Highest message read:   ":N=1:GOSUB 7130
2470 ' 
2480 A$=SPACE$(4-LEN(STR$(HM)))+STR$(HM):GOSUB 7130
2490 ' 
2500 GOSUB 7130:A$=" ":GOSUB 7130:IHM=HM
2510 ' 
2520 ' Look for messages to this caller and build their message index
2530 ' 
2540 FT=-1:MX=0:MZ=0:IU=0:CNT=0:G=0
2550 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
2560 BK=0:GET #1,RE:IF EOF(1) THEN 2700
2570 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 2690
2580 IF IU=0 THEN IU=G
2590 IF G>9998 THEN MZ=MZ-1:GOTO 2700
2600 GET #1,RE+3:GOSUB 7630
2610 I=INSTR(S$," "):IF I=0 THEN S1$=S$:S2$="":GOTO 2630
2620 S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
2630 IF S1$=N$ AND S2$=O$ THEN 2660
2640 IF N$<>SYS3$ THEN 2690
2650 IF S1$=SYS1$ AND S2$=SYS2$ THEN 2660 ELSE 2690
2660 IF NOT FT THEN 2680
2670 A$="You have mail...":GOSUB 7130:GOSUB 7130:FT=0
2680 RX=RE:GOSUB 5820:RE=RX:CNT=CNT+1
2690 GET #1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 2560
2700 IF CNT=0 THEN 2715
2710 GOSUB 7130
2715 CLOSE
2720 '
2730 IF NEWUSER THEN GOSUB 3620
2735 ' 
2740 ' Main command acceptor/dispatcher
2750 ' 
2760 A$=CN$+" "+CO$+"?   Your command: "
2765 IF XPR THEN A1$=A$ ELSE GOSUB 7130
2770 IF NOT XPR THEN A1$=A1$+"  B,E,F,R,S,K,L,G,H,I,J,U,T,X,P,C,N,D ( or ? ): "
2780 N=1:GOSUB 7130:C=1:GOSUB 7260
2790 IF B$="" THEN 2760
2800 FF=INSTR("BER?SKGIJUTXPDCFNLH",B$):GOSUB 2810:GOTO 2760
2810 IF FF=0 THEN 2980
2820 ON FF GOTO 3540,3660,4980,3620,5460,6500,6040,3580,3100,6800,7770,7730,8680,3630,9490,6260,9960,7900,10180
2830 ' 
2960 ' Special SYSOP functions
2970 ' 
2980 IF B$="Z" AND N$=SYS3$ THEN GOSUB 8200:RETURN                      ' print COMMENTS file
2990 ' 
3000 IF B$="XL" AND N$=SYS3$ THEN GOSUB 10140:RETURN                    ' print XMODEM.LOG file
3010 ' 
3020 IF B$="UALL" AND N$=SYS3$ THEN 6800                                ' print entire USERS file
3030 ' 
3040 GOSUB 7130
3050 A$="I do not understand ("+B$+").":GOSUB 7130:GOSUB 7130
3060 SAV$="":RETURN
3070 ' 
3080 ' Exit to CP/M
3090 ' 
3100 T=0
3110 ' 
3120 IF N$=SYS3$ THEN 3440                                              ' SYSOP can always go to CP/M
3130 ' 
3140 IF MF$="#" THEN 3340                                               ' SUPER user can always go to CP/M
3150 ' 
3160 IF GOCPM=3 THEN 3240                                               ' no one can go to CP/M but SUPER user
3170 ' 
3180 IF MF$<>"*" AND GOCPM=1 THEN 3290                                  ' let unvalidated users go to CP/M
3190 ' 
3200 IF MF$="!" AND GOCPM=2 THEN 3290                                   ' let validated users go to CP/M
3210 ' 
3220 ' Tell caller they cannot go to CP/M
3230 ' 
3240 GOSUB 7130
3250 A$=ANS1$:GOSUB 7130:GOSUB 7130:SAV$="":RETURN
3260 ' 
3270 ' If NOPASS then a password is not needed
3280 ' 
3290 IF P3$="NOPASS" THEN 3340
3300 ' 
3310 T=T+1:IF T=2 THEN GOSUB 7130:GOSUB 7130:RETURN
3320 A1$=PC$:N=1:GOSUB 7130:C=2:GOSUB 7260
3330 IF B$="" OR B$<>P3$ THEN 3310
3340 IF XPR THEN 3400
3350 ' 
3360 ' Display ENTERCPM
3370 ' 
3380 FIL$="ENTERCPM":NW=1:GOSUB 7810
3390 ' 
3400 IF IHM<>HM THEN MFJ$=MF$:GOSUB 8970                                ' update the USERS file
3410 ' 
3420 GOSUB 6220
3430 ' 
3440 POKE 4,0                                                           ' set up to dump to user 0 
3450 ' 
3460 IF N$=SYS3$ THEN GOSUB 7130:A$="Entering CP/M...":GOSUB 7130
3470 ' 
3480 POKE 0,&HC3                                                        ' change the CALL (CD) at 0 back to a JMP (C3)
3482 '
3485 IF N$=SYS3$ AND WHEEL THEN POKE &H3E,255:PRINT:PRINT "Setting Wheel BYTE "
3488 '
3490 IF EPRG$="NOFILE" THEN 3500 ELSE RUN EPRG$				' Run a file on CP/M entry
3495 '
3500 SYSTEM                                                             ' JUMP (C3) to restore system.
3510 ' 
3520 ' Display BULLETIN file
3530 ' 
3540 FIL$="BULLETIN":NW=1:GOSUB 7810:RETURN
3550 ' 
3560 ' Display INFO file
3570 ' 
3580 FIL$="INFO":NW=1:GOSUB 7810:RETURN
3590 ' 
3600 ' Display MENURBBS file
3610 ' 
3620 IF N$=SYS3$ THEN FIL$="SYOPMENU" ELSE FIL$="MENURBBS"
3625 NW=1:GOSUB 7810:RETURN
3627 '
3628 ' Print a selected file for valid users
3629 '
3630 IF MF$=" " OR MF$="*" THEN 3250
3635 FIL$=DFIL$:NW=1:GOSUB 7810: RETURN
3638 ' 
3640 ' Enter a new message
3650 ' 
3660 IF N$=SYS3$ THEN 3810                                              ' SYSOP can always enter messages
3670 ' 
3680 IF MF$="#" THEN 3810                                               ' SUPER users can always enter messages
3690 ' 
3700 IF LMSG=3 THEN 3780                                                ' no one can enter messages but SUPER users
3710 ' 
3720 IF MF$<>"*" AND LMSG=1 THEN 3810                                   ' let unvalidated users enter messages
3730 ' 
3740 IF MF$="!" AND LMSG=2 THEN 3810                                    ' let validated users enter messages
3750 ' 
3760 ' Tell caller they cannot enter messages
3770 ' 
3780 GOSUB 7130
3790 GOTO 3250
3800 ' 
3810 F=0:GOSUB 7130:V=0
3820 OPEN "R",1,DSK2$+"COUNTERS",5
3830 FIELD #1,5 AS RR$:GET #1,MNUM:V=VAL(RR$)
3840 A$="Msg # will be ":N=1:GOSUB 7130
3850 A$=STR$(V+1):GOSUB 7130:CLOSE
3860 GOSUB 7130
3870 A1$="To (RETURN for ALL): ":N=1:GOSUB 7130
3880 C=1:GOSUB 7260:IF B$="" THEN T$="ALL" ELSE T$=B$
3890 GOSUB 9290:IF NOT OK THEN 3870
3900 GOSUB 9400
3910 A1$="Subject: ":N=1:GOSUB 7130
3920 C=0:GOSUB 7260:IF B$="" THEN 3910 ELSE K$=B$:
3930 IF LEN(K$)>26 THEN PRINT "Too long, 25 character limit":GOTO 3910
3940 PW$="":IF T$="ALL" THEN 3980
3950 A1$="Private? (Y/N) ":GOSUB 9030
3960 IF NOT OK THEN 3980
3970 PW$="*"
3980 IF XPR THEN 4020
3990 GOSUB 7130
4000 A$="Enter up to"+STR$(SIZE)+" lines of text (NO semicolons).":GOSUB 7130
4010 A$="When done, hit two RETURNs.":GOSUB 7130
4020 GOSUB 7130:F=0
4030 IF F=SIZE THEN A$="Message full.":GOSUB 7130:GOTO 4100
4040 F=F+1
4050 A1$=SPACE$(3-LEN(STR$(F)))+STR$(F)+"> ":N=1:GOSUB 7130
4060 GOSUB 7260:IF B$="" THEN F=F-1:IF F=0 THEN 4320 ELSE 4100
4070 IF F=SIZE-2 THEN PRINT "(2 lines left)"
4080 IF F=SIZE-1 THEN PRINT "(Last line)"
4090 A$(F)=B$+" ":GOTO 4030
4100 GOSUB 7130
4110 A1$="Select: (A)bort, (C)ontinue, (E)dit, (H)eader, (L)ist, (S)ave: "
4120 IF XPR THEN A1$="(A,C,E,H,L,S) "
4130 N=1:GOSUB 7130:C=1:GOSUB 7260
4140 IF B$="" THEN 4110
4150 FF=INSTR("HLEACS",B$):IF FF=0 THEN 4110
4160 ON FF GOTO 4360,4200,4530,4320,4030,4660
4170 ' 
4180 ' List message entered
4190 ' 
4200 GOSUB 7080:GOSUB 7130
4210 A$="Date: "+D$:GOSUB 7130
4220 A$="To:   "+TX$:GOSUB 7130
4230 A$="Re:   "+K$:GOSUB 7130
4240 IF PW$="*" THEN A$="    <PRIVATE>":GOSUB 7130
4250 GOSUB 7140
4260 FOR L=1 TO F:A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L)
4270 IF BK THEN 4100 ELSE GOSUB 7130:NEXT L
4280 GOSUB 7130:GOTO 4100
4290 ' 
4300 ' Abort message entry
4310 ' 
4320 GOSUB 7130:A$="Aborted":GOSUB 7130:GOSUB 7130:RETURN
4330 ' 
4340 ' Edit header
4350 ' 
4360 GOSUB 7130:A$="Enter new data or RETURN for no change.":GOSUB 7130
4370 A1$="To:   "+TX$+": ":N=1:GOSUB 7130:C=1:GOSUB 7260
4380 IF B$="" THEN 4410
4390 TSV$=T$:T$=B$:GOSUB 9290:IF NOT OK THEN T$=TSV$:GOTO 4370
4400 GOSUB 9400
4410 A1$="Re:   "+K$+": ":N=1:GOSUB 7130:C=0:GOSUB 7260
4420 IF B$<>"" THEN K$=B$
4430 IF T$="ALL" THEN PW$="":GOTO 4100
4440 IF PW$="*" THEN A$="Yes" ELSE A$="No"
4450 A1$="Private ("+A$+"): ":N=1:GOSUB 7130:C=1:GOSUB 7260
4460 IF B$=" " AND A$="Y" THEN 4100
4470 IF B$=" " AND A$="N" THEN 4100
4480 IF B$="Y" THEN PW$="*":GOTO 4100
4490 B$=" ":GOTO 4100
4500 ' 
4510 ' Edit draft message
4520 ' 
4530 IF XPR THEN 4570
4540 GOSUB 7130
4550 A$="Enter Line Number to change or RETURN to end.":GOSUB 7130
4560 A$="Then enter new line or RETURN for no change.":GOSUB 7130
4570 GOSUB 7130:A1$="Line Number: ":N=1:GOSUB 7130:C=3:GOSUB 7260
4580 L=VAL(B$):IF L=0 OR L>F THEN GOSUB 7130:GOTO 4100
4590 A$=" was:":GOSUB 7130
4600 A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L):GOSUB 7130
4610 A1$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": ":N=1:GOSUB 7130:GOSUB 7260
4620 IF B$="" THEN 4570 ELSE A$(L)=B$+" ":GOTO 4570
4630 ' 
4640 ' Save new message
4650 ' 
4660 IF PW$<>"" THEN PW$=";"+PW$
4670 GOSUB 7130:A$="Saving message...":N=1:GOSUB 7130
4680 OPEN "R",1,DSK2$+"SUMMARY",30
4690 RE=1:FIELD #1,30 AS RR$:RL=30
4700 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 7580:PUT #1,RE
4710 RE=RE+1:S$=D$:GOSUB 7580:PUT #1,RE
4720 RE=RE+1:S$=N$+" "+O$:GOSUB 7580:PUT #1,RE
4730 RE=RE+1:S$=T$:GOSUB 7580:PUT #1,RE
4740 RE=RE+1:S$=K$:GOSUB 7580:PUT #1,RE
4750 RE=RE+1:S$=STR$(F):GOSUB 7580:PUT #1,RE
4760 RE=RE+1:S$=" 9999":GOSUB 7580:PUT #1,RE
4770 CLOSE #1
4780 VV=0
4790 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD #1,5 AS RR$:GET #1,MNUM
4800 LSET RR$=STR$(V+1):PUT #1,MNUM
4810 GET #1,MSGS:VV=VAL(RR$)
4820 LSET RR$=STR$(VV+1):PUT #1,MSGS:CLOSE #1
4830 OPEN "R",1,DSK2$+"MESSAGES",65
4840 RL=65:FIELD #1,65 AS RR$:RE=MX+1
4850 S$=STR$(V+1)+PW$:GOSUB 7580:PUT #1,RE
4860 RE=RE+1:S$=D$:GOSUB 7580:PUT #1,RE
4870 RE=RE+1:S$=N$+" "+O$:GOSUB 7580:PUT #1,RE
4880 RE=RE+1:S$=T$:GOSUB 7580:PUT #1,RE
4890 RE=RE+1:S$=K$:GOSUB 7580:PUT #1,RE
4900 RE=RE+1:S$=STR$(F):GOSUB 7580:PUT #1,RE
4910 RE=RE+1
4920 FOR P=1 TO F:S$=A$(P):GOSUB 7580:PUT #1,RE:RE=RE+1:NEXT P:SS$=" 9999"
4930 GOSUB 7580:PUT #1,RE:CLOSE #1:MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F
4940 GOSUB 7130:GOSUB 7130:U=U+1:RETURN
4950 ' 
4960 ' Read message
4970 ' 
4980 FT=-1:G=0
4990 GOSUB 7130
5000 A2$="Read ":GOSUB 5400
5010 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
5020 IF M<1 THEN GOSUB 7130:RETURN
5030 IF M>U THEN GOSUB 9090:GOTO 4990
5040 OPEN "R",1,DSK2$+"MESSAGES",65
5050 RE=1:FIELD #1,65 AS RR$:MI=0
5060 MI=MI+1:IF (MI>MZ) OR BK THEN 5350 ELSE G=M(MI,1)
5070 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 5060
5080 IF G>M THEN 5300
5090 GOSUB 8040:IF OK OR NOT PERS THEN 5100 ELSE RE=RE+M(MI,2):GOTO 5060
5100 RE=RE+1:GET #1,RE:GOSUB 7630:DM$=S$
5110 RE=RE+1:GET #1,RE:GOSUB 7630:NO$=S$
5120 RE=RE+1:GET #1,RE:GOSUB 7630:T$=S$
5130 RE=RE+1:GET #1,RE:GOSUB 7630:GOSUB 8150:K$=S$
5140 RE=RE+1:GET #1,RE:J=VAL(RR$):GOSUB 7130
5150 IF FT THEN GOSUB 7080:GOSUB 7130:FT=0
5160 A$="Msg #:"+STR$(G):GOSUB 7130
5170 A$="Date: "+DM$:GOSUB 7130
5180 T01$=NO$:T02$="":TX$=NO$
5190 I=INSTR(NO$," "):IF I>0 THEN T01$=LEFT$(NO$,I-1):T02$=MID$(NO$,I+1)
5200 IF T01$<>SYS3$ THEN GOSUB 9410
5210 A$="From: "+TX$:GOSUB 7130
5220 T01$=T$:T02$="":TX$=T$
5230 I=INSTR(T$," "):IF I>0 THEN T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1)
5240 GOSUB 9400
5250 A$="To:   "+TX$:GOSUB 7130
5260 A$="Re:   "+K$:GOSUB 7130:GOSUB 7130
5270 RE=RE+1:FOR P=1 TO J:GET #1,RE:GOSUB 7630:A$=S$:GOSUB 7130
5280 IF BK THEN BK=0:GOTO 5300
5290 RE=RE+1:NEXT P:GOSUB 7130
5300 IF RIGHT$(B$,1)="+" THEN 5330
5310 IF G>HM THEN HM=G
5320 CLOSE:GOTO 4990
5330 M=M+1:MI=0:RE=1
5340 IF M<=U AND NOT BK THEN 5060
5350 IF G>HM THEN HM=G
5360 CLOSE:A$="End of Messages.":GOSUB 7130:GOSUB 7130:DM$="":NO$="":RETURN
5370 ' 
5380 ' Common message number prompt
5390 ' 
5400 A1$="Message Number: ("+STR$(IU)+"-"+STR$(U)+")"
5410 IF NOT XPR THEN A1$=A1$+" to "+A2$+" (RETURN to quit)"
5420 A1$=A1$+" : ":N=1:GOSUB 7130:GOSUB 7260:GOSUB 7130:RETURN
5430 ' 
5440 ' Summarize messages
5450 ' 
5460 GOSUB 7130
5470 A2$="Start at":GOSUB 5400
5480 IF LEN(B$)=0 THEN M=0:GOSUB 7130:RETURN ELSE M=VAL(B$):GOSUB 7210
5490 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 5540
5500 IF LEN(B$)<3 THEN RETURN
5510 IF MID$(B$,2,1)<>"=" THEN RETURN
5520 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
5530 IF ST=0 THEN RETURN
5540 IF M<1 THEN RETURN
5550 IF M>U THEN GOSUB 9090:RETURN
5560 GOSUB 7080:GOSUB 7130
5570 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
5580 GET #1,RE
5590 GOTO 5650
5600 IF PERS THEN A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+":   <PRIVATE>":GOSUB 7130
5610 GOTO 5630
5620 IF (RE+5)/6<M THEN 5630
5630 RE=RE+6
5640 GOTO 5580
5650 IF EOF(1) OR BK THEN 5760 ELSE G=VAL(RR$)
5660 IF G>9998 THEN 5760
5670 IF G=0 THEN 5620
5680 IF G<M THEN 5630
5690 GOSUB 8040:IF OK OR NOT PERS THEN 5700 ELSE 5600
5700 GET #1,RE+ST+1
5710 IF ST=0 THEN 5730
5720 GOSUB 7630:CY$=S$:GOSUB 9210:IF INSTR(CY$,SV$)=0 THEN 5620
5730 GOSUB 5820
5740 IF BK THEN 5760
5750 IF U=G OR BK THEN 5760 ELSE RE=RE+2:GOTO 5580
5760 GOSUB 7130
5770 A$="End of Survey ":GOSUB 7130:GOSUB 7130
5780 CLOSE:RETURN
5790 ' 
5800 ' Display summary of messages
5810 ' 
5820 A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+": "                             ' Msg Number
5830 GET #1,RE+5:GOSUB 7630
5840 A$=A$+SPACE$(3-LEN(STR$(VAL(S$))))+STR$(VAL(S$))+"  "              ' Lines
5850 RE=RE+1:GET #1,RE:GOSUB 7630
5860 A$=A$+S$+"  "                                                      ' Date
5870 RE=RE+1:GET #1,RE:GOSUB 7630                                       ' From
5880 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
5890 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
5900 IF S$<>SYS3$ THEN CX$=S$:GOSUB 9130:S$=CX$
5910 A$=A$+S$+SPACE$(8-LEN(S$))+" to => "
5920 RE=RE+1:GET #1,RE:GOSUB 7630                                       ' To
5930 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
5940 IF S$<>SYS3$ AND S$<>"ALL" THEN CX$=S$:GOSUB 9130:S$=CX$
5950 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
5960 A$=A$+S$+SPACE$(8-LEN(S$))+" "
5970 RE=RE+1:GET #1,RE:GOSUB 7630                                       ' Subject
5980 GOSUB 8150
5990 A$=A$+S$:GOSUB 7130
6000 RETURN
6010 ' 
6020 ' Goodbye
6040 GOSUB 7130:BK=0:GOSUB 6220
6110 A$="   Goodbye...":GOSUB 7130
6120 ' 
6130 ' Update the users file if needed
6140 ' 
6150 IF N$=SYS3$ GOTO 6400                                              ' no need to update for SYSOP
6160 ' 
6170 GOSUB 7130:GOSUB 7130:IF IHM<>HM THEN MFJ$=MF$:GOSUB 8970
6180 GOTO 6400
6190 ' 
6200 ' COMMENTS or feedback for the SYSOP
6210 ' 
6220 IF XPR THEN GOSUB 7130
6230 IF N$=SYS3$ THEN RETURN
6240 A$="Leave comments for SYSOP? (Y/N or <R>eturn to RBBS) :":N=1:GOSUB 7130
6245 C=1:GOSUB 7260:IF B$=" " OR LEFT$(B$,1)="R" THEN 2760
6250 IF LEFT$(B$,1)="N" THEN 6360
6260 RE=2:RL=65:OPEN "R",1,DSK2$+"COMMENTS",65:FIELD #1,65 AS RR$
6270 GET #1,1:RE=VAL(RR$)+1:IF RE=1 THEN RE=2
6280 S$=" ":GOSUB 7580:PUT #1,RE:RE=RE+1
6290 S$="From: "+CN$+" "+CO$+" "+D$:GOSUB 7580:PUT #1,RE
6300 GOSUB 7130:A$="Enter text - type two RETURNs to end.":GOSUB 7130
6310 A1$="> ":N=1:GOSUB 7130:GOSUB 7260
6320 IF B$<>"" THEN RE=RE+1:S$=B$:RL=65:GOSUB 7580:PUT #1,RE:GOTO 6310
6330 GOSUB 7130:A1$="Done? (Y/N) ":GOSUB 9030
6340 IF NOT OK THEN 6310
6350 S$=STR$(RE):RL=65:GOSUB 7580:PUT #1,1:CLOSE
6360 GOSUB 7130:RETURN
6370 A1$="   Goodbye..."
6380 GOSUB 7130:GOSUB 7130
6390 ' 
6400 POKE 0,&HC3
6410 ' 
6420 POKE &H5B,0                                                        ' prevent "RBBS P" until next signin.
6430 ' 
6440 RUN EXIT$
6450 ' 
6460 SYSTEM                                                             ' return back to the operating system.
6470 ' 
6480 ' Kill a message
6490 ' 
6500 GOSUB 7130
6510 A2$="Kill":GOSUB 5400
6520 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
6530 IF M<1 THEN GOSUB 7130:RETURN
6540 IF M>U THEN GOSUB 9090:GOTO 6500
6550 A$="Searching...":N=1:GOSUB 7130
6560 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD #1,30 AS RR$:RL=30
6570 GET #1,RE
6580 IF EOF(1) THEN 6750 ELSE G=VAL(RR$)
6590 IF G>9998 THEN 6750
6600 IF G<M THEN RE=RE+6:GOTO 6570
6610 IF G>M THEN 6750
6620 GOSUB 8040:IF OK OR NOT PERS THEN 6630 ELSE 6750
6630 GET #1,RE:GOSUB 7630:PW=INSTR(S$,";"):PW$=""
6640 IF N$=SYS3$ OR PERS OR OK THEN PERS=0:GOTO 6660
6650 IF PW=0 THEN PRINT "   Protected.":CLOSE #1:PRINT:RETURN 
6660 S$=" 0"+":"+STR$(G):GOSUB 7580:PUT #1,RE:CLOSE
6670 OPEN "R",1,DSK2$+"MESSAGES",65:RE=1:FIELD #1,65 AS RR$:MI=0
6680 MI=MI+1:IF MI>MZ THEN 6750 ELSE G=M(MI,1)
6690 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 6680
6700 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 7580:PUT #1,RE:M(MI,1)=0
6710 CLOSE #1
6720 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD #1,5 AS RR$
6730 GET #1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT #1,MSGS
6740 A$="   Message killed.":GOTO 6760
6750 A$="   Not found."
6760 CLOSE:GOSUB 7130:GOTO 6500
6770 ' 
6780 ' Display USERS file
6790 ' 
6800 GOSUB 7080
6810 OPEN "R",1,DSK3$+"USERS",62:FIELD #1,1 AS MU$,1 AS SU$,60 AS RR$
6820 FIELD #1,10 AS NN$:GET #1,1:NU=VAL(NN$)
6830 GOSUB 7130
6840 FOR J=NU+1 TO 2 STEP -1
6850 GET #1,J:IF SU$=" " AND B$="UALL" THEN 6910                        ' SYSOP sees all with UALL
6860 ' 
6870 IF MU$="*" THEN 7020                                               ' do not show TWITS
6880 ' 
6890 IF MU$=" " AND NOT SHOALL THEN 7020                                ' show UNVALIDATED if SHOALL
6900 ' 
6910 GOSUB 7630:S0$=S$
6920 I=INSTR(S0$,";"): S1$=LEFT$(S0$,I-1):S2$=MID$(S0$,I+1)
6930 I=INSTR(S2$,";"): S3$=MID$(S2$,I+1):S2$=LEFT$(S2$,I-1)
6940 I=INSTR(S3$,";"): S3$=LEFT$(S3$,I-1)
6950 ' 
6960 ' Show location if SHOLOC, but SYSOP always sees location
6970 ' 
6980 IF N$<>SYS3$ AND NOT SHOLOC THEN 7010
6990 A$=S1$+" "+S2$+", "+S3$:GOSUB 7130
7000 IF N$=SYS3$ OR SHOLOC THEN 7020
7010 A$=S1$+" "+S2$:GOSUB 7130
7020 IF BK THEN 7040
7030 NEXT J
7040 CLOSE:GOSUB 7130:RETURN
7050 ' 
7060 ' Print control character info
7070 ' 
7080 GOSUB 7130
7090 A$="CTRL-S to PAUSE, CTRL-K to ABORT":GOSUB 7130
7100 ' 
7110 ' Print string from A$ on console
7120 ' 
7130 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
7140 IF A1$<>"" THEN A$=A1$:A1$=""
7150 IF N=1 THEN PRINT A$;:PP$=A$:GOTO 7200
7160 BI=ASC(INKEY$+" ")
7170 IF BI=&H13 OR BI=&H53 OR BI=&H73 THEN BI=ASC(INPUT$(1)):GOTO 7190
7180 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN BK=-1:GOTO 7210 
7190 PRINT A$
7200 A=A+LEN(A$)
7210 A$="":N=0
7220 RETURN
7230 ' 
7240 ' Accept string into B$ from console
7250 ' 
7260 IF BEL AND SAV$="" THEN PRINT CHR$(7);
7270 B$="":BK=0
7280 IF SAV$="" THEN GOSUB 8250:IF C<>3 THEN PRINT
7290 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 7310
7300 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
7310 IF LEN(B$)=0 THEN C=0:RETURN
7320 IF C=0 THEN 7340
7330 CY$=B$:GOSUB 9210:B$=CY$
7340 D=D+LEN(B$):C=0
7350 RETURN
7360 ' 
7370 ' ON-ERROR handler
7380 ' 
7390 IF ERL=960 THEN RESUME 1000
7400 IF ERL=1080 THEN RESUME 1130
7410 IF ERL=1870 THEN RESUME 1910
7420 IF ERL=2050 THEN RE=0:RESUME 2060
7430 IF ERL=2270 THEN RESUME 2310
7440 IF ERL=2550 THEN RESUME 2700
7450 IF ERL=3820 THEN RESUME 3840
7460 IF ERL=4790 THEN RESUME 4800
7470 IF ERL=4810 THEN RESUME 4820
7480 IF ERL=5040 THEN RESUME 5360
7490 IF ERL=5570 THEN RESUME 5760
7500 IF ERL=6260 THEN RESUME 6290
7510 IF ERL=7810 THEN RESUME 7860
7520 IF ERL=8800 THEN RESUME 8910
7540 RESUME NEXT
7550 ' 
7560 ' Fill and store disk record
7570 ' 
7580 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
7590 RETURN
7600 ' 
7610 ' Unpack disk record
7620 ' 
7630 ZZ=LEN(RR$)-2
7640 WHILE MID$(RR$,ZZ,1)=" "
7650 ZZ=ZZ-1:IF ZZ=1 THEN 7670
7660 WEND
7670 S$=LEFT$(RR$,ZZ)
7680 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
7690 RETURN
7700 ' 
7710 ' Toggle expert mode
7720 ' 
7730 XPR=NOT XPR:RETURN
7740 ' 
7750 ' Toggle bell prompt
7760 ' 
7770 BEL=NOT BEL:RETURN
7780 ' 
7790 ' Subroutine to print a file
7800 ' 
7810 OPEN "I",1,DSK$+FIL$:BK=0:IF EOF(1) THEN 7860
7820 IF NW=0 THEN GOSUB 7080 ELSE NW=0
7830 GOSUB 7130
7840 IF EOF(1) OR BK THEN 7860 ELSE LINE INPUT #1,A$:GOSUB 7130:GOTO 7840
7850 GOSUB 7130
7860 CLOSE #1:GOSUB 7130:RETURN
7870 ' 
7880 ' Print CALLERS file
7890 ' 
7900 GOSUB 7080
7910 GOSUB 7130
7920 OPEN "R",1,DSK3$+"CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
7930 CA=CN
7940 FOR CNT=SIZ+1 TO 2 STEP -1
7950 GET #1,CNT:GOSUB 7630
7960 A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 7130:IF BK THEN 7990
7970 CA=CA-1
7980 NEXT CNT
7990 CLOSE:GOSUB 7130
8000 A$=" End ":GOSUB 7130:GOSUB 7130:RETURN
8010 ' 
8020 ' Test for personal messages
8030 ' 
8040 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")<>0 THEN PERS=-1
8050 IF N$=SYS3$ THEN 8080                                              ' This is the SYSOP let him read anything
8060 GET #1,RE+3:GOSUB 8120:IF OK THEN 8080
8070 GET #1,RE+2:GOSUB 8120
8080 RETURN
8090 ' 
8100 ' Test FROM or TO field for callers name
8110 ' 
8120 GOSUB 7630:I=INSTR(S$," "):S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
8130 IF S1$=N$ AND S2$=O$ THEN OK=-1 ELSE OK=0
8140 RETURN
8150 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
8160 RETURN
8170 ' 
8180 ' Print COMMENTS file for SYSOP
8190 ' 
8200 FIL$="COMMENTS":NW=0:DSK$=DSK2$:GOSUB 7810
8210 DSK$=DSK6$:RETURN
8220 ' 
8230 ' Character-at-a-time line input with editing (IF C=2, NO ECHO)
8240 ' 
8250 CHC=0: SAV$="":DC=0:IC=&H30
8260 NCH=ASC(INPUT$(1))
8270 IF NCH=13 THEN RETURN                                              ' CR
8280 IF NCH=127 THEN 8360
8290 IF NCH<32 THEN 8380
8300 IF CHC>=63 THEN PRINT CHR$(7);:GOTO 8260
8310 SAV$=SAV$+CHR$(NCH): CHC=CHC+1 :IC=IC+1:IF IC=&H3A THEN IC=&H30
8320 IF DC THEN PRINT CHR$(10);
8330 IF C<>2 THEN PRINT CHR$(NCH); ELSE PRINT CHR$(IC);
8340 IF CHC=55 THEN PRINT CHR$(7);
8350 DC=0:GOTO 8260
8360 IF CHC=0 THEN 8260 ELSE PRINT BSL$;:DC=-1
8370 CHC=CHC-1:IC=IC-1: SAV$=LEFT$(SAV$,CHC): GOTO 8260
8380 IF CHC=0 THEN 8260
8390 IF NCH=8 THEN PRINT ERS$;:DC=0:GOTO 8370                           ' BS
8400 IF NCH=12 THEN GOSUB 8460:GOTO 8470                                ' ^L
8410 IF NCH=18 THEN PRINT:PRINT PP$;:GOTO 8470                          ' ^Retype
8420 IF NCH=21 THEN PRINT " #": PRINT PP$;:DC=0:GOTO 8250               ' ^U
8430 IF NCH<>24 THEN 8260                                               ' ^X
8440 GOSUB 8460
8450 GOTO 8250
8460 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: RETURN
8470 IF C<>2 THEN PRINT SAV$;: GOTO 8520
8480 ' 
8490 ' Print numbers to hide password
8500 ' 
8510 IC=&H30:FOR BCC=1 TO CHC: IC=IC+1: PRINT CHR$(IC);: NEXT BCC
8520 DC=0:GOTO 8260
8530 ' 
8540 ' New user password prompt
8550 ' 
8560 GOSUB 7130
8570 A$="Enter at least six alphanumeric characters":GOSUB 7130
8580 A1$="for your PASSWORD:  "
8590 N=1:GOSUB 7130:C=2:GOSUB 7260:S04$=B$:IF S04$="" THEN 8560
8595 IF INSTR(S04$," ")>0 THEN A1$=NSP$:N=1:GOSUB 7130:GOTO 8560
8600 IF LEN(S04$)<6 THEN 8560
8610 A1$="Enter it again:     "
8620 N=1:GOSUB 7130:C=2:GOSUB 7260
8630 IF S04$<>B$ THEN A1$="No match, try again.":GOSUB 7130:GOTO 8560
8640 GOSUB 7130:A$="Please remember it.":GOSUB 7130:GOSUB 7130:RETURN
8650 ' 
8660 ' User password change routine
8670 ' 
8680 GOSUB 7130
8690 IF N$<>SYS3$ THEN 8950
8700 GOSUB 7130
8710 A1$="FIRST Name: ":N=1:GOSUB 7130
8720 C=1:GOSUB 7260:T01$=B$:IF T01$="" THEN GOSUB 7130:GOSUB 7130:RETURN
8730 A1$="LAST Name:  ":N=1:GOSUB 7130
8740 C=1:GOSUB 7260:T02$=B$:IF T02$="" THEN RETURN
8750 OK=0:GOSUB 8800:IF OK THEN GOSUB 9680:GOTO 8700
8760 GOSUB 7130:A$="Not found.":GOSUB 7130:GOTO 8700
8770 ' 
8780 ' Check USERS file
8790 ' 
8800 OPEN "R",1,DSK3$+"USERS",62:FIELD #1,62 AS RR$:GET #1,1:NU=VAL(RR$)
8810 FOR J=2 TO NU+1:GET #1,J:GOSUB 7630:S00$=MID$(S$,3)
8820 I=INSTR(S00$,";"): S01$=LEFT$(S00$,I-1):S02$=MID$(S00$,I+1)
8830 I=INSTR(S02$,";"): S03$=MID$(S02$,I+1):S02$=LEFT$(S02$,I-1)
8840 I=INSTR(S03$,";"): S04$=MID$(S03$,I+1):S03$=LEFT$(S03$,I-1)
8850 I=INSTR(S04$,";"): IF I=0 THEN S05$="0":GOTO 8870
8860 S05$=MID$(S04$,I+1):S04$=LEFT$(S04$,I-1)
8870 HM=VAL(S05$)
8880 IF T01$<>S01$ OR T02$<>S02$ THEN 8900
8890 MFJ$=LEFT$(S$,1):GOSUB 7130:UJ=J:OK=-1:CLOSE:RETURN
8900 NEXT J
8910 CLOSE:RETURN
8920 ' 
8930 ' Update USERS file
8940 ' 
8950 MFJ$=MF$
8960 GOSUB 8560
8970 OPEN "R",1,DSK3$+"USERS",62:FIELD #1,62 AS RR$
8980 S$=MFJ$+" "+S01$+";"+S02$+";"+S03$+";"+S04$+";"+STR$(HM)
8990 RL=62:GOSUB 7580:PUT #1,UJ:CLOSE:RETURN
9000 ' 
9010 ' Prompt for YES or NO answer
9020 ' 
9030 A2$=A1$:OK=0
9040 A1$=A2$:N=1:GOSUB 7130:C=1:GOSUB 7260:ANS$=LEFT$(B$,1)
9050 IF ANS$="" THEN 9040 ELSE IF ANS$="Y" THEN OK=-1:RETURN
9060 IF ANS$="N" THEN RETURN
9070 A$="<Y or N>":GOSUB 7130:GOTO 9030
9080 ' 
9090 A$="Invalid message number.":GOSUB 7130:SAV$="":RETURN
9100 ' 
9110 ' Capitalize string CX$ (FRANK -> Frank)
9120 ' 
9130 FOR ZZ=2 TO LEN(CX$)
9140 ZA=ASC(MID$(CX$,ZZ,1)):IF ZA<&H41 OR ZA>&H5A THEN 9160
9150 MID$(CX$,ZZ,1)=CHR$(ZA+&H20)
9160 NEXT ZZ
9170 RETURN
9180 ' 
9190 ' Uppercase string CY$ (frank -> FRANK)
9200 ' 
9210 FOR ZZ=1 TO LEN(CY$)
9220 ZA=ASC(MID$(CY$,ZZ,1)):IF ZA<&H61 OR ZA>&H7A THEN 9240
9230 MID$(CY$,ZZ,1)=CHR$(ZA-&H20)
9240 NEXT ZZ
9250 RETURN
9260 ' 
9270 ' Check for existing user TO
9280 ' 
9290 T01$=T$:T02$=""
9300 IF T$=SYS3$ OR T$="ALL" THEN OK=-1:RETURN
9310 U01$=S01$:U02$=S02$:U03$=S03$:U04$=S04$:SHM=HM:SUJ=UJ:SMF$=MF$
9320 I=INSTR(T$," "): IF I=0 THEN OK=0:GOTO 9350
9330 T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1):OK=0:GOSUB 8800
9340 S01$=U01$:S02$=U02$:S03$=U03$:S04$=U04$:HM=SHM:UJ=SUJ:MF$=SMF$
9350 IF NOT OK THEN:GOSUB 7130:A1$="Not a known user.":GOSUB 7130:GOSUB 7130:GOTO 2760
9360 RETURN
9370 ' 
9380 ' Capitalize TO for message entry display
9390 ' 
9400 IF T$=SYS3$ OR T$="ALL" THEN TX$=T$:RETURN
9410 CX$=T01$:GOSUB 9130:T01$=CX$:CX$=T02$:GOSUB 9130:T02$=CX$
9420 TX$=T01$+" "+T02$
9430 RETURN
9440 ' 
9450 CX$=N$:GOSUB 9130:CN$=CX$:CX$=O$:GOSUB 9130:CO$=CX$:RETURN
9460 ' 
9470 ' Chat mode
9480 ' 
9490 A$=" ":GOSUB 7130:GOSUB 7130
9500 A$="> "+CN$+" "+CO$+", you have entered the CHAT mode":GOSUB 7130
9510 A1$="Page the SYSOP? (Y/N) ":GOSUB 9030
9520 IF NOT OK THEN RETURN
9530 FOR T1=1 TO 5
9540 PRINT CHR$(7);
9550 FOR T2=1 TO BEEP:NEXT T2
9560 NEXT T1
9570 GOSUB 7130:GOSUB 7130
9580 A$="Type /EX to Exit CHAT":GOSUB 7130
9590 A$="":GOSUB 7130
9600 BELS=BEL:BEL=0                                                     ' no bell during chat, but save origional value
9610 A1$=">":N=1:GOSUB 7130:GOSUB 7260
9620 IF B$="/EX" OR B$="/ex" THEN BEL=BELS:RETURN
9630 GOTO 9610
9640 GOTO 2760                                                          ' go back to beginning just in case
9650 ' 
9660 ' Program area to validate users by SYSOP
9670 ' 
9680 IF N$<>SYS3$ THEN 2760                                             ' DOUBLE CHECK IF SYSOP
9690 A$=S01$+" "+S02$+","+" password -> "+S04$+" -->> ":N=1:GOSUB 7130
9700 IF MFJ$=" " THEN A$="Unvalidated User":GOTO 9750
9710 IF MFJ$="!" THEN A$="Validated User":GOTO 9750
9720 IF MFJ$="#" THEN A$="SUPER User":GOTO 9750
9730 IF MFJ$="*" THEN A$="TWIT Status":GOTO 9750
9740 PRINT "User log error.":RETURN
9750 N=1:GOSUB 7130
9760 A$=" ":GOSUB 7130
9810 IF VAP$="NOPASS" GOTO 9850
9820 GOSUB 7130:A1$="Enter your validation Password -> ":N=1:GOSUB 7130
9830 C=2:GOSUB 7260:IF B$=VAP$ THEN 9850
9840 GOTO 8700                                                          ' go back and try again
9850 GOSUB 7130:A1$="<P>assword, <T>wit, <V>alidate, <U>nvalidate or <S>uper user -> ":N=1:GOSUB 7130
9860 C=1:GOSUB 7260
9865 IF B$="P" THEN 8960
9870 IF B$="T" THEN MFJ$="*":GOTO 9920                                  ' tag this guy as a TWIT
9880 IF B$="V" THEN MFJ$="!":GOTO 9920                                  ' tag as a VALID user
9890 IF B$="S" THEN MFJ$="#":GOTO 9920                                  ' tag him as a SUPER user
9900 IF B$="U" THEN MFJ$=" ":GOTO 9920                                  ' UNVALIDATE user
9910 GOSUB 7130:RETURN
9920 GOSUB 7130:GOTO 8970                                               ' add it to the USERS file
9930 ' 
9940 ' Display NEWS files
9950 ' 
9960 FIL$="NEWS":NW=0:DSK$=DSK5$:GOSUB 7810                             ' Bring up NEWS menu
9970 ' 
9980 IF NNUM=0 THEN DSK$=DSK6$:RETURN                                   ' If no news files then return
9990 ' 
10000 A1$="News file number 1 -"
10010 A1$=A1$+STR$(NNUM)+",  "+STR$(NNUM+1)+" to Exit  --> "
10020 N=1:GOSUB 7130:C=1:GOSUB 7260
10030 IF B$="" THEN 10000
10040 FQ=VAL(B$):IF FQ<1 OR FQ>NNUM THEN DSK$=DSK6$:RETURN
10050 FIL$="NEWS"+MID$(STR$(FQ),2):NW=0:DSK$=DSK5$:GOSUB 7810:GOTO 9960
10060 ' 
10070 ' Display TWIT file
10080 ' 
10090 FIL$="TWIT":NW=1:GOSUB 7810
10100 GOTO 6400				'Dump the TWIT
10110 ' 
10120 ' Display XMODEM.LOG file
10130 ' 
10140 FIL$="XMODEM.LOG":NW=0:GOSUB 7810: RETURN
10150 ' 
10160 ' Display HELP files
10170 ' 
10180 FIL$="HELP":NW=0:DSK$=DSK4$:GOSUB 7810                            ' bring up HELP menu
10190 ' 
10200 IF HNUM=0 THEN DSK$=DSK6$:RETURN                                  ' if no HELP files then return
10210 ' 
10220 A1$="HELP File number 1 -"
10230 A1$=A1$+STR$(HNUM)+",  "+STR$(HNUM+1)+"  to exit -->"
10240 N=1:GOSUB 7130:C=1:GOSUB 7260
10250 IF B$="" THEN 10220
10260 FQ=VAL(B$):IF FQ<1 OR FQ>HNUM THEN DSK$=DSK6$:RETURN
10270 FIL$="HELP"+MID$(STR$(FQ),2):NW=0:DSK$=DSK4$:GOSUB 7810:GOTO 10180
10280 ' 
10290 ' Sub-routine for multi-SYSOP
10300 ' 
10310 IF NOT MSYS THEN O$="":GOTO 10360                                 ' only one SYSOP
10320 ' 
10330 GOSUB 7130:A1$="Which SYSOP are you -> ":N=1:GOSUB 7130
10340 C=1:GOSUB 7260:IF B$="" THEN 10330
10350 O$=B$
10360 CN$=N$:CO$=O$:GOSUB 7730:GOSUB 7770:INC=0:RETURN
10370 ' THE END