10 REM RBBS VERSION 2.2
20 REM *****RBBS - "Remote Bulletin Board System"*****
30 REM by Bruce R. Ratoff
40 REM adapted from Xitan Basic SJBBS by Howard Moulton
45 REM changes of 12/10/80 by Bruce Ratoff
46 REM    FIXED BUG THAT PREVENTED "NEWCOM" FROM PRINTING
47 REM    MADE "LASTCALR" A $SYS FILE
48 REM    IMPROVED CONTROL-K RESPONSE (STILL NOT PERFECT BUT BETTER)
50 REM changes of 11/14/80 by Ron Fowler
60 REM    ADDED PERSONAL MESSAGE FUNCTION
70 REM    K FUNCTION STORES NAME OF ERASING USER IN MSG# RECORD
80 REM changes of 11/9/80  by Ron Fowler
90 REM  1: PRINT CALLERS FOR SYSOP
100 REM  2: SAVE KILLED MSG #S, PUT PWD'S IN MSG FILE
110 REM  3: RE-ENTRY OPTION, FILE "LASTCALR"
120 REM 10/21/80 --> Fix several minor bugs in P and S cmds.  (BRR)
130 REM Changes 10/15/80 by Ron Fowler:
140 REM    1) added "Q", quick summary command
150 REM    2) added "X", "P" cmds - expert user mode, and bell toggle
160 REM    3) rearranged message entry for CBBS compatibility
170 REM    4) added ";" delimitation - "command anticipation"
180 REM    5) added password file access at 3 levels:
190 REM       a. p1$ is high-level quick-access to cp/m
200 REM       b. p2$ is sysop 'last name' (sysop has special priveliges)
210 REM       c. p3$ is the normal cpm access password:
220 REM          (IF P3$ IS "NOPASS", THEN CPM ACCESS IS UNRESTRICTED)
230 REM    6) coded several sequences as subroutines, to shorten code
240 REM    7) made several cosmetic changes
250 REM note: the file "PWDS" can be created by a text editor.  The
260 REM       passwords are sequential..e.g.,"GOTOCPM,FOWLER,NOPASS"
270 REM *** put the shortest version of your first name in line 920
280 REM
290 REM
300 DEFINT A-Z
310 VERS$="vers 2.2"' VERSION NUMBER
320 DIM A$(17),M(200,2)
330 POKE 0,&HCD
340 INC=1
350 ON ERROR GOTO 13620
360 RFLG=PEEK(&H5D):POKE &H5D,32
370 REM
380 REM SIGNON FUNCTIONS
390 REM
400 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
410 P2$="RON":P3$="SLAGBACK 'DEFAULT PWDS
420 BK=0:GOSUB 13020:N=1:A$="Westland, Mich. RBBS...":GOSUB 13020:N=0
430 OPEN "I",1,"A:PWDS":IF EOF(1) THEN 450
440 INPUT #1,P1$,P2$,P3$
450 CLOSE #1
460 BEL=-1:XPR=0'INITIAL BEL ON, NOT EXPERT
470 A$=VERS$:GOSUB 13020:GOSUB 13020
480 SAV$=""
490 IF RFLG<>ASC("P") THEN 530
500 INC=0
510 OPEN "I",1,"LASTCALR":INPUT #1,N$,O$:CLOSE
520 A$="Welcome back, "+N$+" "+O$+".":GOSUB 13020:GOSUB 13020:GOTO 740
530 GOSUB 4080:GOSUB 3080'REM PRINT INFO, THEN BULLETINS
540 BK=0:A$="(Prompting bell means system is ready for input).":GOSUB 13020:GOSUB 13020
550 A$="What is your FIRST name ?":GOSUB 13020:C=1:GOSUB 13260:C=0:N$=B$:
   IF N$="" THEN 550
560 IF N$=P1$ THEN 2240 ' DIRECT CPM EXIT
570 IF N$<"A" OR LEN(N$)=1 THEN 550
580 A1$="What is your LAST name ?":GOSUB 13020:C=1:GOSUB 13260:C=0:O$=B$:
   IF O$="" THEN 550
