10 REM RBBS VERSION 2.5
20 REM *****RBBS - "Remote Bulletin Board System"*****
21 REM by Bruce R. Ratoff
22 REM adapted from Xitan Basic SJBBS by Howard Moulton
29 REM 
30 REM 08/18/81
31 REM Changed time/date logic to look at in-memory time
32 REM and date maintained by my interrupt-driven time/date
33 REM routines.  Commented out Bill E.'s code.  (Bruce Ratoff)
39 REM
40 REM more changes by Bill Earnest, 3/24/81
41 REM   NOTE CHGS AT 510-520,580,590,720,                
42 REM   3650-3670,4600-4730,6000-. MY BYE INCLUDES THE @ ON
43 REM   FIRST ENTRY SO USER NEEDNT REMEMBER "P". SYS. CLOCK
44 REM   IS CALLED AROUND 4600 & LEAVES DATA IN 0F400H++. CALL
45 REM   @ 580 AREA FORCES USER 0 FOR THOSE CARELESS FOLKS
46 REM   THAT SAY RIBBS FROM ANYWHERE. LINE INPUT PROCESSING @
47 REM   6000++ INCLUDES THE NEAR-LINE-END BELL. I USED SOME
48 REM   PIECES FROM RBBS24 ALSO. THE LINE INPUT ISNT TOO VERY
49 REM   SLOW EVEN UNDER MBASIC, BUT COMPILED IS BETTER.        
50 REM      Note that the program contains 2 calls to external
51 REM      routines which are special to Bill Earnest's
52 REM      system, at
53 REM		580-590 and
54 REM		4610-4730 (to call in a clock)
55 REM	    These calls will cause the program to crash unless
56 REM      you implement similar routines and thus have been
57 REM      disabled with REM statements.  Remove the REMs if
58 REM      if you have a use for them.  Note too that several
59 REM	    of the RBBS2.4 routines are omitted in this version;
60 REM      you may want to replace them.  And note that Bill
61 REM      has figured how to use the clock to put times into
62 REM      the CALLERS file!   --Ben Bronson
65 REM changes of 12/10/80 by Bruce Ratoff
66 REM    FIXED BUG THAT PREVENTED "NEWCOM" FROM PRINTING
70 REM    MADE "LASTCALR" A $SYS FILE
80 REM    IMPROVED CONTROL-K RESPONSE (STILL NOT PERFECT BUT BETTER)
90 REM changes of 11/14/80 by Ron Fowler
100 REM    ADDED PERSONAL MESSAGE FUNCTION
110 REM    K FUNCTION STORES NAME OF ERASING USER IN MSG# RECORD
120 REM changes of 11/9/80  by Ron Fowler
130 REM  1: PRINT CALLERS FOR SYSOP
140 REM  2: SAVE KILLED MSG #S, PUT PWD'S IN MSG FILE
150 REM  3: RE-ENTRY OPTION, FILE "LASTCALR"
160 REM 10/21/80 --> Fix several minor bugs in P and S cmds.  (BRR)
170 REM Changes 10/15/80 by Ron Fowler:
180 REM    1) added "Q", quick summary command
190 REM    2) added "X", "P" cmds - expert user mode, and bell toggle
200 REM    3) rearranged message entry for CBBS compatibility
210 REM    4) added ";" delimitation - "command anticipation"
220 REM    5) added password file access at 3 levels:
230 REM       a. p1$ is high-level quick-access to cp/m
240 REM       b. p2$ is sysop 'last name' (sysop has special priveliges)
250 REM       c. p3$ is the normal cpm access password:
260 REM          (IF P3$ IS "NOPASS", THEN CPM ACCESS IS UNRESTRICTED)
270 REM    6) coded several sequences as subroutines, to shorten code
280 REM    7) made several cosmetic changes
290 REM note: the file "PWDS" can be created by a text editor.  The
300 REM       passwords are sequential..e.g.,"GOTOCPM,FOWLER,NOPASS"
310 REM *** put the shortest version of your first name in line 920
320 REM
330 REM
500 DEFINT A-Z
510 REM [disabled] FOR I=8 TO 15: READ J: POKE I,J: NEXT I
520 REM [disabled] DATA 14,0,17,0,0,&HC3,5,0
530 VERS$="vers 2.5"' VERSION NUMBER
540 DIM A$(17),M(400,2)
550 POKE 0,&HCD
560 INC=1: ERS$=CHR$(8)+" "+CHR$(8)
570 ON ERROR GOTO 4810
580 RFLG=PEEK(&H5D):POKE &H5D,32
590 REM [disabled:] POKE 9,32: POKE 11,0: CALL BDCAL
600 REM
610 REM SIGNON FUNCTIONS
620 REM
630 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
640 P2$="xxxxxx":P3$="NOPASS" 'DEFAULT PWDS
650 BK=0:GOSUB 4200:N=1:A$="Cranford, NJ RIBBS...":GOSUB 4200:N=0
660 OPEN "I",1,"A:PWDS":IF EOF(1) THEN 680
670 INPUT #1,P1$,P2$,P3$
680 CLOSE #1
690 BEL=-1:XPR=0'INITIAL BEL ON, NOT EXPERT
700 A$=VERS$:GOSUB 4200:GOSUB 4200
710 SAV$=""
720 IF RFLG<>ASC("P") THEN 770
730 INC=0
740 OPEN "I",1,"A:LASTCALR":IF EOF(1) THEN 790
750 INPUT #1,N$,O$,TON:CLOSE
760 A$="Welcome back, "+N$+" "+O$+".":GOSUB 4200:GOSUB 4200:GOTO 990
770 GOSUB 1840:GOSUB 1740'REM PRINT INFO, THEN BULLETINS
780 BK=0:A$="(Prompting bell means system is ready for input).":GOSUB 4200:GOSUB 4200
790 A$="What is your FIRST name ?":GOSUB 4200:C=1:GOSUB 4400:C=0:N$=B$:

    IF N$="" THEN 790
