home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol008 / rbbs22.asc < prev    next >
Encoding:
Text File  |  1984-04-29  |  19.8 KB  |  462 lines
  1. 10 REM RBBS VERSION 2.2
  2. 20 REM *****RBBS - "Remote Bulletin Board System"*****
  3. 30 REM by Bruce R. Ratoff
  4. 40 REM adapted from Xitan Basic SJBBS by Howard Moulton
  5. 45 REM changes of 12/10/80 by Bruce Ratoff
  6. 46 REM    FIXED BUG THAT PREVENTED "NEWCOM" FROM PRINTING
  7. 47 REM    MADE "LASTCALR" A $SYS FILE
  8. 48 REM    IMPROVED CONTROL-K RESPONSE (STILL NOT PERFECT BUT BETTER)
  9. 50 REM changes of 11/14/80 by Ron Fowler
  10. 60 REM    ADDED PERSONAL MESSAGE FUNCTION
  11. 70 REM    K FUNCTION STORES NAME OF ERASING USER IN MSG# RECORD
  12. 80 REM changes of 11/9/80  by Ron Fowler
  13. 90 REM  1: PRINT CALLERS FOR SYSOP
  14. 100 REM  2: SAVE KILLED MSG #S, PUT PWD'S IN MSG FILE
  15. 110 REM  3: RE-ENTRY OPTION, FILE "LASTCALR"
  16. 120 REM 10/21/80 --> Fix several minor bugs in P and S cmds.  (BRR)
  17. 130 REM Changes 10/15/80 by Ron Fowler:
  18. 140 REM    1) added "Q", quick summary command
  19. 150 REM    2) added "X", "P" cmds - expert user mode, and bell toggle
  20. 160 REM    3) rearranged message entry for CBBS compatibility
  21. 170 REM    4) added ";" delimitation - "command anticipation"
  22. 180 REM    5) added password file access at 3 levels:
  23. 190 REM       a. p1$ is high-level quick-access to cp/m
  24. 200 REM       b. p2$ is sysop 'last name' (sysop has special priveliges)
  25. 210 REM       c. p3$ is the normal cpm access password:
  26. 220 REM          (IF P3$ IS "NOPASS", THEN CPM ACCESS IS UNRESTRICTED)
  27. 230 REM    6) coded several sequences as subroutines, to shorten code
  28. 240 REM    7) made several cosmetic changes
  29. 250 REM note: the file "PWDS" can be created by a text editor.  The
  30. 260 REM       passwords are sequential..e.g.,"GOTOCPM,FOWLER,NOPASS"
  31. 270 REM *** put the shortest version of your first name in line 920
  32. 280 REM
  33. 290 REM
  34. 300 DEFINT A-Z
  35. 310 VERS$="vers 2.2"' VERSION NUMBER
  36. 320 DIM A$(17),M(200,2)
  37. 330 POKE 0,&HCD
  38. 340 INC=1
  39. 350 ON ERROR GOTO 13620
  40. 360 RFLG=PEEK(&H5D):POKE &H5D,32
  41. 370 REM
  42. 380 REM SIGNON FUNCTIONS
  43. 390 REM
  44. 400 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
  45. 410 P2$="RON":P3$="SLAGBACK 'DEFAULT PWDS
  46. 420 BK=0:GOSUB 13020:N=1:A$="Westland, Mich. RBBS...":GOSUB 13020:N=0
  47. 430 OPEN "I",1,"A:PWDS":IF EOF(1) THEN 450
  48. 440 INPUT #1,P1$,P2$,P3$
  49. 450 CLOSE #1
  50. 460 BEL=-1:XPR=0'INITIAL BEL ON, NOT EXPERT
  51. 470 A$=VERS$:GOSUB 13020:GOSUB 13020
  52. 480 SAV$=""
  53. 490 IF RFLG<>ASC("P") THEN 530
  54. 500 INC=0
  55. 510 OPEN "I",1,"LASTCALR":INPUT #1,N$,O$:CLOSE
  56. 520 A$="Welcome back, "+N$+" "+O$+".":GOSUB 13020:GOSUB 13020:GOTO 740
  57. 530 GOSUB 4080:GOSUB 3080'REM PRINT INFO, THEN BULLETINS
  58. 540 BK=0:A$="(Prompting bell means system is ready for input).":GOSUB 13020:GOSUB 13020
  59. 550 A$="What is your FIRST name ?":GOSUB 13020:C=1:GOSUB 13260:C=0:N$=B$:
  60.  
  61.     IF N$="" THEN 550
  62. 560 IF N$=P1$ THEN 2240 ' DIRECT CPM EXIT
  63. 570 IF N$<"A" OR LEN(N$)=1 THEN 550
  64. 580 A1$="What is your LAST name ?":GOSUB 13020:C=1:GOSUB 13260:C=0:O$=B$:
  65.  
  66.     IF O$="" THEN 550
  67. 590 IF O$<"A" OR LEN(O$)=1 THEN 550
  68. 600 IF N$="SYSOP" AND O$=P2$ THEN O$="":GOTO 700
  69. 610 IF N$="SYSOP" THEN 550
  70. 620 A$="Checking user file...":GOSUB 13020:V=0:OPEN "R",1,"A:USERS",62:
  71.  
  72.     FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
  73. 630 FOR I=2 TO NU+1:GET#1,I:
  74.  
  75.     IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN MF$=LEFT$(RR$,1):CLOSE:
  76.  
  77.        GOSUB 13020:GOTO 700
  78. 640 NEXT I
  79. 650 V=1:A1$="Where (City,State) are you calling from ?":GOSUB 13020:
  80.  
  81.     C=1:GOSUB 13260:C=0:ST$=B$:IF ST$="" THEN 580
  82. 660 A$="Hello "+N$+" "+O$+" from "+ST$:GOSUB 13020:
  83.  
  84.     A1$="Did I misspell anything ?":GOSUB 13020:C=1:GOSUB 13260:C=0:
  85.  
  86.     IF LEFT$(B$,1)="Y" THEN 550
  87. 670 A1$="This checking is only done the first time you call.":GOSUB 13020
  88. 680 S$="  "+N$+" "+O$+" "+ST$:RL=62:GOSUB 16000:NU=NU+1:PUT#1,NU+1:
  89.  
  90.     S$=STR$(NU):GOSUB 16000:PUT#1,1:CLOSE
  91. 690 FIL$="NEWCOM":GOSUB 18000:MF$=" "
  92. 700 A$="Logging "+N$+" "+O$+" to disk...":N=1:GOSUB 13020:
  93.  
  94.     OPEN "R",1,"A:CALLERS",60:    FIELD#1,60 AS RR$:GET#1,1
  95. 710 RE=VAL(RR$)+1:S$=STR$(RE):RL=60:GOSUB 16000:PUT#1,1:RE=RE+1
  96. 720 S$=N$+" "+O$+" "+ST$:GOSUB 16000:PUT#1,RE:CLOSE#1
  97. 730 OPEN "O",1,"LASTCALR. "+CHR$(&HA0):PRINT #1,N$;",";O$:CLOSE
  98. 740 BK=0:GOSUB 13020:A$="Active # of msg's ":N=1:GOSUB 13020:
  99.  
  100.     OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MSGS:M=VAL(RR$)
  101. 750 A$=STR$(M)+".":GOSUB 13020
  102. 760 A$="You are caller # ":N=1:GOSUB 13020:GET#1,CALLS
  103. 770 CN=VAL(RR$)+INC:A$=STR$(CN):LSET RR$=A$:GOSUB 13020:PUT#1,CALLS
  104. 780 A$="Next msg # will be ":N=1:GOSUB 13020:GET#1,MNUM:U=VAL(RR$)
  105. 790 A$=STR$(U+1):GOSUB 13020:CLOSE:GOSUB 13020
  106. 800 REM
  107. 810 REM LOOK FOR MSGS FOR THIS CALLER
  108. 820 REM AND BUILD MESSAGE INDEX
  109. 830 REM
  110. 840 FT=1:MX=0:MZ=0:IU=0:'FLAG FIRST TIME FOR PRINTING HEADING
  111. 850 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,28 AS RR$
  112. 860 BK=0:GET#1,RE:IF EOF(1) THEN 960
  113. 870 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 950
  114. 880 IF IU=0 THEN IU=G
  115. 890 IF G>9998 THEN MZ=MZ-1:GOTO 960
  116. 900 GET#1,RE+3:GOSUB 16500:IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 930
  117. 910 IF N$<>"SYSOP" THEN 950
  118. 920 IF INSTR(S$,"RON")=0 THEN 950
  119. 930 IF FT THEN A$="Please retrieve and kill the following message(s) left for you:":GOSUB 13020:FT=0
  120. 940 A$=STR$(G):N=1:GOSUB 13020
  121. 950 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 860
  122. 960 CLOSE:GOSUB 13020:GOSUB 13020
  123. 1000 REM
  124. 1020 REM *** MAIN COMMAND ACCEPTOR/DISPATCHER ***
  125. 1040 REM
  126. 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)"
  127. 1080 A1$=A1$+"?":GOSUB 13020:C=1:GOSUB 13260:C=0
  128. 1100 IF B$="" THEN 1000
  129. 1120 FF=INSTR("BER?SKGWCUPXQL",B$):GOSUB 1140:GOTO 1000
  130. 1140 IF FF=0 THEN 1180
  131. 1160 ON FF GOTO 3000,6000,8000,5000,18060,11000,10000,4000,2000,12000,
  132.  
  133.      17040,17000,18080,19000
  134. 1180 IF N$+O$="SYSOP" THEN IF B$="%" THEN GOSUB 19000:GOTO 1000
  135. 1200 A$="I don't understand '"+B$+"', "+N$+".":GOSUB 13020:GOSUB 13020:
  136.  
  137.      SAV$="":RETURN
  138. 2000 REM
  139. 2020 REM ***EXIT TO CP/M***
  140. 2040 REM
  141. 2060 IF MF$="*" THEN A$="You've lost that privelege, "+N$:GOSUB 13020:
  142.  
  143.      SAV$="":RETURN
  144. 2080 IF P3$="NOPASS" THEN 2140
  145. 2100 A1$="Password ?":GOSUB 13020:C=1:GOSUB 13260:C=0
  146. 2120 IF B$<>P3$ THEN A$="+++INVALID+++":GOSUB 13020:GOSUB 13020:RETURN
  147. 2140 IF XPR THEN 2240
  148. 2160 A$="Please remember to type BYE before hanging up the phone.":GOSUB 13020:GOSUB 13020
  149. 2180 A$="To re-enter RIBBS, type:":GOSUB 13020:
  150.  
  151.    A$="A>RIBBS P":GOSUB 13020:GOSUB 13020
  152. 2200 A$="For info on software exchange, type:":GOSUB 13020:
  153.  
  154.      A$="A>TYPE THIS-SYS.DOC":GOSUB 13020:GOSUB 13020
  155. 2220 A$="For general info, type:":GOSUB 13020:
  156.  
  157.      A$="A>HELP":GOSUB 13020:GOSUB 13020
  158. 2240 GOSUB 13020:POKE 4,0:A$="Entering CP/M...":GOSUB 13020:POKE 0,&HC3:SYSTEM
  159. 3000 REM
  160. 3020 REM ***DISPLAY BULLETINS***
  161. 3040 REM
  162. 3060 GOSUB 12220
  163. 3080 FIL$="BULLETIN":GOSUB 18000:RETURN
  164. 4000 REM
  165. 4020 REM ***DISPLAY WELCOME MESSAGE***
  166. 4040 REM
  167. 4060 GOSUB 12220
  168. 4080 FIL$="INFO":GOSUB 18000:RETURN
  169. 5000 REM
  170. 5020 REM *** DISPLAY MENU OF FUNCTIONS ***
  171. 5040 REM
  172. 5060 GOSUB 13020:A$="Functions supported:":GOSUB 13020:IF BK THEN RETURN
  173. 5080 A$="S--> Scan messages     R--> Retrieve message":GOSUB 13020:
  174.  
  175.      IF BK THEN RETURN
  176. 5100 A$="E--> Enter message     K--> Kill message":GOSUB 13020:IF BK THEN RETURN
  177. 5120 A$="B--> retype Bulletins  W--> retype welcome":GOSUB 13020:IF BK THEN RETURN
  178. 5140 A$="C--> exit to CP/M      U--> list User file":GOSUB 13020:IF BK THEN RETURN
  179. 5160 A$="P--> Prompt (bel) togl X--> eXpert user mode":GOSUB 13020:IF BK THEN RETURN
  180. 5180 A$="Q--> Quick summary     G--> Goodbye (signoff)":GOSUB 13020:IF BK THEN RETURN
  181. 5200 GOSUB 13020:A$="Commands may be strung together, separated by semicolons.":
  182.  
  183.      GOSUB 13020:A$="For example, 'R;123' retrieves message # 123.":GOSUB 13020:
  184.  
  185.      IF BK THEN RETURN
  186. 5220 GOSUB 13020:A$="Software exchange is done under CP/M using":GOSUB 13020:
  187.  
  188.      A$="the XMODEM program (for intelligent transfer)":GOSUB 13020:
  189.  
  190.      A$="or the TYPE command (simple ASCII listing).":GOSUB 13020
  191. 5240 IF BK THEN RETURN
  192. 5280 GOSUB 13020:RETURN
  193. 6000 REM
  194. 6020 REM ***ENTER A NEW MESSAGE***
  195. 6040 REM
  196. 6060 F=0:GOSUB 13020:OPEN "R",1,"A:COUNTERS",5:A$="Msg # will be ":N=1:
  197.  
  198.      GOSUB 13020:FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
  199. 6080 A$=STR$(V+1):GOSUB 13020:CLOSE
  200. 6100 GOSUB 13020:A1$="Todays date (MM/DD/YY)?":GOSUB 13020:GOSUB 13260:D$=B$
  201. 6120 A1$="Who to (C/R for ALL)?":GOSUB 13020:C=1:GOSUB 13260:C=0:IF B$="" THEN T$="ALL" ELSE T$=B$
  202. 6140 A1$="Subject?":GOSUB 13020:C=1:GOSUB 13260:C=0:K$=B$:
  203.  
  204.      A1$="Password?":GOSUB 13020:C=1:GOSUB 13260:C=0:PW$=B$
  205. 6160 A1$="To enter msg,type in lines.":GOSUB 13020:A1$="To edit,hit blank C/R."
  206.  
  207.      :GOSUB 13020:GOSUB 13020:F=0
  208. 6180 IF F=16 THEN A$="Msg full.":GOSUB 13020:GOTO 6240
  209. 6200 F=F+1:A1$=STR$(F)+" ":N=1:GOSUB 13020:GOSUB 13260:IF B$="" THEN F=F-1:GOTO 6240
  210. 6220 A$(F)=B$+" ":GOTO 6180
  211. 6240 GOSUB 13020:A1$="(L)ist, (E)dit, (Q)uit, (C)ontinue, (S)ave; Select?":
  212.  
  213.      IF XPR THEN A1$="L,E,Q,C,S?"
  214. 6260 GOSUB 13020:C=1:GOSUB 13260:C=0
  215. 6280 IF B$<>"L" THEN 6360 ELSE GOSUB 12220
  216. 6300 GOSUB 13020:FOR L=1 TO F:A$=STR$(L)+" "+A$(L)
  217. 6320 IF BK THEN 6240 ELSE GOSUB 13020:NEXT L
  218. 6340 GOSUB 13020:GOTO 6240
  219. 6360 IF B$="Q" THEN A$="Aborted":GOSUB 13020:RETURN
  220. 6380 IF B$="C" THEN 6180
  221. 6400 IF B$="E" THEN 6460
  222. 6420 IF B$="S" THEN 6560
  223. 6440 GOTO 6240
  224. 6460 GOSUB 13020:A1$="Line #?":GOSUB 13020:GOSUB 13260:L=VAL(B$)
  225. 6480 IF L=0 OR L>F THEN 6240 ELSE A$="Was:":GOSUB 13020:A$=A$(L):GOSUB 13020
  226. 6500 A1$="Enter new line":IF NOT XPR THEN A1$=A1$+" (C/R for no change)"
  227. 6520 A1$=A1$+":":GOSUB 13020:GOSUB 13260
  228. 6540 IF B$="" THEN 6240 ELSE A$(L)=B$+" ":GOTO 6240
  229. 6560 REM
  230. 6580 IF PW$<>"" THEN PW$=";"+PW$
  231. 6600 A$="Updating summary file, ":N=1:GOSUB 13020
  232. 6620 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  233. 6640 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 16000:PUT#1,RE
  234. 6660 RE=RE+1:S$=D$:GOSUB 16000:PUT#1,RE
  235. 6680 RE=RE+1:S$=N$+" "+O$:GOSUB 16000:PUT#1,RE
  236. 6700 RE=RE+1:S$=T$:GOSUB 16000:PUT#1,RE
  237. 6720 RE=RE+1:S$=K$:GOSUB 16000:PUT#1,RE
  238. 6740 RE=RE+1:S$=STR$(F):GOSUB 16000:PUT#1,RE
  239. 6760 RE=RE+1:S$=" 9999":GOSUB 16000:PUT#1,RE
  240. 6780 CLOSE#1
  241. 6800 A$="next msg #, ":N=1:GOSUB 13020:
  242.  
  243.      OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$
  244. 6820 GET#1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MNUM
  245. 6840 A$="active msg's, ":N=1:GOSUB 13020
  246. 6860 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MSGS:CLOSE#1
  247. 6880 A$="and msg file.":N=1:GOSUB 13020:OPEN "R",1,"A:MESSAGES",65:RL=65
  248. 6900 FIELD#1,65 AS RR$
  249. 6920 RE=MX+1
  250. 6940 S$=STR$(V+1)+PW$:GOSUB 16000:PUT#1,RE
  251. 6960 RE=RE+1:S$=D$:GOSUB 16000:PUT#1,RE
  252. 6980 RE=RE+1:S$=N$+" "+O$:GOSUB 16000:PUT#1,RE
  253. 7000 RE=RE+1:S$=T$:GOSUB 16000:PUT#1,RE
  254. 7020 RE=RE+1:S$=K$:GOSUB 16000:PUT#1,RE
  255. 7040 RE=RE+1:S$=STR$(F):GOSUB 16000:PUT#1,RE
  256. 7060 RE=RE+1
  257. 7080 FOR P=1 TO F:S$=A$(P):GOSUB 16000:PUT#1,RE:RE=RE+1:NEXT P:
  258.  
  259.      S$=" 9999":GOSUB 16000:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:
  260.  
  261.      M(MZ,1)=V+1:M(MZ,2)=F
  262. 7100 GOSUB 13020:GOSUB 13020:U=U+1:RETURN
  263. 8000 REM
  264. 8020 REM ***RETRIEVE MESSAGE***
  265. 8040 REM
  266. 8060 GOSUB 13020:A1$="MSG # ("+STR$(IU)+" -"+STR$(U)+" )":
  267.  
  268.      IF NOT XPR THEN A1$=A1$+" to retrieve (c/r to end)"
  269. 8080 A1$=A1$+"?":GOSUB 13020:GOSUB 13260:GOSUB 13020
  270. 8100 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  271. 8120 IF M<1 THEN GOSUB 13020:RETURN
  272. 8140 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":GOTO 8060
  273. 8160 GOSUB 12220:GOSUB 13020
  274. 8180 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,63 AS RR$:MI=0
  275. 8200 MI=MI+1:IF (MI>MZ) OR BK THEN 8540 ELSE G=M(MI,1)
  276. 8220 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 8200
  277. 8240 IF G>M THEN 8480
  278. 8260 GOSUB 19100:IF OK THEN 8280 ELSE RE=RE+M(MI,2):GOTO 8200
  279. 8280 RE=RE+1:GET#1,RE:GOSUB 16500:D$=S$
  280. 8300 RE=RE+1:GET#1,RE:GOSUB 16500:NO$=S$
  281. 8320 RE=RE+1:GET#1,RE:GOSUB 16500:T$=S$
  282. 8340 RE=RE+1:GET#1,RE:GOSUB 16500:GOSUB 19200:K$=S$
  283. 8360 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 13020
  284. 8380 A$="Msg #"+STR$(G)+" was entered on date "+D$+" from "+NO$:GOSUB 13020
  285. 8400 A$="To "+T$+" about "+K$:GOSUB 13020:GOSUB 13020
  286. 8420 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 16500:A$=S$:GOSUB 13020
  287. 8440 IF BK THEN 8540
  288. 8460 RE=RE+1:NEXT P:GOSUB 13020
  289. 8480 IF RIGHT$(B$,1)<>"+" THEN CLOSE:GOTO 8020
  290. 8500 M=M+1:MI=0:RE=1
  291. 8520 IF M<=U AND NOT BK THEN 8200
  292. 8540 CLOSE:A$="End of msg's.":GOSUB 13020:GOSUB 13020:D$="":NO$="":RETURN
  293. 9000 REM
  294. 9020 REM ***SUMMARIZE MESSAGES***
  295. 9040 REM COMMON CODE FOR S AND Q CMDS
  296. 9060 REM
  297. 9080 GOSUB 13020:
  298.  
  299.       A1$="Msg # ("+STR$(IU)+" -"+STR$(U)+" ) to start (C/R to end)?":
  300.  
  301.       GOSUB 13020:C=1:GOSUB 13260:C=0:GOSUB 13020
  302. 9100 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$):GOSUB 13220
  303. 9120 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 9220
  304. 9140 IF LEN(B$)<3 THEN RETURN
  305. 9160 IF MID$(B$,2,1)<>"=" THEN RETURN
  306. 9180 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
  307. 9200 IF ST=0 THEN RETURN
  308. 9220 IF M<1 THEN RETURN
  309. 9240 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":RETURN
  310. 9260 IF NOT QU THEN GOSUB 12220:GOSUB 13020
  311. 9280 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD #1,28 AS RR$
  312. 9300 GET #1,RE
  313. 9320 IF EOF(1) OR BK THEN 9660 ELSE G=VAL(RR$)
  314. 9340 IF G>9998 THEN 9660
  315. 9360 IF G<M THEN RE=RE+6:GOTO 9300
  316. 9380 GOSUB 19100:IF OK THEN 9400 ELSE RE=RE+6:GOTO 9300
  317. 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
  318. 9420 IF NOT QU THEN 9500
  319. 9440 REM quick summary
  320. 9460 GET #1,RE+4:GOSUB 16500:GOSUB 19200:
  321.  
  322.       A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+" "+S$:GOSUB 13020
  323. 9480 IF U=G OR BK THEN 9660 ELSE RE=RE+6:GOTO 9300
  324. 9500 REM full summary
  325. 9520 A$="Msg #"+STR$(G)+"    Date entered: ":N=1:GOSUB 13020:IF BK THEN 9660
  326. 9540 RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$+"   From: ":N=1:GOSUB 13020:IF BK THEN 9660
  327. 9560 RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
  328. 9580 A$="To: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
  329. 9600 A$="About: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:
  330.  
  331.       GOSUB 16500:GOSUB 19200:A$=S$:GOSUB 13020:IF BK THEN 9660
  332. 9620 A$="Size: ":N=1:GOSUB 13020:RE=RE+1:GET #1,RE:GOSUB 16500:A$=S$:GOSUB 13020:IF BK THEN 9660
  333. 9640 GOSUB 13020:IF U=G OR BK THEN 9660 ELSE RE=RE+1:GOTO 9300
  334. 9660 GOSUB 13020:A$="***** End of summary *****":GOSUB 13020:GOSUB 13020:GOSUB 13020:CLOSE:RETURN
  335. 10000 REM
  336. 10020 REM ***GOODBYE***
  337. 10040 REM
  338. 10060 GOSUB 13020:A1$="Want to leave any comments?":GOSUB 13020:C=1:GOSUB 13260:C=0
  339. 10080 IF LEFT$(B$,1)<>"Y" THEN 10260
  340. 10100 OPEN "R",1,"A:COMMENTS",65:FIELD#1,65 AS RR$:GET#1,1:RE=VAL(RR$)+1:RL=65
  341. 10120 IF RE=1 THEN RE=2
  342. 10140 S$="From: "+N$+" "+O$:GOSUB 16000
  343. 10160 PUT#1,RE
  344. 10180 A$="Enter comments; to end, hit C/R.":GOSUB 13020
  345. 10200 A$="Ok>":N=1:GOSUB 13020:GOSUB 13260
  346. 10220 IF B$="" THEN 10240 ELSE RE=RE+1:S$=B$:RL=65:GOSUB 16000:PUT#1,RE:GOTO 10200
  347. 10240 S$=STR$(RE):RL=65:GOSUB 16000:PUT#1,1:CLOSE
  348. 10260 GOSUB 13020:
  349.  
  350.      A$="Character count:  "+STR$(A)+" typed by system - "+STR$(D)+
  351.  
  352.      " typed by you.":GOSUB 13020:
  353.  
  354.      A$="From Ron: thanks for calling, "+N$+".":GOSUB 13020
  355. 10280 A$="***** End of connection ******":GOSUB 13020:GOSUB 13020:SYSTEM
  356. 11000 REM
  357. 11020 REM ***KILL A MESSAGE***
  358. 11040 REM
  359. 11060 GOSUB 13020:A1$="Message # to kill?":GOSUB 13020:GOSUB 13260
  360. 11080 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  361. 11100 IF M<1 THEN GOSUB 13020:RETURN
  362. 11120 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13020:SAV$="":GOTO 11040
  363. 11140 A$="Scanning summary file...":GOSUB 13020:
  364.  
  365.      OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  366. 11160 GET#1,RE
  367. 11180 IF EOF(1) THEN 11520 ELSE G=VAL(RR$)
  368. 11200 IF G>9998 THEN 11520
  369. 11220 IF G<M THEN RE=RE+6:GOTO 11160
  370. 11240 IF G>M THEN 11520
  371. 11260 GOSUB 19100:IF NOT OK THEN 11520
  372. 11280 GOSUB 16500:PW=INSTR(S$,";"):PW$=""
  373. 11300 IF PW=0 OR N$+O$="SYSOP" OR PERS THEN PERS=0:GOTO 11340
  374. 11320 PW$=MID$(S$,PW+1):A1$="Password ?":GOSUB 13020:C=1:GOSUB 13260:C=0:
  375.  
  376.       IF B$<>PW$ THEN A$="Incorrect.":GOSUB 13020:GOSUB 13020:CLOSE:RETURN
  377. 11340 S$=" 0"+":"+STR$(G):GOSUB 16000:PUT#1,RE:CLOSE
  378. 11360 A$="Updating message file...":GOSUB 13020
  379. 11380 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
  380. 11400 MI=MI+1:IF MI>MZ THEN 11520 ELSE G=M(MI,1)
  381. 11420 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 11400
  382. 11440 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 16000:PUT#1,RE:M(MI,1)=0
  383. 11460 CLOSE#1:A$="Updating message count...":GOSUB 13020
  384. 11480 OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:
  385.  
  386.      GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS:CLOSE
  387. 11500 GOSUB 13020:A$="Message killed.":GOSUB 13020:GOSUB 13020:RETURN
  388. 11520 CLOSE:A$="Message not found.":GOSUB 13020:GOSUB 13020:RETURN
  389. 12000 REM
  390. 12020 REM ***DISPLAY USER FILE***
  391. 12040 REM
  392. 12060 GOSUB 12220:OPEN "R",1,"A:USERS",62:FIELD#1,1 AS MU$,1 AS SU$,60 AS RR$:
  393.  
  394.       FIELD#1,10 AS NN$:GET#1,1:NU=VAL(NN$)
  395. 12080 FOR I=NU+1 TO 2 STEP -1:
  396.  
  397.       GET#1,I:IF SU$<>"*" THEN GOSUB 16500:A$=S$:GOSUB 13020
  398. 12100 IF BK THEN 12140
  399. 12120 NEXT I
  400. 12140 CLOSE:GOSUB 13020:RETURN
  401. 12160 REM
  402. 12180 REM **** PRINT CONTROL-CHAR INFO
  403. 12200 REM
  404. 12220 GOSUB 13020
  405. 13000 A$="Use ctl-K to abort, ctl-S to pause."
  406. 13020 REM
  407. 13040 REM ***PRINT STRING FROM A$ ON CONSOLE***
  408. 13060 REM
  409. 13080 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
  410. 13100 IF A1$<>"" THEN A$=A1$:A1$=""
  411. 13120 IF RIGHT$(A$,1)="?" OR N=1 THEN PRINT A$;:PP$=A$:GOTO 13180
  412. 13140 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
  413. 13160 IF BI=11 THEN BK=-1:GOTO 13220 ELSE PRINT A$
  414. 13180 A=A+LEN(A$)
  415. 13200 IF N$+O$="SYSOP" AND INP(255)=1 THEN LPRINT A$;:
  416.  
  417.          IF N=0 AND RIGHT$(A$,1)<>"?" THEN LPRINT
  418. 13220 A$="":N=0
  419. 13240 RETURN
  420. 13260 REM
  421. 13280 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
  422. 13300 REM
  423. 13320 IF BEL AND SAV$="" THEN PRINT CHR$(7);
  424. 13340 B$="":BK=0
  425. 13360 IF SAV$="" THEN LINE INPUT SAV$
  426. 13380 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 13420
  427. 13400 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
  428. 13420 IF LEN(B$)=0 THEN RETURN
  429. 13440 IF C=0 THEN 13480
  430. 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
  431. 13480 IF LEN(B$)<62 THEN 13580
  432. 13500 A$="Input line too long - would be truncated to:":GOSUB 13020
  433. 13520 B$=LEFT$(B$,61):PRINT B$
  434. 13540 LINE INPUT "Retype line (Y/N)?";QQ$:QQ$=LEFT$(QQ$,1)
  435. 13560 IF QQ$="Y" OR QQ$="y" THEN PRINT PP$;:SAV$="":GOTO 13260
  436. 13580 D=D+LEN(B$):RETURN
  437. 13600 RETURN
  438. 13620 REM
  439. 15000 REM ***ON ERROR HANDLER***
  440. 15010 IF ERL=430 THEN RESUME 450
  441. 15020 IF ERL=18030 THEN RESUME 18050
  442. 15030 IF ERL=700 THEN RE=0:RESUME 710
  443. 15040 IF ERL=740 THEN M=0:RESUME 750
  444. 15050 IF ERL=760 THEN C=0:RESUME 770
  445. 15060 IF ERL=780 THEN U=0:RESUME 790
  446. 15070 IF ERL=6060 THEN V=0:RESUME 6080
  447. 15080 IF ERL=6800 THEN C=0:RESUME 6820
  448. 15090 IF ERL=6840 THEN C=0:RESUME 6860
  449. 15100 RESUME NEXT
  450. 16000 REM
  451. 16010 REM FILL AND STORE DISK RECORD
  452. 16020 REM
  453. 16030 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  454. 16040 RETURN
  455. 16500 REM
  456. 16510 REM UNPACK DISK RECORD
  457. 16520 REM
  458. 16530 ZZ=LEN(RR$)-2
  459. 16540 WHILE MID$(RR$,ZZ,1)=" "
  460. 16550 ZZ=ZZ-1:IF ZZ=1 THEN 16570
  461. 16560 WEND
  462. 16570 S$=LEFT$(RR$,ZZ)
  463. 16580 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
  464. 16590 RETURN
  465. 17000 REM
  466. 17010 REM *** TOGGLE EXPERT USER MODE
  467. 17020 REM
  468. 17030 XPR=NOT XPR:RETURN
  469. 17040 REM
  470. 17050 REM *** TOGGLE BELL PROMPT
  471. 17060 REM
  472. 17070 BEL=NOT BEL:RETURN
  473. 18000 REM
  474. 18010 REM SUBROUTINE TO PRINT A FILE
  475. 18020 REM
  476. 18030 OPEN "I",1,"A:"+FIL$:BK=0
  477. 18040 IF EOF(1) OR BK THEN 18050 ELSE LINE INPUT #1,A$:GOSUB 13020:GOTO 18040
  478. 18050 CLOSE #1:RETURN
  479. 18060 REM FULL SUMMARY
  480. 18070 QU=0:GOSUB 9000:RETURN
  481. 18080 REM QUICK SUMMARY
  482. 18090 QU=-1:GOSUB 9000:RETURN
  483. 19000 REM PRINT "CALLERS" FILE...FOR SYSOP ONLY (PRIVATE CMD)
  484. 19010 GOSUB 13020
  485. 19020 IF N$+O$<>"SYSOP" THEN 1200' IF NOT SYSOP, SAY "I DON'T UNDERSTAND".
  486. 19030 OPEN "R",1,"A:CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
  487. 19040 CA=CN
  488. 19050 FOR CNT=SIZ+1 TO 2 STEP -1
  489. 19060 GET #1,CNT:GOSUB 16500:A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 13020:IF BK THEN 19090
  490. 19070 CA=CA-1
  491. 19080 NEXT CNT
  492. 19090 CLOSE:A$= "END OF CALLERS.":GOSUB 13020:GOSUB 13020:RETURN
  493. 19100 REM TEST FOR PERSONAL MESSAGES
  494. 19110 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")=0 THEN 19160
  495. 19120 PERS=-1
  496. 19130 IF N$+O$="SYSOP" THEN 19160
  497. 19140 GET #1,RE+3:GOSUB 19170:IF OK THEN 19160
  498. 19150 GET #1,RE+2:GOSUB 19170
  499. 19160 RETURN
  500. 19170 REM TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME
  501. 19180 IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN OK=-1 ELSE OK=0
  502. 19190 RETURN
  503. 19200 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
  504. 19210 RETURN
  505.