590 IF O$<"A" OR LEN(O$)=1 THEN 550
600 IF N$="SYSOP" AND O$=P2$ THEN O$="":GOTO 700
610 IF N$="SYSOP" THEN 550
620 A$="Checking user file...":GOSUB 13020:V=0:OPEN "R",1,"A:USERS",62:
   FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
630 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 13020:GOTO 700
640 NEXT I
650 V=1:A1$="Where (City,State) are you calling from ?":GOSUB 13020:
   C=1:GOSUB 13260:C=0:ST$=B$:IF ST$="" THEN 580
660 A$="Hello "+N$+" "+O$+" from "+ST$:GOSUB 13020:
   A1$="Did I misspell anything ?":GOSUB 13020:C=1:GOSUB 13260:C=0:
   IF LEFT$(B$,1)="Y" THEN 550
670 A1$="This checking is only done the first time you call.":GOSUB 13020
680 S$="  "+N$+" "+O$+" "+ST$:RL=62:GOSUB 16000:NU=NU+1:PUT#1,NU+1:
   S$=STR$(NU):GOSUB 16000:PUT#1,1:CLOSE
690 FIL$="NEWCOM":GOSUB 18000:MF$=" "
700 A$="Logging "+N$+" "+O$+" to disk...":N=1:GOSUB 13020:
   OPEN "R",1,"A:CALLERS",60:    FIELD#1,60 AS RR$:GET#1,1
710 RE=VAL(RR$)+1:S$=STR$(RE):RL=60:GOSUB 16000:PUT#1,1:RE=RE+1
720 S$=N$+" "+O$+" "+ST$:GOSUB 16000:PUT#1,RE:CLOSE#1
730 OPEN "O",1,"LASTCALR. "+CHR$(&HA0):PRINT #1,N$;",";O$:CLOSE
740 BK=0:GOSUB 13020:A$="Active # of msg's ":N=1:GOSUB 13020:
   OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MSGS:M=VAL(RR$)
750 A$=STR$(M)+".":GOSUB 13020
760 A$="You are caller # ":N=1:GOSUB 13020:GET#1,CALLS
770 CN=VAL(RR$)+INC:A$=STR$(CN):LSET RR$=A$:GOSUB 13020:PUT#1,CALLS
780 A$="Next msg # will be ":N=1:GOSUB 13020:GET#1,MNUM:U=VAL(RR$)
790 A$=STR$(U+1):GOSUB 13020:CLOSE:GOSUB 13020
800 REM
810 REM LOOK FOR MSGS FOR THIS CALLER
820 REM AND BUILD MESSAGE INDEX
830 REM
840 FT=1:MX=0:MZ=0:IU=0:'FLAG FIRST TIME FOR PRINTING HEADING
850 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,28 AS RR$
860 BK=0:GET#1,RE:IF EOF(1) THEN 960
870 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 950
880 IF IU=0 THEN IU=G
890 IF G>9998 THEN MZ=MZ-1:GOTO 960
900 GET#1,RE+3:GOSUB 16500:IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 930
910 IF N$<>"SYSOP" THEN 950
920 IF INSTR(S$,"RON")=0 THEN 950
930 IF FT THEN A$="Please retrieve and kill the following message(s) left for you:":GOSUB 13020:FT=0
940 A$=STR$(G):N=1:GOSUB 13020
950 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 860
960 CLOSE:GOSUB 13020:GOSUB 13020
1000 REM
1020 REM *** MAIN COMMAND ACCEPTOR/DISPATCHER ***
1040 REM
1060 A1$="Function":IF NOT XPR THEN A1$=A1$+" (B,E,R,S,K,G,W,C,U,P,X,Q (or '?' if not known)"
1080 A1$=A1$+"?":GOSUB 13020:C=1:GOSUB 13260:C=0
1100 IF B$="" THEN 1000
1120 FF=INSTR("BER?SKGWCUPXQL",B$):GOSUB 1140:GOTO 1000
1140 IF FF=0 THEN 1180
1160 ON FF GOTO 3000,6000,8000,5000,18060,11000,10000,4000,2000,12000,
    17040,17000,18080,19000
1180 IF N$+O$="SYSOP" THEN IF B$="%" THEN GOSUB 19000:GOTO 1000
1200 A$="I don't understand '"+B$+"', "+N$+".":GOSUB 13020:GOSUB 13020:
    SAV$="":RETURN