800 IF N$=P1$ THEN 1620 ' DIRECT CPM EXIT
805 IF LEFT$(N$,1)=" " OR RIGHT$(N$,1)=" " THEN 790
810 IF N$<"A" OR LEN(N$)=1 THEN 790
820 A1$="What is your LAST name ?":GOSUB 4200:C=1:GOSUB 4400:C=0:O$=B$:

    IF O$="" THEN 790
830 IF O$<"A" OR LEN(O$)=1 THEN 790
835 IF LEFT$(O$,1)=" " OR RIGHT$(O$,1)=" " THEN 790
840 IF N$="SYSOP" AND O$=P2$ THEN O$="":GOTO 940
850 IF N$="SYSOP" THEN 790
860 A$="Checking user file...":GOSUB 4200:V=0:OPEN "R",1,"A:USERS",62:

    FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
870 FOR I=2 TO NU+1:GET#1,I:

    IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN MF$=LEFT$(RR$,1):CLOSE:

       GOSUB 4200:GOTO 940
880 NEXT I
890 V=1:A1$="Where (City,State) are you calling from ?":GOSUB 4200:

    C=1:GOSUB 4400:C=0:ST$=B$:IF ST$="" THEN 820
900 A$="Hello "+N$+" "+O$+" from "+ST$:GOSUB 4200:

    A1$="Did I misspell anything ?":GOSUB 4200:C=1:GOSUB 4400:C=0:

    IF LEFT$(B$,1)="Y" THEN 790
910 A1$="This checking is only done the first time you call.":GOSUB 4200
920 S$="  "+N$+" "+O$+" "+ST$:RL=62:GOSUB 5000:NU=NU+1:PUT#1,NU+1:

    S$=STR$(NU):GOSUB 5000:PUT#1,1:CLOSE
930 FIL$="NEWCOM":GOSUB 5400:MF$=" "
940 A$="Logging "+N$+" "+O$+" to disk...":N=1:GOSUB 4200:

    OPEN "R",1,"A:CALLERS",60:FIELD#1,60 AS RR$:GET#1,1
950 RE=VAL(RR$)+1:S$=STR$(RE):RL=60:GOSUB 5000:PUT#1,1:RE=RE+1
960 GOSUB 4610
970 S$=N$+" "+O$+" "+ST$+" "+D$+" "+DT$:GOSUB 5000:PUT#1,RE:CLOSE#1
980 OPEN "O",1,"A:LASTCALR. "+CHR$(&HA0):PRINT #1,N$;",";O$;",";TON:CLOSE
990 BK=0:GOSUB 4200:A$="Active # of msg's ":N=1:GOSUB 4200:

    OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MSGS:M=VAL(RR$)
