10 REM RBBS VERSION 3.1 (Last updated: 09/12/82)
20 REM *****RBBS - "Remote Bulletin Board System"*****
30 REM
40 REM  MODS BY SFK 08/01/82
50 REM  MORE MODS BY FJW 08/15/82
60 REM  STILL MORE MODS BY FJW 09/06/82
70 REM
80 REM FOR MORE REMARKS, SEE ORIGINAL VERSION 2.4, PLUS RBBS-RTN.001,
90 REM PLUS THE DOC FILE FOR THIS VERSION (TO BE WRITTEN)
100 REM
110 REM CUSTOMIZED VERSION FOR THE ARMTE HYBRID COMPUTER FACILITY RBBS
120 REM
130 REM  **********************************************
140 DEFINT A-Z
150 DIM A$(25),M(200,2)
160 REM
170 REM   LOCAL MODS SECTION  (SEE ALSO EXIT ROUTINE)
180 REM
190 VERS1$="ARMTE Hybrid Computer Facility RBBS ...."
200 SYS1$="FRANK":SYS2$="WANCHO" 'SYSOP'S NAME FOR NORMAL SIGNON
210 P1$="CPM":P2$="WANCHO":P3$="NOPASS":PC$="" 'DEFAULT PWDS
220 DSK$="B:":ERS$=CHR$(8)+" "+CHR$(8):BSL$=CHR$(8)+"/"+CHR$(8)
230 REM
240 REM   START OF CODE
250 REM
260 POKE 0,&HCD  ' CHANGE JMP TO CALL AT 0
270 INC=1
280 ON ERROR GOTO 5130
290 RFLG=PEEK(&H5D):POKE &H5D,&H20
300 RTNOKFLG=PEEK(&H5B):POKE &H5B,120 'Legal return flag.
310 REM
320 REM SIGNON FUNCTIONS
330 REM
340 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1:NW=0
350 BK=0:GOSUB 4870:A$=VERS1$:N=1:GOSUB 4870
360 OPEN "I",1,DSK$+"PWDS":IF EOF(1) THEN 380
370 INPUT #1,P1$,P2$,P3$,PC$ : REM DIRECT PW, SYSOP PW, CP/M PW, PROMPT
380 CLOSE #1
390 BEL=-1:XPR=0  'INITIAL BELL ON, NOT EXPERT
400 A$="Version 3.1":N=1:GOSUB 4870:GOSUB 4870:GOSUB 4870:SAV$=""
410 IF RFLG<>ASC("P") THEN 510
420 IF RTNOKFLG<>ASC("x") THEN 510
430 V=0:INC=0 ' SO CALLER NUMBER SAYS SAME
440 OPEN "I",1,DSK$+"LASTCALR":INPUT #1,N$,O$:CLOSE
450 A$="Welcome back, "
460 IF N$<>"SYSOP" THEN 480
470 CN$=N$:O$="":CO$=O$:A$=A$+N$+".":GOSUB 4870:GOSUB 4870:V=1:GOTO 870
480 GOSUB 7130:V=1
490 A$=A$+CN$+" "+CO$+".":GOSUB 4870:GOSUB 4870
500 T01$=N$:T02$=O$:GOSUB 6480:MF$=MFJ$:GOTO 870
510 GOSUB 1740:IF NOT BK THEN NW=1:GOSUB 1700'REM PRINT INFO, THEN BULLETINS
520 GOSUB 4870:BK=0
530 GOSUB 4870
540 A1$="Enter your FIRST Name: ":N=1:GOSUB 4870
550 C=1:GOSUB 5000:N$=B$:IF N$="" THEN 540
560 IF N$=P1$ THEN POKE &H5B,0:GOTO 1660 ' DIRECT CPM EXIT
570 IF N$<"A" OR LEN(N$)=1 THEN 540
580 A1$="Enter your LAST Name:  ":N=1:GOSUB 4870
590 C=1:IF N$="SYSOP" THEN C=2
600 GOSUB 5000:O$=B$:IF O$="" THEN 540
610 IF O$<"A" OR LEN(O$)=1 THEN 540
620 IF N$="SYSOP" AND O$=P2$ THEN O$="":CN$=N$:CO$="":GOTO 820
630 IF N$="SYSOP" THEN 540
640 A$="Checking User file...":GOSUB 4870
650 V=0:T01$=N$:T02$=O$:OK=0:GOSUB 6480:IF OK THEN MF$=MFJ$:GOTO 660 ELSE 700
660 T=0
670 T=T+1:IF T=4 THEN 4260 ELSE A1$="Enter your PASSWORD: "
680 N=1:GOSUB 4870:C=2:GOSUB 5000:UPW$=B$:IF UPW$="" THEN 670
690 IF UPW$=S04$ THEN 820 ELSE 670
700 A1$="Are you a New User? ":GOSUB 6710
710 IF NOT OK THEN A$="OK, let's try again.":GOSUB 4870:GOTO 540
720 V=1:GOSUB 6290 'GET USER TO SET HIS OWN PASSWORD
730 A1$="Enter YOUR City, State: ":N=1:GOSUB 4870
740 C=1:GOSUB 5000:S03$=B$:IF S03$="" THEN 730
750 GOSUB 7130
760 A$="Hello "+CN$+" "+CO$+" from "+S03$:GOSUB 4870
770 A1$="Is anything misspelled? ":GOSUB 6710:IF OK THEN 540
780 HM=0:S05$=STR$(HM):S$="  "+N$+";"+O$+";"+S03$+";"+S04$+";"+S05$
790 OPEN "R",1,DSK$+"USERS",62:FIELD#1,62 AS RR$
800 RL=62:GOSUB 5280:NU=NU+1:PUT#1,NU+1:S$=STR$(NU):GOSUB 5280:PUT#1,1:CLOSE
810 FIL$="NEWCOM":GOSUB 5510:MF$=" "
820 A$="Logging name to disk...":GOSUB 4870:RE=1
830 OPEN "R",1,DSK$+"CALLERS",60:FIELD#1,60 AS RR$:GET#1,1:RE=VAL(RR$)+1
840 S$=STR$(RE):RL=60:GOSUB 5280:PUT#1,1:RE=RE+1
850 S$=N$+" "+O$+" "+S03$:GOSUB 5280:PUT#1,RE:CLOSE#1
860 OPEN "O",1,DSK$+"LASTCALR":PRINT #1,N$;",";O$:CLOSE
870 PRINT
880 IF V=0 THEN IF N$<>"SYSOP" THEN GOSUB 7130
890 REM GOSUB 7140
900 BK=0:GOSUB 4870:CN=1:M=0:U=0
910 OPEN "R",1,DSK$+"COUNTERS",5:FIELD#1,5 AS RR$
920 GET#1,CALLS:CN=VAL(RR$)+INC
930 GET#1,MSGS:M=VAL(RR$)
940 GET#1,MNUM:U=VAL(RR$)
950 A$="You are caller number:      ":N=1:GOSUB 4870
960 A$=STR$(CN):LSET RR$=A$
970 A$=SPACE$(4-LEN(STR$(CN)))+STR$(CN):GOSUB 4870:PUT#1,CALLS:GOSUB 4870
980 A$="Number of Active Messages:  ":N=1:GOSUB 4870
990 A$=SPACE$(4-LEN(STR$(M)))+STR$(M):GOSUB 4870
1000 A$="Last System Message Number: ":N=1:GOSUB 4870
1010 A$=SPACE$(4-LEN(STR$(U)))+STR$(U):GOSUB 4870:CLOSE
1020 IF HM=0 THEN 1050
1030 A$="Your Last Message Number:   ":N=1:GOSUB 4870
1040 A$=SPACE$(4-LEN(STR$(HM)))+STR$(HM):GOSUB 4870
1050 GOSUB 4870:IHM=HM
1060 REM
1070 REM LOOK FOR MSGS FOR THIS CALLER
1080 REM AND BUILD MESSAGE INDEX
1090 REM
1100 FT=-1:MX=0:MZ=0:IU=0:CNT=0:G=0
1110 OPEN "R",1,DSK$+"SUMMARY",30:RE=1:FIELD#1,28 AS RR$
1120 BK=0:GET#1,RE:IF EOF(1) THEN 1260
1130 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 1250 ' G=0 =DELETED
1140 IF IU=0 THEN IU=G
1150 IF G>9998 THEN MZ=MZ-1:GOTO 1260
1160 GET#1,RE+3:GOSUB 5330
1170 I=INSTR(S$," "):IF I=0 THEN S1$=S$:S2$="":GOTO 1190
1180 S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
1190 IF S1$=N$ AND S2$=O$ THEN 1220
1200 IF N$<>"SYSOP" THEN 1250
1210 IF S1$<>SYS1$ AND S2$<>SYS2$ THEN 1250
1220 IF NOT FT THEN 1240
1230 GOSUB 4870:A$=CN$+", you have mail:":GOSUB 4870:GOSUB 4870:FT=0
1240 RX=RE:GOSUB 3770:RE=RX:CNT=CNT+1
1250 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 1120
1260 IF CNT=0 THEN 1300 ELSE GOSUB 4870:A$="Please Retrieve and Kill "
1270 IF CNT=1 THEN A$=A$+"this message."
1280 IF CNT>1 THEN A$=A$+"these messages."
1290 GOSUB 4870:GOSUB 4870
1300 CLOSE
1310 REM
1320 REM *** MAIN COMMAND ACCEPTOR/DISPATCHER ***
1330 REM
1340 A1$="Command: "
1350 IF NOT XPR THEN A1$=A1$+"B,E,R,S,K,G,W,C,U,T,X,P (or ? if not known): "
1360 N=1:GOSUB 4870:C=1:GOSUB 5000
1370 IF B$="" THEN 1340
1380 FF=INSTR("BER?SKGWCUTXP",B$):GOSUB 1390:GOTO 1340
1390 IF FF=0 THEN 1410
1400 ON FF GOTO 1700,1820,3000,1780,3510,4330,3990,1740,1470,4650,5470,5430,6380
1410 IF N$<>"SYSOP" THEN 1440
1420 IF B$="L" THEN GOSUB 5600:RETURN
1430 IF B$="Z" THEN GOSUB 5870:RETURN
1440 GOSUB 4870
1450 A$="I don't understand '"+B$+"', "+CN$+".":GOSUB 4870:GOSUB 4870
1460 SAV$="":RETURN
1470 REM
1480 REM ***EXIT TO CP/M***
1490 REM
1500 GOSUB 4870:T=0
1510 IF N$="SYSOP" THEN 1670
1520 IF MF$<>"*" THEN 1540
1530 A$=">>>ACCESS DENIED<<<":GOSUB 4870:SAV$="":RETURN
1540 IF MF$="!" THEN A$="*** Privileged user ***":GOSUB 4870:GOTO 1650
1550 IF P3$="NOPASS" THEN 1590
1560 T=T+1:IF T=4 THEN A1$="Too many errors.":GOSUB 4870:GOSUB 4870:RETURN
1570 A1$=PC$:N=1:GOSUB 4870:C=2:GOSUB 5000
1580 IF B$="" OR B$<>P3$ THEN 1560
1590 IF XPR THEN 1650
1600 REM
1610 REM ***DISPLAY ENTERCPM***
1620 REM
1630 GOSUB 4870:FIL$="ENTERCPM":NW=1:GOSUB 5510:GOSUB 4870
1640 REM
1650 IF IHM<>HM THEN MFJ$=MF$:GOSUB 6680
1660 GOSUB 4070
1670 POKE 4,0
1680 A$="Entering CP/M...":GOSUB 4870
1690 POKE 0,&HC3:SYSTEM ' RESTORE JMP AT 0
1700 REM
1710 REM ***DISPLAY BULLETINS***
1720 REM
1730 FIL$="BULLETIN":GOSUB 5510:RETURN
1740 REM
1750 REM ***DISPLAY WELCOME MESSAGE***
1760 REM
1770 FIL$="INFO":GOSUB 5510:RETURN
1780 REM
1790 REM *** DISPLAY MENU OF FUNCTIONS ***
1800 REM
1810 FIL$="MENURBBS":GOSUB 5510:GOSUB 4870:RETURN
1820 REM
1830 REM ***ENTER A NEW MESSAGE***
1840 REM
1850 F=0:GOSUB 4870:V=0
1860 OPEN "R",1,DSK$+"COUNTERS",5
1870 FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
1880 A$="Msg # will be ":N=1:GOSUB 4870
1890 A$=STR$(V+1):GOSUB 4870:CLOSE
1900 GOSUB 4870
1910 A1$="Today's date (MM/DD/YY): ":N=1:GOSUB 4870:GOSUB 5000
1920 IF B$="" THEN 1910 ELSE D$=B$
1930 A1$="To (RETURN for ALL): ":N=1:GOSUB 4870
1940 C=1:GOSUB 5000:IF B$="" THEN T$="ALL" ELSE T$=B$
1950 GOSUB 6950:IF NOT OK THEN 1930
1960 GOSUB 7060
1970 A1$="Subject: ":N=1:GOSUB 4870
1980 C=0:GOSUB 5000:IF B$="" THEN 1970 ELSE K$=B$:
1990 A1$="Password ('*' for personal): ":N=1:GOSUB 4870
2000 C=1:GOSUB 5000:PW$=B$
2010 IF T$<>"ALL" OR LEFT$(PW$,1)<>"*" THEN 2030
2020 A$="Cannot use '*' with ALL.":GOSUB 4870:GOTO 1990
2030 IF XPR THEN 2070
2040 GOSUB 4870
2050 A$="Enter up to 24 lines of text (NO semicolons).":GOSUB 4870
2060 A$="When finished, hit two RETURNs in a row.":GOSUB 4870
2070 GOSUB 4870:F=0
2080 IF F=24 THEN A$="Message full.":GOSUB 4870:GOTO 2150
2090 F=F+1
2100 A1$=SPACE$(3-LEN(STR$(F)))+STR$(F)+"> ":N=1:GOSUB 4870
2110 GOSUB 5000:IF B$="" THEN F=F-1:IF F=0 THEN 2370 ELSE 2150
2120 IF F=22 THEN PRINT "(2 lines left)"
2130 IF F=23 THEN PRINT "(Last line)"
2140 A$(F)=B$+" ":GOTO 2080
2150 GOSUB 4870
2160 A1$="Select: (H)eader, (L)ist, (E)dit, (A)bort, (C)ontinue, (S)ave: "
2170 IF XPR THEN A1$="H,L,E,A,C,S: "
2180 N=1:GOSUB 4870:C=1:GOSUB 5000
2190 IF B$="" THEN 2160
2200 FF=INSTR("HLEACS",B$):IF FF=0 THEN 2160
2210 ON FF GOTO 2410,2250,2570,2370,2080,2670
2220 REM
2230 REM LIST MESSAGE ENTERED
2240 REM
2250 GOSUB 4850:GOSUB 4870
2260 A$="Date: "+D$:GOSUB 4870
2270 A$="To:   "+TX$:GOSUB 4870
2280 A$="Re:   "+K$:GOSUB 4870
2290 A$="PW:   "+PW$:GOSUB 4870
2300 GOSUB 4910
2310 FOR L=1 TO F:A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L)
2320 IF BK THEN 2150 ELSE GOSUB 4870:NEXT L
2330 GOSUB 4870:GOTO 2150
2340 REM
2350 REM ABORT MESSAGE ENTRY
2360 REM
2370 GOSUB 4870:A$="Aborted":GOSUB 4870:GOSUB 4870:RETURN
2380 REM
2390 REM EDIT HEADER
2400 REM
2410 GOSUB 4870:A$="Enter replacement or RETURN for no change.":GOSUB 4870
2420 A1$="Date: "+D$+": ":N=1:GOSUB 4870:GOSUB 5000
2430 IF B$<>"" THEN D$=B$
2440 A1$="To:   "+TX$+": ":N=1:GOSUB 4870:C=1:GOSUB 5000
2450 IF B$="" THEN 2480
2460 TSV$=T$:T$=B$:GOSUB 6950:IF NOT OK THEN T$=TSV$:GOTO 2440
2470 GOSUB 7060
2480 A1$="Re:   "+K$+": ":N=1:GOSUB 4870:C=0:GOSUB 5000
2490 IF B$<>"" THEN K$=B$
2500 A1$="PW:   "+PW$+": ":N=1:GOSUB 4870:C=1:GOSUB 5000
2510 IF B$="" THEN 2150
2520 IF T$<>"ALL" OR LEFT$(B$,1)<>"*" THEN PW$=B$:GOTO 2150
2530 A$="Cannot use '*' with ALL.":GOSUB 4870:GOTO 2500
2540 REM
2550 REM EDIT DRAFT MESSAGE
2560 REM
2570 IF XPR THEN 2610
2580 GOSUB 4870
2590 A$="Enter Line Number to change (RETURN or 0 to end).":GOSUB 4870
2600 A$="Then enter replacement or RETURN for no change.":GOSUB 4870
2610 GOSUB 4870:A1$="Line Number: ":N=1:GOSUB 4870:C=3:GOSUB 5000
2620 L=VAL(B$):IF L=0 OR L>F THEN GOSUB 4870:GOTO 2150
2630 A$=" was:":GOSUB 4870
2640 A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L):GOSUB 4870
2650 A1$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": ":N=1:GOSUB 4870:GOSUB 5000
2660 IF B$="" THEN 2610 ELSE A$(L)=B$+" ":GOTO 2610
2670 REM
2680 REM SAVE NEW MESSAGE
2690 REM
2700 IF PW$<>"" THEN PW$=";"+PW$
2710 A$="Updating Summary file, ":N=1:GOSUB 4870
2720 OPEN "R",1,DSK$+"SUMMARY",30
2730 RE=1:FIELD#1,30 AS RR$:RL=30
2740 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 5280:PUT#1,RE
2750 RE=RE+1:S$=D$:GOSUB 5280:PUT#1,RE
2760 RE=RE+1:S$=N$+" "+O$:GOSUB 5280:PUT#1,RE
2770 RE=RE+1:S$=T$:GOSUB 5280:PUT#1,RE
2780 RE=RE+1:S$=K$:GOSUB 5280:PUT#1,RE
2790 RE=RE+1:S$=STR$(F):GOSUB 5280:PUT#1,RE
2800 RE=RE+1:S$=" 9999":GOSUB 5280:PUT#1,RE
2810 CLOSE#1
2820 A$="Next Message #, ":N=1:GOSUB 4870:VV=0
2830 OPEN "R",1,DSK$+"COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MNUM
2840 LSET RR$=STR$(V+1):PUT#1,MNUM
2850 A$="Active Messages, ":N=1:GOSUB 4870
2860 GET#1,MSGS:VV=VAL(RR$)
2870 LSET RR$=STR$(VV+1):PUT#1,MSGS:CLOSE#1
2880 A$="and Message file.":N=1:GOSUB 4870
2890 OPEN "R",1,DSK$+"MESSAGES",65
2900 RL=65:FIELD#1,65 AS RR$:RE=MX+1
2910 S$=STR$(V+1)+PW$:GOSUB 5280:PUT#1,RE
2920 RE=RE+1:S$=D$:GOSUB 5280:PUT#1,RE
2930 RE=RE+1:S$=N$+" "+O$:GOSUB 5280:PUT#1,RE
2940 RE=RE+1:S$=T$:GOSUB 5280:PUT#1,RE
2950 RE=RE+1:S$=K$:GOSUB 5280:PUT#1,RE
2960 RE=RE+1:S$=STR$(F):GOSUB 5280:PUT#1,RE
2970 RE=RE+1
2980 FOR P=1 TO F:S$=A$(P):GOSUB 5280:PUT#1,RE:RE=RE+1:NEXT P:

S$=" 9999":GOSUB 5280:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F
2990 GOSUB 4870:GOSUB 4870:U=U+1:RETURN
3000 REM
3010 REM ***RETRIEVE MESSAGE***
3020 REM
3030 FT=-1:G=0
3040 GOSUB 4870
3050 A2$="Retrieve":GOSUB 3450
3060 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
3070 IF M<1 THEN GOSUB 4870:RETURN
3080 IF M>U THEN GOSUB 6780:GOTO 3040
3090 OPEN "R",1,DSK$+"MESSAGES",65
3100 RE=1:FIELD#1,65 AS RR$:MI=0
3110 MI=MI+1:IF (MI>MZ) OR BK THEN 3400 ELSE G=M(MI,1)
3120 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 3110
3130 IF G>M THEN 3350
3140 GOSUB 5760:IF OK OR NOT PERS THEN 3150 ELSE RE=RE+M(MI,2):GOTO 3110
3150 RE=RE+1:GET#1,RE:GOSUB 5330:D$=S$
3160 RE=RE+1:GET#1,RE:GOSUB 5330:NO$=S$
3170 RE=RE+1:GET#1,RE:GOSUB 5330:T$=S$
3180 RE=RE+1:GET#1,RE:GOSUB 5330:GOSUB 5850:K$=S$
3190 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 4870
3200 IF FT THEN GOSUB 4850:GOSUB 4870:FT=0
3210 A$="Msg #:"+STR$(G):GOSUB 4870
3220 A$="Date: "+D$:GOSUB 4870
3230 T01$=NO$:T02$="":TX$=NO$
3240 I=INSTR(NO$," "):IF I>0 THEN T01$=LEFT$(NO$,I-1):T02$=MID$(NO$,I+1)
3250 IF T01$<>"SYSOP" THEN GOSUB 7100
3260 A$="From: "+TX$:GOSUB 4870
3270 T01$=T$:T02$="":TX$=T$
3280 I=INSTR(T$," "):IF I>0 THEN T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1)
3290 GOSUB 7060
3300 A$="To:   "+TX$:GOSUB 4870
3310 A$="Re:   "+K$:GOSUB 4870:GOSUB 4870
3320 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 5330:A$=S$:GOSUB 4870
3330 IF BK THEN BK=0:GOTO 3350
3340 RE=RE+1:NEXT P:GOSUB 4870
3350 IF RIGHT$(B$,1)="+" THEN 3380
3360 IF G>HM THEN HM=G
3370 CLOSE:GOTO 3040
3380 M=M+1:MI=0:RE=1
3390 IF M<=U AND NOT BK THEN 3110
3400 IF G>HM THEN HM=G
3410 CLOSE:A$="End of Messages.":GOSUB 4870:GOSUB 4870:D$="":NO$="":RETURN
3420 REM
3430 REM COMMON MESSAGE NUMBER PROMPT
3440 REM
3450 A1$="Message Number: ("+STR$(IU)+"-"+STR$(U)+")"
3460 IF NOT XPR THEN A1$=A1$+" to "+A2$+" (RETURN to quit)"
3470 A1$=A1$+" : ":N=1:GOSUB 4870:GOSUB 5000:GOSUB 4870:RETURN
3480 REM
3490 REM ***SUMMARIZE MESSAGES***
3500 REM
3510 GOSUB 4870
3520 A2$="Start":GOSUB 3450
3530 IF LEN(B$)=0 THEN M=0:GOSUB 4870:RETURN ELSE M=VAL(B$):GOSUB 4980
3540 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 3590
3550 IF LEN(B$)<3 THEN RETURN
3560 IF MID$(B$,2,1)<>"=" THEN RETURN
3570 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
3580 IF ST=0 THEN RETURN
3590 IF M<1 THEN RETURN
3600 IF M>U THEN GOSUB 6780:RETURN
3610 GOSUB 4850:GOSUB 4870
3620 OPEN "R",1,DSK$+"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
3630 GET #1,RE
3640 IF EOF(1) OR BK THEN 3740 ELSE G=VAL(RR$)
3650 IF G>9998 THEN 3740
3660 IF G<M THEN RE=RE+6:GOTO 3630
3670 GOSUB 5730:IF OK OR NOT PERS THEN 3680 ELSE RE=RE+6:GOTO 3630
3680 GET #1,RE+ST+1
3690 IF ST=0 THEN 3710
3700 GOSUB 5330:CY$=S$:GOSUB 6870:IF INSTR(CY$,SV$)=0 THEN RE=RE+6:GOTO 3630
3710 GOSUB 3770
3720 IF BK THEN 3740
3730 IF U=G OR BK THEN 3740 ELSE RE=RE+2:GOTO 3630
3740 GOSUB 4870
3750 A$="*** End of Survey ***":GOSUB 4870:GOSUB 4870:GOSUB 4870
3760 CLOSE:RETURN
3770 REM
3780 REM DISPLAY ONE-LINER "FULL" SUMMARY OF MSG G
3790 REM
3800 A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+": " ' Msg Number
3810 GET #1,RE+5:GOSUB 5330
3820 A$=A$+SPACE$(3-LEN(STR$(VAL(S$))))+STR$(VAL(S$))+"  " ' Lines
3830 RE=RE+1:GET #1,RE:GOSUB 5330
3840 A$=A$+S$+"  "  ' Date
3850 RE=RE+1:GET #1,RE:GOSUB 5330 ' From
3860 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
3870 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
3880 IF S$<>"SYSOP" THEN CX$=S$:GOSUB 6790:S$=CX$
3890 A$=A$+S$+SPACE$(8-LEN(S$))+" -> "
3900 RE=RE+1:GET #1,RE:GOSUB 5330 ' To
3910 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
3920 IF S$<>"SYSOP" AND S$<>"ALL" THEN CX$=S$:GOSUB 6790:S$=CX$
3930 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
3940 A$=A$+S$+SPACE$(8-LEN(S$))+" "
3950 RE=RE+1:GET #1,RE:GOSUB 5330 ' Subject
3960 GOSUB 5850
3970 A$=A$+S$:GOSUB 4870
3980 RETURN
3990 REM
4000 REM ***GOODBYE***
4010 REM
4020 BK=0:GOSUB 4070:IF BK THEN 1310
4030 A$=CN$+", thanks for calling...":GOSUB 4870
4040 A$="Please call again!  Bye...":GOSUB 4870
4050 GOSUB 4870:GOSUB 4870:IF IHM<>HM THEN MFJ$=MF$:GOSUB 6680
4060 GOTO 4280
4070 REM
4080 REM COMMENTS FOR SYSOP
4090 REM
4100 IF N$="SYSOP" THEN RETURN
4110 GOSUB 4870
4120 A1$="Enter confidential comments for the SYSOP? ":GOSUB 6710
4130 IF NOT OK THEN 4230
4140 RE=2:RL=65:OPEN "R",1,DSK$+"COMMENTS",65:FIELD#1,65 AS RR$
4150 GET#1,1:RE=VAL(RR$)+1:IF RE=1 THEN RE=2
4160 S$=" ":GOSUB 5280:PUT#1,RE:RE=RE+1
4170 S$="From: "+CN$+" "+CO$:GOSUB 5280:PUT#1,RE
4180 A$="Enter text; type two RETURNs to end.":GOSUB 4870
4190 GOSUB 4870
4200 A1$="> ":N=1:GOSUB 4870:GOSUB 5000
4210 IF B$<>"" THEN RE=RE+1:S$=B$:RL=65:GOSUB 5280:PUT#1,RE:GOTO 4200
4220 S$=STR$(RE):RL=65:GOSUB 5280:PUT#1,1:CLOSE
4230 GOSUB 4870
4240 A$="Character count: "+STR$(A)+" typed by system - "+STR$(D)+" typed by you.":GOSUB 4870
4250 GOSUB 4870:RETURN
4260 A1$="Sorry, too many errors.  Try again another time.  Bye..."
4270 GOSUB 4870:GOSUB 4870
4280 REM
4290 OUT &H82,0 '<--- TURN OFF DTR TO MODEM FOR DISCONNECT.
4300 POKE 0,&HC3  '<--- Restore jump instruction at WBOOT.
4310 POKE &H5B,0 '<--- Prevent "RBBS P" until next signin.
4320 SYSTEM
4330 REM
4340 REM ***KILL A MESSAGE***
4350 REM
4360 GOSUB 4870
4370 A2$="Kill":GOSUB 3450
4380 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
4390 IF M<1 THEN GOSUB 4870:RETURN
4400 IF M>U THEN GOSUB 6780:GOTO 4350
4410 A$="Scanning Summary file...":N=1:GOSUB 4870
4420 OPEN "R",1,DSK$+"SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
4430 GET#1,RE
4440 IF EOF(1) THEN 4630 ELSE G=VAL(RR$)
4450 IF G>9998 THEN 4630
4460 IF G<M THEN RE=RE+6:GOTO 4430
4470 IF G>M THEN 4630
4480 GOSUB 5730:IF OK OR NOT PERS THEN 4490 ELSE 4630
4490 GET#1,RE:GOSUB 5330:PW=INSTR(S$,";"):PW$=""
4500 IF PW=0 OR N$="SYSOP" OR PERS OR OK THEN PERS=0:GOTO 4530
4510 PW$=MID$(S$,PW+1):GOSUB 4870:A1$="Password: ":N=1:GOSUB 4870
4520 C=1:GOSUB 5000:IF B$<>PW$ THEN A$="Incorrect.":GOTO 4640
4530 S$=" 0"+":"+STR$(G):GOSUB 5280:PUT#1,RE:CLOSE
4540 A$="Updating Message file...":N=1:GOSUB 4870
4550 OPEN "R",1,DSK$+"MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
4560 MI=MI+1:IF MI>MZ THEN 4630 ELSE G=M(MI,1)
4570 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 4560
4580 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 5280:PUT#1,RE:M(MI,1)=0
4590 CLOSE#1:A$="Updating Message count...":GOSUB 4870
4600 OPEN "R",1,DSK$+"COUNTERS",5:FIELD#1,5 AS RR$
4610 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS
4620 GOSUB 4870:A$="Message killed.":GOTO 4640
4630 A$="Message not found."
4640 CLOSE:GOSUB 4870:GOTO 4360
4650 REM
4660 REM ***DISPLAY USER FILE***
4670 REM
4680 GOSUB 4850
4690 OPEN "R",1,DSK$+"USERS",62:FIELD#1,1 AS MU$,1 AS SU$,60 AS RR$
4700 FIELD#1,10 AS NN$:GET#1,1:NU=VAL(NN$)
4710 GOSUB 4870
4720 FOR J=NU+1 TO 2 STEP -1
4730 GET#1,J:IF SU$="*" THEN 4790
4740 GOSUB 5330:S0$=S$
4750 I=INSTR(S0$,";"): S1$=LEFT$(S0$,I-1):S2$=MID$(S0$,I+1)
4760 I=INSTR(S2$,";"): S3$=MID$(S2$,I+1):S2$=LEFT$(S2$,I-1)
4770 I=INSTR(S3$,";"): S3$=LEFT$(S3$,I-1)
4780 A$=S1$+" "+S2$+", "+S3$:GOSUB 4870
4790 IF BK THEN 4810
4800 NEXT J
4810 CLOSE:GOSUB 4870:RETURN
4820 REM
4830 REM **** PRINT CONTROL-CHAR INFO
4840 REM
4850 GOSUB 4870
4860 A$="Use CTL-S or S to PAUSE, CTL-K or K to ABORT."
4870 REM
4880 REM ***PRINT STRING FROM A$ ON CONSOLE***
4890 REM
4900 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
4910 IF A1$<>"" THEN A$=A1$:A1$=""
4920 IF N=1 THEN PRINT A$;:PP$=A$:GOTO 4970
4930 BI=ASC(INKEY$+" ")
4940 IF BI=&H13 OR BI=&H53 OR BI=&H73 THEN BI=ASC(INPUT$(1)):GOTO 4960
4950 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN BK=-1:GOTO 4980 
4960 PRINT A$
4970 A=A+LEN(A$)
4980 A$="":N=0
4990 RETURN
5000 REM
5010 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
5020 REM
5030 IF BEL AND SAV$="" THEN PRINT CHR$(7);
5040 B$="":BK=0
5050 IF SAV$="" THEN GOSUB 5980:IF C<>3 THEN PRINT
5060 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 5080
5070 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
5080 IF LEN(B$)=0 THEN C=0:RETURN
5090 IF C=0 THEN 5110
5100 CY$=B$:GOSUB 6870:B$=CY$
5110 D=D+LEN(B$):C=0
5120 RETURN
5130 REM
5140 REM ***ON ERROR HANDLER***
5150 IF ERL=360 THEN RESUME 380
5160 IF ERL=830 THEN RE=0:RESUME 840
5170 IF ERL=910 THEN RESUME 950
5180 IF ERL=1110 THEN RESUME 1260
5190 IF ERL=1860 THEN RESUME 1880
5200 IF ERL=2830 THEN RESUME 2840
5210 IF ERL=2860 THEN RESUME 2870
5220 IF ERL=3090 THEN RESUME 3400
5230 IF ERL=3620 THEN RESUME 3740
5240 IF ERL=4140 THEN RESUME 4170
5250 IF ERL=5540 THEN RESUME 5590
5260 IF ERL=6480 THEN RESUME 6620
5270 RESUME NEXT
5280 REM
5290 REM FILL AND STORE DISK RECORD
5300 REM
5310 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
5320 RETURN
5330 REM
5340 REM UNPACK DISK RECORD
5350 REM
5360 ZZ=LEN(RR$)-2
5370 WHILE MID$(RR$,ZZ,1)=" "
5380 ZZ=ZZ-1:IF ZZ=1 THEN 5400
5390 WEND
5400 S$=LEFT$(RR$,ZZ)
5410 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
5420 RETURN
5430 REM
5440 REM *** TOGGLE EXPERT USER MODE
5450 REM
5460 XPR=NOT XPR:RETURN
5470 REM
5480 REM *** TOGGLE BELL PROMPT
5490 REM
5500 BEL=NOT BEL:RETURN
5510 REM
5520 REM SUBROUTINE TO PRINT A FILE
5530 REM
5540 OPEN "I",1,DSK$+FIL$:BK=0:IF EOF(1) THEN 5590
5550 IF NW=0 THEN GOSUB 4850 ELSE NW=0
5560 GOSUB 4870
5570 IF EOF(1) OR BK THEN 5590 ELSE LINE INPUT #1,A$:GOSUB 4870:GOTO 5570
5580 GOSUB 4870
5590 CLOSE #1:RETURN
5600 REM
5610 REM PRINT "CALLERS" FILE...FOR SYSOP ONLY (PRIVATE L CMD)
5620 REM
5630 GOSUB 4870
5640 OPEN "R",1,DSK$+"CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
5650 CA=CN
5660 FOR CNT=SIZ+1 TO 2 STEP -1
5670 GET #1,CNT:GOSUB 5330
5680 A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 4870:IF BK THEN 5710
5690 CA=CA-1
5700 NEXT CNT
5710 CLOSE:GOSUB 4870
5720 A$="*** End of CALLERS ***":GOSUB 4870:GOSUB 4870:RETURN
5730 REM
5740 REM TEST FOR PERSONAL MESSAGES
5750 REM
5760 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")<>0 THEN PERS=-1
5770 IF N$="SYSOP" THEN 5800
5780 GET #1,RE+3:GOSUB 5820:IF OK THEN 5800
5790 GET #1,RE+2:GOSUB 5820
5800 RETURN
5810 REM TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME
5820 GOSUB 5330:I=INSTR(S$," "):S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
5830 IF S1$=N$ AND S2$=O$ THEN OK=-1 ELSE OK=0
5840 RETURN
5850 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
5860 RETURN
5870 REM
5880 REM PRINT COMMENTS FILE FOR SYSOP (Z COMMAND)
5890 REM
5900 GOSUB 4870:OPEN "R",1,DSK$+"COMMENTS",65:RE=1:FIELD#1,65 AS RR$
5910 GET#1,RE:RE=RE+1:IF EOF(1) THEN 5930
5920 GOSUB 5330:A$=S$:GOSUB 4870:GOTO 5910
5930 CLOSE:GOSUB 4870:IF RE=2 THEN RETURN
5940 A$="*** End of COMMENTS ***":GOSUB 4870:GOSUB 4870
5950 IF RE>3 THEN 5960 ELSE RETURN
5960 A1$="Delete COMMENTS file? ":GOSUB 6710:IF OK THEN KILL DSK$+"COMMENTS"
5970 RETURN
5980 REM
5990 REM CHARACTER-AT-A-TIME LINE INPUT WITH EDITING (IF C=2, NO ECHO)
6000 REM
6010 CHC=0: SAV$="":DC=0:IC=&H30
6020 NCH=ASC(INPUT$(1))
6030 IF NCH=13 THEN RETURN 'CR
6040 IF NCH=127 THEN 6120
6050 IF NCH<32 THEN 6140
6060 IF CHC>=63 THEN PRINT CHR$(7);:GOTO 6020
6070 SAV$=SAV$+CHR$(NCH): CHC=CHC+1 :IC=IC+1:IF IC=&H3A THEN IC=&H30
6080 IF DC THEN PRINT CHR$(10);
6090 IF C<>2 THEN PRINT CHR$(NCH); ELSE PRINT CHR$(IC);
6100 IF CHC=55 THEN PRINT CHR$(7);
6110 DC=0:GOTO 6020
6120 IF CHC=0 THEN 6020 ELSE PRINT BSL$;:DC=-1
6130 CHC=CHC-1:IC=IC-1: SAV$=LEFT$(SAV$,CHC): GOTO 6020
6140 IF CHC=0 THEN 6020
6150 IF NCH=8 THEN PRINT ERS$;:DC=0:GOTO 6130 'BS
6160 IF NCH=12 THEN GOSUB 6220:GOTO 6230 '^L
6170 IF NCH=18 THEN PRINT:PRINT PP$;:GOTO 6230 '^Retype
6180 IF NCH=21 THEN PRINT " #": PRINT PP$;:DC=0:GOTO 6010 '^U
6190 IF NCH<>24 THEN 6020 '^X
6200 GOSUB 6220
6210 GOTO 6010
6220 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: RETURN
6230 IF C<>2 THEN PRINT SAV$;: GOTO 6250
6240 IC=&H30:FOR BCC=1 TO CHC: IC=IC+1: PRINT CHR$(IC);: NEXT BCC
6250 DC=0:GOTO 6020
6260 REM
6270 REM NEW USER PASSWORD PROMPT
6280 REM
6290 GOSUB 4870
6300 A$="Enter at least six alphanumeric characters":GOSUB 4870
6310 A1$="for your PASSWORD:  "
6320 N=1:GOSUB 4870:C=2:GOSUB 5000:S04$=B$:IF S04$="" THEN 6290
6330 IF LEN(S04$)<6 THEN 6290
6340 A1$="Now enter it again: "
6350 N=1:GOSUB 4870:C=2:GOSUB 5000
6360 IF S04$<>B$ THEN A1$="No match.  Try again.":GOSUB 4870:GOTO 6290
6370 A$="OK, now please remember it.":GOSUB 4870:GOSUB 4870:RETURN
6380 REM
6390 REM USER PASSWORD CHANGE ROUTINE
6400 REM
6410 IF N$<>"SYSOP" THEN 6630
6420 A1$="User's FIRST Name: ":N=1:GOSUB 4870
6430 C=1:GOSUB 5000:T01$=B$:IF T01$="" THEN RETURN
6440 A1$="User's LAST Name:  ":N=1:GOSUB 4870
6450 C=1:GOSUB 5000:T02$=B$:IF T02$="" THEN RETURN
6460 OK=0:GOSUB 6480:IF OK THEN GOSUB 6670:GOTO 6420
6470 A$="Not found.":GOSUB 4870:GOTO 6420
6480 REM
6490 REM CHECK USERS FILE
6500 REM
6510 OPEN "R",1,DSK$+"USERS",62:FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
6520 FOR J=2 TO NU+1:GET#1,J:GOSUB 5330:S00$=MID$(S$,3)
6530 I=INSTR(S00$,";"): S01$=LEFT$(S00$,I-1):S02$=MID$(S00$,I+1)
6540 I=INSTR(S02$,";"): S03$=MID$(S02$,I+1):S02$=LEFT$(S02$,I-1)
6550 I=INSTR(S03$,";"): S04$=MID$(S03$,I+1):S03$=LEFT$(S03$,I-1)
6560 I=INSTR(S04$,";"): IF I=0 THEN S05$="0":GOTO 6580
6570 S05$=MID$(S04$,I+1):S04$=LEFT$(S04$,I-1)
6580 HM=VAL(S05$)
6590 IF T01$<>S01$ OR T02$<>S02$ THEN 6610
6600 MFJ$=LEFT$(S$,1):GOSUB 4870:UJ=J:OK=-1:CLOSE:RETURN
6610 NEXT J
6620 CLOSE:RETURN
6630 REM
6640 REM UPDATE USERS FILE
6650 REM
6660 MFJ$=MF$
6670 GOSUB 6260
6680 OPEN "R",1,DSK$+"USERS",62:FIELD#1,62 AS RR$
6690 S$=MFJ$+" "+S01$+";"+S02$+";"+S03$+";"+S04$+";"+STR$(HM)
6700 RL=62:GOSUB 5280:PUT#1,UJ:CLOSE:RETURN
6710 REM
6720 REM PROMPT FOR YES OR NO ANSWER
6730 REM
6740 A2$=A1$:OK=0
6750 A1$=A2$:N=1:GOSUB 4870:C=1:GOSUB 5000:ANS$=LEFT$(B$,1)
6760 IF ANS$="" THEN 6750 ELSE IF ANS$="Y" THEN OK=-1:RETURN
6770 IF ANS$<>"N" THEN 6710 ELSE RETURN
6780 A$="That's an invalid message number, "+CN$+".":GOSUB 4870:SAV$="":RETURN
6790 REM
6800 REM CAPITALIZE STRING CX$ (e.g., FRANK -> Frank)
6810 REM
6820 FOR ZZ=2 TO LEN(CX$)
6830 ZA=ASC(MID$(CX$,ZZ,1)):IF ZA<&H41 OR ZA>&H5A THEN 6850
6840 MID$(CX$,ZZ,1)=CHR$(ZA+&H20)
6850 NEXT ZZ
6860 RETURN
6870 REM
6880 REM UPPERCASE STRING CY$ (e.g., frank -> FRANK)
6890 REM
6900 FOR ZZ=1 TO LEN(CY$)
6910 ZA=ASC(MID$(CY$,ZZ,1)):IF ZA<&H61 OR ZA>&H7A THEN 6930
6920 MID$(CY$,ZZ,1)=CHR$(ZA-&H20)
6930 NEXT ZZ
6940 RETURN
6950 REM
6960 REM CHECK FOR EXISTING USER (FOR "TO:")
6970 REM
6980 T01$=T$:T02$=""
6990 IF T$="SYSOP" OR T$="ALL" THEN OK=-1:RETURN
7000 U01$=S01$:U02$=S02$:U03$=S03$:U04$=S04$:SHM=HM:SUJ=UJ:SMF$=MF$
7010 I=INSTR(T$," "): IF I=0 THEN OK=0:GOTO 7040
7020 T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1):OK=0:GOSUB 6480
7030 S01$=U01$:S02$=U02$:S03$=U03$:S04$=U04$:HM=SHM:UJ=SUJ:MF$=SMF$
7040 IF NOT OK THEN A1$="Not a currently known User.  OK? ":GOSUB 6710
7050 RETURN
7060 REM
7070 REM CAPITALIZE "TO:" FOR MESSAGE ENTRY DISPLAY
7080 REM
7090 IF T$="SYSOP" OR T$="ALL" THEN TX$=T$:RETURN
7100 CX$=T01$:GOSUB 6790:T01$=CX$:CX$=T02$:GOSUB 6790:T02$=CX$
7110 TX$=T01$+" "+T02$
7120 RETURN
7130 CX$=N$:GOSUB 6790:CN$=CX$:CX$=O$:GOSUB 6790:CO$=CX$:RETURN
7140 REM K=1:FOR J=&H40 TO &H43:POKE J,ASC(MID$(O$,K,1)):K=K+1:NEXT J:RETURN