2000 REM
2020 REM ***EXIT TO CP/M***
2040 REM
2060 IF MF$="*" THEN A$="You've lost that privelege, "+N$:GOSUB 13020:
    SAV$="":RETURN
2080 IF P3$="NOPASS" THEN 2140
2100 A1$="Password ?":GOSUB 13020:C=1:GOSUB 13260:C=0
2120 IF B$<>P3$ THEN A$="+++INVALID+++":GOSUB 13020:GOSUB 13020:RETURN
2140 IF XPR THEN 2240
2160 A$="Please remember to type BYE before hanging up the phone.":GOSUB 13020:GOSUB 13020
2180 A$="To re-enter RIBBS, type:":GOSUB 13020:
  A$="A>RIBBS P":GOSUB 13020:GOSUB 13020
2200 A$="For info on software exchange, type:":GOSUB 13020:
    A$="A>TYPE THIS-SYS.DOC":GOSUB 13020:GOSUB 13020
2220 A$="For general info, type:":GOSUB 13020:
    A$="A>HELP":GOSUB 13020:GOSUB 13020
2240 GOSUB 13020:POKE 4,0:A$="Entering CP/M...":GOSUB 13020:POKE 0,&HC3:SYSTEM
3000 REM
3020 REM ***DISPLAY BULLETINS***
3040 REM
3060 GOSUB 12220
3080 FIL$="BULLETIN":GOSUB 18000:RETURN
4000 REM
4020 REM ***DISPLAY WELCOME MESSAGE***
4040 REM
4060 GOSUB 12220
4080 FIL$="INFO":GOSUB 18000:RETURN
5000 REM
5020 REM *** DISPLAY MENU OF FUNCTIONS ***
5040 REM
5060 GOSUB 13020:A$="Functions supported:":GOSUB 13020:IF BK THEN RETURN
5080 A$="S--> Scan messages     R--> Retrieve message":GOSUB 13020:
    IF BK THEN RETURN
5100 A$="E--> Enter message     K--> Kill message":GOSUB 13020:IF BK THEN RETURN
5120 A$="B--> retype Bulletins  W--> retype welcome":GOSUB 13020:IF BK THEN RETURN
5140 A$="C--> exit to CP/M      U--> list User file":GOSUB 13020:IF BK THEN RETURN
5160 A$="P--> Prompt (bel) togl X--> eXpert user mode":GOSUB 13020:IF BK THEN RETURN
5180 A$="Q--> Quick summary     G--> Goodbye (signoff)":GOSUB 13020:IF BK THEN RETURN
5200 GOSUB 13020:A$="Commands may be strung together, separated by semicolons.":
    GOSUB 13020:A$="For example, 'R;123' retrieves message # 123.":GOSUB 13020:
    IF BK THEN RETURN
5220 GOSUB 13020:A$="Software exchange is done under CP/M using":GOSUB 13020:
    A$="the XMODEM program (for intelligent transfer)":GOSUB 13020:
    A$="or the TYPE command (simple ASCII listing).":GOSUB 13020
5240 IF BK THEN RETURN
5280 GOSUB 13020:RETURN
6000 REM
6020 REM ***ENTER A NEW MESSAGE***
6040 REM
6060 F=0:GOSUB 13020:OPEN "R",1,"A:COUNTERS",5:A$="Msg # will be ":N=1:
    GOSUB 13020:FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
6080 A$=STR$(V+1):GOSUB 13020:CLOSE
6100 GOSUB 13020:A1$="Todays date (MM/DD/YY)?":GOSUB 13020:GOSUB 13260:D$=B$
6120 A1$="Who to (C/R for ALL)?":GOSUB 13020:C=1:GOSUB 13260:C=0:IF B$="" THEN T$="ALL" ELSE T$=B$
6140 A1$="Subject?":GOSUB 13020:C=1:GOSUB 13260:C=0:K$=B$:
    A1$="Password?":GOSUB 13020:C=1:GOSUB 13260:C=0:PW$=B$
6160 A1$="To enter msg,type in lines.":GOSUB 13020:A1$="To edit,hit blank C/R."
    :GOSUB 13020:GOSUB 13020:F=0