1000 A$=STR$(M)+".":GOSUB 4200
1010 A$="You are caller # ":N=1:GOSUB 4200:GET#1,CALLS
1020 CN=VAL(RR$)+INC:A$=STR$(CN):LSET RR$=A$:GOSUB 4200:PUT#1,CALLS
1030 A$="Next msg # will be ":N=1:GOSUB 4200:GET#1,MNUM:U=VAL(RR$)
1040 A$=STR$(U+1):GOSUB 4200:CLOSE:GOSUB 4200
1100 REM
1110 REM LOOK FOR MSGS FOR THIS CALLER
1120 REM AND BUILD MESSAGE INDEX
1130 REM
1140 FT=1:MX=0:MZ=0:IU=0:'FLAG FIRST TIME FOR PRINTING HEADING
1150 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,28 AS RR$
1160 BK=0:GET#1,RE:IF EOF(1) THEN 1260
1170 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 1250
1180 IF IU=0 THEN IU=G
1190 IF G>9998 THEN MZ=MZ-1:GOTO 1260
1200 GET#1,RE+3:GOSUB 5100:IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 1230
1210 IF N$<>"SYSOP" THEN 1250
1220 IF INSTR(S$,"BRUCE")=0 THEN 1250
1230 IF FT THEN A$="Please retrieve and kill the following message(s) left for you:":GOSUB 4200:FT=0
1240 A$=STR$(G):N=1:GOSUB 4200
1250 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 1160
1260 CLOSE:GOSUB 4200:GOSUB 4200
1300 REM
1310 REM *** MAIN COMMAND ACCEPTOR/DISPATCHER ***
1320 REM
1330 A1$="Function":IF NOT XPR THEN A1$=A1$+" (B,E,R,S,K,G,W,C,U,P,X,Q (or '?' if not known)"
1340 A1$=A1$+"?":GOSUB 4200:C=1:GOSUB 4400:C=0
1350 IF B$="" THEN 1300
1360 FF=INSTR("BER?SKGWCUPXQL",B$):GOSUB 1370:GOTO 1300
1370 IF FF=0 THEN 1390
1380 ON FF GOTO 1700,2100,2800,1900,5500,3700,3500,1800,1500,4000,

     5300,5200,5600,5700
1390 IF N$+O$="SYSOP" THEN IF B$="%" THEN GOSUB 5700:GOTO 1300
1400 A$="I don't understand '"+B$+"', "+N$+".":GOSUB 4200:GOSUB 4200:

     SAV$="":RETURN
1500 REM
1510 REM ***EXIT TO CP/M***
1520 REM
1530 IF MF$="*" THEN A$="You've lost that privelege, "+N$:GOSUB 4200:

     SAV$="":RETURN
1540 IF P3$="NOPASS" THEN 1570
1550 A1$="Password ?":GOSUB 4200:C=1:GOSUB 4400:C=0
1560 IF B$<>P3$ THEN A$="+++INVALID+++":GOSUB 4200:GOSUB 4200:RETURN
1570 IF XPR THEN 1620
1580 A$="Please remember to type BYE before hanging up the phone.":GOSUB 4200:GOSUB 4200
1590 A$="To re-enter RIBBS, type:":GOSUB 4200:A$="A>USER 3":GOSUB 4200:

   A$="A>RIBBS P":GOSUB 4200:GOSUB 4200
1600 A$="For info on software exchange, type:":GOSUB 4200:

     A$="A>TYPE THIS-SYS.DOC":GOSUB 4200:GOSUB 4200
1610 A$="For general info, type:":GOSUB 4200:

     A$="A>HELP":GOSUB 4200:GOSUB 4200
1620 GOSUB 4200:POKE 4,0:A$="Entering CP/M...":GOSUB 4200:POKE 0,&HC3:SYSTEM
1700 REM
1710 REM ***DISPLAY BULLETINS***
1720 REM
1730 GOSUB 4130
1740 FIL$="A:BULLETIN":GOSUB 5400:RETURN
1800 REM
1810 REM ***DISPLAY WELCOME MESSAGE***
1820 REM
1830 GOSUB 4130
1840 FIL$="A:INFO":GOSUB 5400:RETURN
1900 REM
1910 REM *** DISPLAY MENU OF FUNCTIONS ***
1920 REM
1930 GOSUB 4200:A$="Functions supported:":GOSUB 4200:IF BK THEN RETURN
1940 A$="S--> Scan messages     R--> Retrieve message":GOSUB 4200:

     IF BK THEN RETURN
1950 A$="E--> Enter message     K--> Kill message":GOSUB 4200:IF BK THEN RETURN
1960 A$="B--> retype Bulletins  W--> retype welcome":GOSUB 4200:IF BK THEN RETURN
1970 A$="C--> exit to CP/M      U--> list User file":GOSUB 4200:IF BK THEN RETURN
1980 A$="P--> Prompt (bel) togl X--> eXpert user mode":GOSUB 4200:IF BK THEN RETURN
1990 A$="Q--> Quick summary     G--> Goodbye (signoff)":GOSUB 4200:IF BK THEN RETURN
2000 GOSUB 4200:A$="Commands may be strung together, separated by semicolons.":

     GOSUB 4200:A$="For example, 'R;123' retrieves message # 123.":GOSUB 4200:

     IF BK THEN RETURN
2010 GOSUB 4200:A$="Software exchange is done under CP/M using":GOSUB 4200:

     A$="the XMODEM program (for intelligent transfer)":GOSUB 4200:

     A$="or the TYPE command (simple ASCII listing).":GOSUB 4200
2020 IF BK THEN RETURN
2030 GOSUB 4200:RETURN
2100 REM
2110 REM ***ENTER A NEW MESSAGE***
2120 REM
2130 F=0:GOSUB 4200:OPEN "R",1,"A:COUNTERS",5:A$="Msg # will be ":N=1:

     GOSUB 4200:FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
2140 A$=STR$(V+1):GOSUB 4200:CLOSE
2150 GOSUB 4610
2160 GOSUB 4200: A1$="Today's date is "+D$: GOSUB 4200
2170 A1$="Who to (C/R for ALL)?":GOSUB 4200:C=1:GOSUB 4400:C=0:IF B$="" THEN T$="ALL" ELSE T$=B$
2180 A1$="Subject?(26 char in summary)":GOSUB 4200:C=1:GOSUB 4400:C=0:K$=B$
2190 IF LEN(K$)>30 THEN GOTO 2180
2200 A1$="Password?":GOSUB 4200:C=1:GOSUB 4400:C=0:PW$=B$
2210 A1$="To enter msg,type in lines. (Bell @ end-8)":GOSUB 4200
2220 A1$="To edit,hit only C/R.       (16 lines max)":GOSUB 4200
2230 A1$="No semicolons,please.":GOSUB 4200:GOSUB 4200:F=0
2240 IF F=16 THEN A$="Msg full.":GOSUB 4200:GOTO 2300
2250 F=F+1:A1$=STR$(F)+" ":N=1:GOSUB 4200:GOSUB 4400:IF B$="" THEN F=F-1:GOTO 2300
2260 IF F=12 THEN PRINT "(4 lines left)"
2270 IF F=14 THEN PRINT "(2 lines left)"
2280 IF F=15 THEN PRINT "(last line)"
2290 A$(F)=B$+" ":GOTO 2240
2300 GOSUB 4200:A1$="(L)ist, (E)dit, (Q)uit, (C)ontinue, (S)ave; Select?":

     IF XPR THEN A1$="L,E,Q,C,S?"
2310 GOSUB 4200:C=1:GOSUB 4400:C=0
2320 IF B$<>"L" THEN 2360 ELSE GOSUB 4130
2330 GOSUB 4200:FOR L=1 TO F:A$=STR$(L)+" "+A$(L)
2340 IF BK THEN 2300 ELSE GOSUB 4200:NEXT L
2350 GOSUB 4200:GOTO 2300
2360 IF B$="Q" THEN A$="Aborted":GOSUB 4200:RETURN
2370 IF B$="C" THEN 2240
2380 IF B$="E" THEN 2410
2390 IF B$="S" THEN 2460
2400 GOTO 2300
2410 GOSUB 4200:A1$="Line #?":GOSUB 4200:GOSUB 4400:L=VAL(B$):PP$=""
2420 IF L=0 OR L>F THEN 2300 ELSE A$="Was:":GOSUB 4200:A$=A$(L):GOSUB 4200
2430 A1$="Enter new line":IF NOT XPR THEN A1$=A1$+" (C/R for no change)"
2440 A1$=A1$+":":GOSUB 4200:GOSUB 4400
2450 IF B$="" THEN 2300 ELSE A$(L)=B$+" ":GOTO 2300
2460 REM
2470 IF PW$<>"" THEN PW$=";"+PW$
2480 A$="Updating summary file, ":N=1:GOSUB 4200
2490 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
2500 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 5000:PUT#1,RE
2510 RE=RE+1:S$=D$:GOSUB 5000:PUT#1,RE
2520 RE=RE+1:S$=N$+" "+O$:GOSUB 5000:PUT#1,RE
2530 RE=RE+1:S$=T$:GOSUB 5000:PUT#1,RE
2540 RE=RE+1:S$=K$:GOSUB 5000:PUT#1,RE
2550 RE=RE+1:S$=STR$(F):GOSUB 5000:PUT#1,RE
2560 RE=RE+1:S$=" 9999":GOSUB 5000:PUT#1,RE
2570 CLOSE#1
2580 A$="next msg #, ":N=1:GOSUB 4200:

     OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$