6180 IF F=16 THEN A$="Msg full.":GOSUB 13020:GOTO 6240
6200 F=F+1:A1$=STR$(F)+" ":N=1:GOSUB 13020:GOSUB 13260:IF B$="" THEN F=F-1:GOTO 6240
6220 A$(F)=B$+" ":GOTO 6180
6240 GOSUB 13020:A1$="(L)ist, (E)dit, (Q)uit, (C)ontinue, (S)ave; Select?":
    IF XPR THEN A1$="L,E,Q,C,S?"
6260 GOSUB 13020:C=1:GOSUB 13260:C=0
6280 IF B$<>"L" THEN 6360 ELSE GOSUB 12220
6300 GOSUB 13020:FOR L=1 TO F:A$=STR$(L)+" "+A$(L)
6320 IF BK THEN 6240 ELSE GOSUB 13020:NEXT L
6340 GOSUB 13020:GOTO 6240
6360 IF B$="Q" THEN A$="Aborted":GOSUB 13020:RETURN
6380 IF B$="C" THEN 6180
6400 IF B$="E" THEN 6460
6420 IF B$="S" THEN 6560
6440 GOTO 6240
6460 GOSUB 13020:A1$="Line #?":GOSUB 13020:GOSUB 13260:L=VAL(B$)
6480 IF L=0 OR L>F THEN 6240 ELSE A$="Was:":GOSUB 13020:A$=A$(L):GOSUB 13020
6500 A1$="Enter new line":IF NOT XPR THEN A1$=A1$+" (C/R for no change)"
6520 A1$=A1$+":":GOSUB 13020:GOSUB 13260
6540 IF B$="" THEN 6240 ELSE A$(L)=B$+" ":GOTO 6240
6560 REM
6580 IF PW$<>"" THEN PW$=";"+PW$
6600 A$="Updating summary file, ":N=1:GOSUB 13020
6620 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
6640 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 16000:PUT#1,RE
6660 RE=RE+1:S$=D$:GOSUB 16000:PUT#1,RE
6680 RE=RE+1:S$=N$+" "+O$:GOSUB 16000:PUT#1,RE
6700 RE=RE+1:S$=T$:GOSUB 16000:PUT#1,RE
6720 RE=RE+1:S$=K$:GOSUB 16000:PUT#1,RE
6740 RE=RE+1:S$=STR$(F):GOSUB 16000:PUT#1,RE
6760 RE=RE+1:S$=" 9999":GOSUB 16000:PUT#1,RE
6780 CLOSE#1
6800 A$="next msg #, ":N=1:GOSUB 13020:
    OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$
6820 GET#1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MNUM
6840 A$="active msg's, ":N=1:GOSUB 13020
6860 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MSGS:CLOSE#1
6880 A$="and msg file.":N=1:GOSUB 13020:OPEN "R",1,"A:MESSAGES",65:RL=65
6900 FIELD#1,65 AS RR$
6920 RE=MX+1
6940 S$=STR$(V+1)+PW$:GOSUB 16000:PUT#1,RE
6960 RE=RE+1:S$=D$:GOSUB 16000:PUT#1,RE
6980 RE=RE+1:S$=N$+" "+O$:GOSUB 16000:PUT#1,RE
7000 RE=RE+1:S$=T$:GOSUB 16000:PUT#1,RE
7020 RE=RE+1:S$=K$:GOSUB 16000:PUT#1,RE
7040 RE=RE+1:S$=STR$(F):GOSUB 16000:PUT#1,RE
7060 RE=RE+1
7080 FOR P=1 TO F:S$=A$(P):GOSUB 16000:PUT#1,RE:RE=RE+1:NEXT P:
    S$=" 9999":GOSUB 16000:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:
    M(MZ,1)=V+1:M(MZ,2)=F
7100 GOSUB 13020:GOSUB 13020:U=U+1:RETURN
8000 REM
8020 REM ***RETRIEVE MESSAGE***
8040 REM
8060 GOSUB 13020:A1$="MSG # ("+STR$(IU)+" -"+STR$(U)+" )":
    IF NOT XPR THEN A1$=A1$+" to retrieve (c/r to end)"
8080 A1$=A1$+"?":GOSUB 13020:GOSUB 13260:GOSUB 13020
8100 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
8120 IF M<1 THEN GOSUB 13020:RETURN
8140 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":GOTO 8060
8160 GOSUB 12220:GOSUB 13020
8180 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,63 AS RR$:MI=0
8200 MI=MI+1:IF (MI>MZ) OR BK THEN 8540 ELSE G=M(MI,1)
8220 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 8200
8240 IF G>M THEN 8480
8260 GOSUB 19100:IF OK THEN 8280 ELSE RE=RE+M(MI,2):GOTO 8200
8280 RE=RE+1:GET#1,RE:GOSUB 16500:D$=S$
8300 RE=RE+1:GET#1,RE:GOSUB 16500:NO$=S$
8320 RE=RE+1:GET#1,RE:GOSUB 16500:T$=S$
8340 RE=RE+1:GET#1,RE:GOSUB 16500:GOSUB 19200:K$=S$
8360 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 13020
8380 A$="Msg #"+STR$(G)+" was entered on date "+D$+" from "+NO$:GOSUB 13020
8400 A$="To "+T$+" about "+K$:GOSUB 13020:GOSUB 13020
8420 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 16500:A$=S$:GOSUB 13020
8440 IF BK THEN 8540
8460 RE=RE+1:NEXT P:GOSUB 13020
8480 IF RIGHT$(B$,1)<>"+" THEN CLOSE:GOTO 8020
8500 M=M+1:MI=0:RE=1
8520 IF M<=U AND NOT BK THEN 8200
8540 CLOSE:A$="End of msg's.":GOSUB 13020:GOSUB 13020:D$="":NO$="":RETURN
9000 REM
9020 REM ***SUMMARIZE MESSAGES***
9040 REM COMMON CODE FOR S AND Q CMDS
9060 REM
9080 GOSUB 13020:
     A1$="Msg # ("+STR$(IU)+" -"+STR$(U)+" ) to start (C/R to end)?":
     GOSUB 13020:C=1:GOSUB 13260:C=0:GOSUB 13020
9100 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$):GOSUB 13220
9120 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 9220
9140 IF LEN(B$)<3 THEN RETURN
9160 IF MID$(B$,2,1)<>"=" THEN RETURN
9180 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
9200 IF ST=0 THEN RETURN
9220 IF M<1 THEN RETURN
9240 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":RETURN
9260 IF NOT QU THEN GOSUB 12220:GOSUB 13020
9280 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD #1,28 AS RR$
9300 GET #1,RE
9320 IF EOF(1) OR BK THEN 9660 ELSE G=VAL(RR$)
9340 IF G>9998 THEN 9660
9360 IF G<M THEN RE=RE+6:GOTO 9300
9380 GOSUB 19100:IF OK THEN 9400 ELSE RE=RE+6:GOTO 9300
9400 GET #1,RE+ST+1:IF ST=0 THEN 9420 ELSE GOSUB 16500:IF INSTR(S$,SV$)=0 THEN RE=RE+6:GOTO 9300
9420 IF NOT QU THEN 9500
9440 REM quick summary
9460 GET #1,RE+4:GOSUB 16500:GOSUB 19200:
     A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+" "+S$:GOSUB 13020
9480 IF U=G OR BK THEN 9660 ELSE RE=RE+6:GOTO 9300
9500 REM full summary
9520 A$="Msg #"+STR$(G)+"    Date entered: ":N=1:GOSUB 13020:IF BK THEN 9660
9540 RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$+"   From: ":N=1:GOSUB 13020:IF BK THEN 9660
9560 RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
9580 A$="To: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
9600 A$="About: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:
     GOSUB 16500:GOSUB 19200:A$=S$:GOSUB 13020:IF BK THEN 9660