2590 GET#1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MNUM
2600 A$="active msg's, ":N=1:GOSUB 4200
2610 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MSGS:CLOSE#1
2620 A$="and msg file.":N=1:GOSUB 4200:OPEN "R",1,"A:MESSAGES",65:RL=65
2630 FIELD#1,65 AS RR$
2640 RE=MX+1
2650 S$=STR$(V+1)+PW$:GOSUB 5000:PUT#1,RE
2660 RE=RE+1:S$=D$:GOSUB 5000:PUT#1,RE
2670 RE=RE+1:S$=N$+" "+O$:GOSUB 5000:PUT#1,RE
2680 RE=RE+1:S$=T$:GOSUB 5000:PUT#1,RE
2690 RE=RE+1:S$=K$:GOSUB 5000:PUT#1,RE
2700 RE=RE+1:S$=STR$(F):GOSUB 5000:PUT#1,RE
2710 RE=RE+1
2720 FOR P=1 TO F:S$=A$(P):GOSUB 5000:PUT#1,RE:RE=RE+1:NEXT P:

     S$=" 9999":GOSUB 5000:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:

     M(MZ,1)=V+1:M(MZ,2)=F
2730 GOSUB 4200:GOSUB 4200:U=U+1:RETURN
2800 REM
2810 REM ***RETRIEVE MESSAGE***
2820 REM
2830 GOSUB 4200:A1$="MSG # ("+STR$(IU)+" -"+STR$(U)+" )":

     IF NOT XPR THEN A1$=A1$+" to retrieve (c/r to end)"
2840 A1$=A1$+"?":GOSUB 4200:GOSUB 4400:GOSUB 4200
2850 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
2860 IF M<1 THEN GOSUB 4200:RETURN
2870 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 4200:SAV$="":GOTO 2830
2880 GOSUB 4130:GOSUB 4200
2890 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
2900 MI=MI+1:IF (MI>MZ) OR BK THEN 3070 ELSE G=M(MI,1)
2910 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 2900
2920 IF G>M THEN 3040
2930 GOSUB 5800:IF OK THEN 2940 ELSE RE=RE+M(MI,2):GOTO 2900
2940 RE=RE+1:GET#1,RE:GOSUB 5100:D$=S$
2950 RE=RE+1:GET#1,RE:GOSUB 5100:NO$=S$
2960 RE=RE+1:GET#1,RE:GOSUB 5100:T$=S$
2970 RE=RE+1:GET#1,RE:GOSUB 5100:GOSUB 5930:K$=S$
2980 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 4200
2990 A$="Msg #"+STR$(G)+" was entered on date "+D$+" from "+NO$:GOSUB 4200
3000 A$="To "+T$+" about "+K$:GOSUB 4200:GOSUB 4200
3010 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 5100:A$=S$:GOSUB 4200
3020 IF BK THEN 3070
3030 RE=RE+1:NEXT P:GOSUB 4200
3040 IF RIGHT$(B$,1)<>"+" THEN CLOSE:GOTO 2810
3050 M=M+1:MI=0:RE=1
3060 IF M<=U AND NOT BK THEN 2900
3070 CLOSE:A$="End of msg's.":GOSUB 4200:GOSUB 4200:D$="":NO$="":RETURN
3100 REM
3110 REM ***SUMMARIZE MESSAGES***
3120 REM COMMON CODE FOR S AND Q CMDS
3130 REM
3140 GOSUB 4200:

      A1$="Msg # ("+STR$(IU)+" -"+STR$(U)+" ) to start (C/R to end)?":

      GOSUB 4200:C=1:GOSUB 4400:C=0:GOSUB 4200
3150 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$):GOSUB 4300
3160 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 3210
3170 IF LEN(B$)<3 THEN RETURN
3180 IF MID$(B$,2,1)<>"=" THEN RETURN
3190 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
3200 IF ST=0 THEN RETURN
3210 IF M<1 THEN RETURN
3220 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 4200:SAV$="":RETURN
3230 IF NOT QU THEN GOSUB 4130:GOSUB 4200
3240 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD #1,28 AS RR$
3250 GET #1,RE
3260 IF EOF(1) OR BK THEN 3430 ELSE G=VAL(RR$)
3270 IF G>9998 THEN 3430
3280 IF G<M THEN RE=RE+6:GOTO 3250
3290 GOSUB 5800:IF OK THEN 3300 ELSE RE=RE+6:GOTO 3250
3300 GET #1,RE+ST+1:IF ST=0 THEN 3310 ELSE GOSUB 5100:IF INSTR(S$,SV$)=0 THEN RE=RE+6:GOTO 3250
3310 IF NOT QU THEN 3350
3320 REM quick summary
3330 GET #1,RE+4:GOSUB 5100:GOSUB 5930:

      A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+" "+S$:GOSUB 4200
3340 IF U=G OR BK THEN 3430 ELSE RE=RE+6:GOTO 3250
3350 REM full summary
3360 A$="Msg #"+STR$(G)+"    Date entered: ":N=1:GOSUB 4200:IF BK THEN 3430
3370 RE=RE+1:GET #1,RE:GOSUB 5100:A$=S$+"   From: ":N=1:GOSUB 4200:IF BK THEN 3430
3380 RE=RE+1:GET #1,RE:GOSUB 5100:A$=S$:GOSUB 4200:IF BK THEN 3430
3390 A$="To: ":N=1:GOSUB 4200:RE=RE+1:GET #1,RE:GOSUB 5100:A$=S$:GOSUB 4200:IF BK THEN 3430
3400 A$="About: ":N=1:GOSUB 4200:RE=RE+1:GET #1,RE:

      GOSUB 5100:GOSUB 5930:A$=S$:GOSUB 4200:IF BK THEN 3430
3410 A$="Size: ":N=1:GOSUB 4200:RE=RE+1:GET #1,RE:GOSUB 5100:A$=S$:GOSUB 4200:IF BK THEN 3430
3420 GOSUB 4200:IF U=G OR BK THEN 3430 ELSE RE=RE+1:GOTO 3250
3430 GOSUB 4200:A$="***** End of summary *****":GOSUB 4200:GOSUB 4200:GOSUB 4200:CLOSE:RETURN
3500 REM
3510 REM ***GOODBYE***
3520 REM
3530 GOSUB 4200:A1$="Want to leave any comments?":GOSUB 4200:C=1:GOSUB 4400:C=0
3540 IF LEFT$(B$,1)="N" THEN 3640
3550 IF LEFT$(B$,1)<>"Y" THEN 3530
3560 OPEN "R",1,"A:COMMENTS",65:FIELD#1,65 AS RR$:GET#1,1:RE=VAL(RR$)+1:RL=65
3570 IF RE=1 THEN RE=2
3580 S$="From: "+N$+" "+O$:GOSUB 5000
3590 PUT#1,RE
3600 A$="Enter comments; to end, hit C/R.":GOSUB 4200
3610 A$="Ok>":N=1:GOSUB 4200:GOSUB 4400
3620 IF B$="" THEN 3630 ELSE RE=RE+1:S$=B$:RL=65:GOSUB 5000:PUT#1,RE:GOTO 3610
3630 S$=STR$(RE):RL=65:GOSUB 5000:PUT#1,1:CLOSE
3640 GOSUB 4200:

     A$="Character count:  "+STR$(A)+" typed by system - "+STR$(D)+

     " typed by you.":GOSUB 4200:

     A$="From Bruce: thanks for calling, "+N$+".":GOSUB 4200
3650 GOSUB 4680: TAC=CURT-TON
3660 IF TAC < 0 THEN TAC=TAC+1440
3670 A$="I enjoyed your call the past"+STR$(TAC)+" minutes.":GOSUB 4200
3680 A$="***** End of connection ******":GOSUB 4200:GOSUB 4200:SYSTEM
3700 REM
3710 REM ***KILL A MESSAGE***
3720 REM
3730 GOSUB 4200:A1$="Message # to kill?":GOSUB 4200:GOSUB 4400
3740 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
3750 IF M<1 THEN GOSUB 4200:RETURN
3760 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 4200:SAV$="":GOTO 3720
3770 A$="Scanning summary file...":GOSUB 4200:

     OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