9620 A$="Size: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
9640 GOSUB 13020:IF U=G OR BK THEN 9660 ELSE RE=RE+1:GOTO 9300
9660 GOSUB 13020:A$="***** End of summary *****":GOSUB 13020:GOSUB 13020:GOSUB 13020:CLOSE:RETURN
10000 REM
10020 REM ***GOODBYE***
10040 REM
10060 GOSUB 13020:A1$="Want to leave any comments?":GOSUB 13020:C=1:GOSUB 13260:C=0
10080 IF LEFT$(B$,1)<>"Y" THEN 10260
10100 OPEN "R",1,"A:COMMENTS",65:FIELD#1,65 AS RR$:GET#1,1:RE=VAL(RR$)+1:RL=65
10120 IF RE=1 THEN RE=2
10140 S$="From: "+N$+" "+O$:GOSUB 16000
10160 PUT#1,RE
10180 A$="Enter comments; to end, hit C/R.":GOSUB 13020
10200 A$="Ok>":N=1:GOSUB 13020:GOSUB 13260
10220 IF B$="" THEN 10240 ELSE RE=RE+1:S$=B$:RL=65:GOSUB 16000:PUT#1,RE:GOTO 10200
10240 S$=STR$(RE):RL=65:GOSUB 16000:PUT#1,1:CLOSE
10260 GOSUB 13020:
    A$="Character count:  "+STR$(A)+" typed by system - "+STR$(D)+
    " typed by you.":GOSUB 13020:
    A$="From Ron: thanks for calling, "+N$+".":GOSUB 13020
10280 A$="***** End of connection ******":GOSUB 13020:GOSUB 13020:SYSTEM
11000 REM
11020 REM ***KILL A MESSAGE***
11040 REM
11060 GOSUB 13020:A1$="Message # to kill?":GOSUB 13020:GOSUB 13260
11080 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
11100 IF M<1 THEN GOSUB 13020:RETURN
11120 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":GOTO 11040
11140 A$="Scanning summary file...":GOSUB 13020:
    OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
11160 GET#1,RE
11180 IF EOF(1) THEN 11520 ELSE G=VAL(RR$)
11200 IF G>9998 THEN 11520
11220 IF G<M THEN RE=RE+6:GOTO 11160
11240 IF G>M THEN 11520
11260 GOSUB 19100:IF NOT OK THEN 11520
11280 GOSUB 16500:PW=INSTR(S$,";"):PW$=""
11300 IF PW=0 OR N$+O$="SYSOP" OR PERS THEN PERS=0:GOTO 11340
11320 PW$=MID$(S$,PW+1):A1$="Password ?":GOSUB 13020:C=1:GOSUB 13260:C=0:
     IF B$<>PW$ THEN A$="Incorrect.":GOSUB 13020:GOSUB 13020:CLOSE:RETURN
11340 S$=" 0"+":"+STR$(G):GOSUB 16000:PUT#1,RE:CLOSE
11360 A$="Updating message file...":GOSUB 13020
11380 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
11400 MI=MI+1:IF MI>MZ THEN 11520 ELSE G=M(MI,1)
11420 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 11400
11440 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 16000:PUT#1,RE:M(MI,1)=0
11460 CLOSE#1:A$="Updating message count...":GOSUB 13020
11480 OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:
    GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS:CLOSE
11500 GOSUB 13020:A$="Message killed.":GOSUB 13020:GOSUB 13020:RETURN
11520 CLOSE:A$="Message not found.":GOSUB 130
20:GOSUB 13020:RETURN
12000 REM
12020 REM ***DISPLAY USER FILE***
12040 REM
12060 GOSUB 12220: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$)
12080 FOR I=NU+1 TO 2 STEP -1:
     GET#1,I:IF SU$<>"*" THEN GOSUB 16500:A$=S$:GOSUB 13020
12100 IF BK THEN 12140
12120 NEXT I
12140 CLOSE:GOSUB 13020:RETURN
12160 REM
12180 REM **** PRINT CONTROL-CHAR INFO
12200 REM
12220 GOSUB 13020
13000 A$="Use ctl-K to abort, ctl-S to pause."
13020 REM
13040 REM ***PRINT STRING FROM A$ ON CONSOLE***
13060 REM
13080 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
13100 IF A1$<>"" THEN A$=A1$:A1$=""
13120 IF RIGHT$(A$,1)="?" OR N=1 THEN PRINT A$;:PP$=A$:GOTO 13180
13140 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
13160 IF BI=11 THEN BK=-1:GOTO 13220 ELSE PRINT A$
13180 A=A+LEN(A$)
13200 IF N$+O$="SYSOP" AND INP(255)=1 THEN LPRINT A$;:
        IF N=0 AND RIGHT$(A$,1)<>"?" THEN LPRINT