3780 GET#1,RE
3790 IF EOF(1) THEN 3960 ELSE G=VAL(RR$)
3800 IF G>9998 THEN 3960
3810 IF G<M THEN RE=RE+6:GOTO 3780
3820 IF G>M THEN 3960
3830 GOSUB 5800:IF NOT OK THEN 3960
3840 GOSUB 5100:PW=INSTR(S$,";"):PW$=""
3850 IF PW=0 OR N$+O$="SYSOP" OR PERS THEN PERS=0:GOTO 3870
3860 PW$=MID$(S$,PW+1):A1$="Password ?":GOSUB 4200:C=1:GOSUB 4400:C=0:

      IF B$<>PW$ THEN A$="Incorrect.":GOSUB 4200:GOSUB 4200:CLOSE:RETURN
3870 S$=" 0"+":"+STR$(G):GOSUB 5000:PUT#1,RE:CLOSE
3880 A$="Updating message file...":GOSUB 4200
3890 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
3900 MI=MI+1:IF MI>MZ THEN 3960 ELSE G=M(MI,1)
3910 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 3900
3920 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 5000:PUT#1,RE:M(MI,1)=0
3930 CLOSE#1:A$="Updating message count...":GOSUB 4200
3940 OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:

     GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS:CLOSE
3950 GOSUB 4200:A$="Message killed.":GOSUB 4200:GOSUB 4200:RETURN
3960 CLOSE:A$="Message not found.":GOSUB 4200:GOSUB 4200:RETURN
4000 REM
4010 REM ***DISPLAY USER FILE***
4020 REM
4030 GOSUB 4130:OPEN "R",1,"A:USERS",62:FIELD#1,1 AS MU$,1 AS SU$,60 AS RR$:

      FIELD#1,10 AS NN$:GET#1,1:NU=VAL(NN$)
4040 FOR I=NU+1 TO 2 STEP -1:

      GET#1,I:IF SU$<>"*" THEN GOSUB 5100:A$=S$:GOSUB 4200
4050 IF BK THEN 4070
4060 NEXT I
4070 CLOSE:GOSUB 4200:RETURN
4100 REM
4110 REM **** PRINT CONTROL-CHAR INFO
4120 REM
4130 GOSUB 4200
4140 A$="Use ctl-K to abort, ctl-S to pause."
4200 REM
4210 REM ***PRINT STRING FROM A$ ON CONSOLE***
4220 REM
4230 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
4240 IF A1$<>"" THEN A$=A1$:A1$=""
4250 IF RIGHT$(A$,1)="?" OR N=1 THEN PRINT A$;:PP$=A$:GOTO 4280
4260 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
4270 IF BI=11 THEN BK=-1:GOTO 4300 ELSE PRINT A$
4280 A=A+LEN(A$)
4290 IF N$+O$="SYSOP" AND INP(255)=1 THEN LPRINT A$;:

         IF N=0 AND RIGHT$(A$,1)<>"?" THEN LPRINT
4300 A$="":N=0
4310 RETURN
4400 REM
4410 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
4420 REM
4430 IF BEL AND SAV$="" THEN PRINT CHR$(7);
4440 B$="":BK=0
4450 IF SAV$="" THEN GOSUB 6000
4460 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 4480
4470 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
4480 IF LEN(B$)=0 THEN RETURN
4490 IF C=0 THEN 4510
4500 FOR ZZ=1 TO LEN(B$):MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):NEXT ZZ
4510 IF LEN(B$)<64 THEN 4560
4520 A$="Input line too long - would be truncated to:":GOSUB 4200
4530 B$=LEFT$(B$,63):PRINT B$
4540 LINE INPUT "Retype line (Y/N)?";QQ$:QQ$=LEFT$(QQ$,1)
4550 IF QQ$="Y" OR QQ$="y" THEN PRINT PP$;:SAV$="":GOTO 4400
4560 D=D+LEN(B$):RETURN
4570 RETURN
4600 REM
4610 REM READ ENTER REAL TIME CLOCK/CALENDER
4620 REM
4630 GOSUB 4710: TON=CURT
4640 DM$=HEX$(PEEK(&H52)):DD$=HEX$(PEEK(&H53))
4650 DY$="81":D$=DM$+"/"+DD$+"/"+DY$
4660 DH$=HEX$(PEEK(&H50)):DM$=HEX$(PEEK(&H51))
4670 DT$=DH$+":"+DM$: RETURN
4680 REM READ CLOCK NOW
4690 REM CLOCK=&HEDE3
4700 REM CALL CLOCK
4710 REM GET LAST CLOCK VALUE
4720 CURT = VAL(HEX$(PEEK(&H50)))*60+VAL(HEX$(PEEK(&H51)))
4730 RETURN
4800 REM ***ON ERROR HANDLER***
4810 IF ERL=660 THEN RESUME 680
4820 IF ERL=5430 THEN RESUME 5450
4830 IF ERL=940 THEN RE=0:RESUME 950
4840 IF ERL=990 THEN M=0:RESUME 1000
4850 IF ERL=1010 THEN C=0:RESUME 1020
4860 IF ERL=1030 THEN U=0:RESUME 1040
4870 IF ERL=2130 THEN V=0:RESUME 2140
4880 IF ERL=2580 THEN C=0:RESUME 2590
4890 IF ERL=2600 THEN C=0:RESUME 2610
4900 RESUME NEXT
5000 REM
5010 REM FILL AND STORE DISK RECORD
5020 REM
5030 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
5040 RETURN
5100 REM
5110 REM UNPACK DISK RECORD
5120 REM
5130 ZZ=LEN(RR$)-2
5140 WHILE MID$(RR$,ZZ,1)=" "
5150 ZZ=ZZ-1:IF ZZ=1 THEN 5170
5160 WEND
5170 S$=LEFT$(RR$,ZZ)
5180 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
5190 RETURN
5200 REM
5210 REM *** TOGGLE EXPERT USER MODE
5220 REM
5230 XPR=NOT XPR:RETURN
5300 REM
5310 REM *** TOGGLE BELL PROMPT
5320 REM
5330 BEL=NOT BEL:RETURN
5400 REM
5410 REM SUBROUTINE TO PRINT A FILE
5420 REM
5430 OPEN "I",1,FIL$:BK=0
5440 IF EOF(1) OR BK THEN 5450 ELSE LINE INPUT #1,A$:GOSUB 4200:GOTO 5440
5450 CLOSE #1:RETURN
5500 REM FULL SUMMARY
5510 QU=0:GOSUB 3100:RETURN
5600 REM QUICK SUMMARY
5610 QU=-1:GOSUB 3100:RETURN
5700 REM PRINT "CALLERS" FILE...FOR SYSOP ONLY (PRIVATE CMD)
5710 GOSUB 4200
5720 IF N$+O$<>"SYSOP" THEN 1400' IF NOT SYSOP, SAY "I DON'T UNDERSTAND".
5730 OPEN "R",1,"A:CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
5740 CA=CN
5750 FOR CNT=SIZ+1 TO 2 STEP -1
5760 GET #1,CNT:GOSUB 5100:A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 4200:IF BK THEN 5790
5770 CA=CA-1
5780 NEXT CNT
5790 CLOSE:A$= "END OF CALLERS.":GOSUB 4200:GOSUB 4200:RETURN
5800 REM TEST FOR PERSONAL MESSAGES
5810 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")=0 THEN 5860
5820 PERS=-1
5830 IF N$+O$="SYSOP" THEN 5860
5840 GET #1,RE+3:GOSUB 5900:IF OK THEN 5860
5850 GET #1,RE+2:GOSUB 5900
5860 RETURN
5900 REM TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME
5910 IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN OK=-1 ELSE OK=0
5920 RETURN
5930 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
5940 RETURN
6000 CHC=0: SAV$=""
6010 NCH=ASC(INPUT$(1))
6020 IF NCH=127 THEN 6080
6030 IF NCH<32 THEN 6110
6040 IF CHC>=63 THEN 6010
6050 SAV$=SAV$+CHR$(NCH): CHC=CHC+1: PRINT CHR$(NCH);
6060 IF CHC=55 THEN PRINT CHR$(7);
6070 GOTO 6010
6080 IF CHC=0 THEN 6010 ELSE PRINT RIGHT$(SAV$,1);: GOTO 6100
6090 IF CHC=0 THEN 6010 ELSE PRINT ERS$;
6100 CHC=CHC-1: SAV$=LEFT$(SAV$,CHC): GOTO 6010
6110 IF NCH=8 THEN 6090
6120 IF NCH=13 THEN PRINT: RETURN
6130 IF NCH=21 THEN PRINT " #": GOTO 6000
6140 IF NCH<>24 OR CHC=0 THEN 6010
6150 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: GOTO 6000