13220 A$="":N=0
13240 RETURN
13260 REM
13280 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
13300 REM
13320 IF BEL AND SAV$="" THEN PRINT CHR$(7);
13340 B$="":BK=0
13360 IF SAV$="" THEN LINE INPUT SAV$
13380 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 13420
13400 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
13420 IF LEN(B$)=0 THEN RETURN
13440 IF C=0 THEN 13480
13460 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
13480 IF LEN(B$)<62 THEN 13580
13500 A$="Input line too long - would be truncated to:":GOSUB 13020
13520 B$=LEFT$(B$,61):PRINT B$
13540 LINE INPUT "Retype line (Y/N)?";QQ$:QQ$=LEFT$(QQ$,1)
13560 IF QQ$="Y" OR QQ$="y" THEN PRINT PP$;:SAV$="":GOTO 13260
13580 D=D+LEN(B$):RETURN
13600 RETURN
13620 REM
15000 REM ***ON ERROR HANDLER***
15010 IF ERL=430 THEN RESUME 450
15020 IF ERL=18030 THEN RESUME 18050
15030 IF ERL=700 THEN RE=0:RESUME 710
15040 IF ERL=740 THEN M=0:RESUME 750
15050 IF ERL=760 THEN C=0:RESUME 770
15060 IF ERL=780 THEN U=0:RESUME 790
15070 IF ERL=6060 THEN V=0:RESUME 6080
15080 IF ERL=6800 THEN C=0:RESUME 6820
15090 IF ERL=6840 THEN C=0:RESUME 6860
15100 RESUME NEXT
16000 REM
16010 REM FILL AND STORE DISK RECORD
16020 REM
16030 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
16040 RETURN
16500 REM
16510 REM UNPACK DISK RECORD
16520 REM
16530 ZZ=LEN(RR$)-2
16540 WHILE MID$(RR$,ZZ,1)=" "
16550 ZZ=ZZ-1:IF ZZ=1 THEN 16570
16560 WEND
16570 S$=LEFT$(RR$,ZZ)
16580 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
16590 RETURN
17000 REM
17010 REM *** TOGGLE EXPERT USER MODE
17020 REM
17030 XPR=NOT XPR:RETURN
17040 REM
17050 REM *** TOGGLE BELL PROMPT
17060 REM
17070 BEL=NOT BEL:RETURN
18000 REM
18010 REM SUBROUTINE TO PRINT A FILE
18020 REM
18030 OPEN "I",1,"A:"+FIL$:BK=0
18040 IF EOF(1) OR BK THEN 18050 ELSE LINE INPUT #1,A$:GOSUB 13020:GOTO 18040
18050 CLOSE #1:RETURN
18060 REM FULL SUMMARY
18070 QU=0:GOSUB 9000:RETURN
18080 REM QUICK SUMMARY
18090 QU=-1:GOSUB 9000:RETURN
19000 REM PRINT "CALLERS" FILE...FOR SYSOP ONLY (PRIVATE CMD)
19010 GOSUB 13020
19020 IF N$+O$<>"SYSOP" THEN 1200' IF NOT SYSOP, SAY "I DON'T UNDERSTAND".
19030 OPEN "R",1,"A:CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
19040 CA=CN
19050 FOR CNT=SIZ+1 TO 2 STEP -1
19060 GET #1,CNT:GOSUB 16500:A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 13020:IF BK THEN 19090
19070 CA=CA-1
19080 NEXT CNT
19090 CLOSE:A$= "END OF CALLERS.":GOSUB 13020:GOSUB 13020:RETURN
19100 REM TEST FOR PERSONAL MESSAGES
19110 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")=0 THEN 19160
19120 PERS=-1
19130 IF N$+O$="SYSOP" THEN 19160
19140 GET #1,RE+3:GOSUB 19170:IF OK THEN 19160
19150 GET #1,RE+2:GOSUB 19170
19160 RETURN
19170 REM TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME
19180 IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN OK=-1 ELSE OK=0
19190 RETURN
19200 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
19210 RETURN

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.