home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol007 / ribbs.asc < prev    next >
Encoding:
Text File  |  1984-04-29  |  16.2 KB  |  370 lines
  1. 100 REM *****RIBBS - "Remote Iselin Bulletin Board System"*****
  2. 120 REM by Bruce R Ratoff
  3. 140 REM adapted from Xitan Basic SJBBS by Howard Moulton
  4. 160 REM Last change: 9/19/80
  5. 180 REM
  6. 200 REM
  7. 220 DEFINT A-Z
  8. 240 DIM A$(17),M(400,2)
  9. 260 POKE 0,&HCD
  10. 280 ON ERROR GOTO 13500
  11. 300 REM
  12. 320 REM SIGNON FUNCTIONS
  13. 340 REM
  14. 350 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
  15. 360 BK=0:GOSUB 13000:A$="Iselin N.J. RIBBS ":GOSUB 13000
  16. 380 A$="Program exchange on request.":GOSUB 13000
  17. 400 OPEN "I",1,"A:INFO":BK=0:N=0
  18. 420 IF EOF(1) OR BK THEN 440 ELSE LINE INPUT#1,A$:GOSUB 13000:GOTO 420
  19. 440 CLOSE#1:OPEN "I",1,"A:BULLETIN":BK=0:N=0
  20. 460 IF EOF(1) OR BK THEN 480 ELSE LINE INPUT#1,A$:GOSUB 13000:GOTO 460
  21. 480 CLOSE#1:BK=0:A$="Prompting bell means system is ready for input.":GOSUB 13000
  22. 500 GOSUB 13000
  23. 520 A$="What is your FIRST name ?":GOSUB 13000:C=1:GOSUB 13200:C=0:N$=B$:
  24.     IF N$="" THEN 520
  25. 530 IF N$<"A" THEN 520
  26. 540 A$="What is your LAST name ?":GOSUB 13000:C=1:GOSUB 13200:C=0:O$=B$:
  27.     IF O$="" THEN 520
  28. 550 IF O$<"A" THEN 520
  29. 560 IF N$="SYSOP" AND O$="BRUCE" THEN O$="":GOTO 780
  30. 570 IF N$="SYSOP" THEN 520
  31. 580 V=0:OPEN "R",1,"A:USERS",62:FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$):
  32.     A$="Checking user file...":GOSUB 13000
  33. 600 FOR I=2 TO NU+1:GET#1,I:
  34.     IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN MF$=LEFT$(RR$,1):CLOSE:
  35.        GOSUB 13000:GOTO 780
  36. 620 NEXT I
  37. 640 V=1:A$="Where (City,State) are you calling from ?":GOSUB 13000:
  38.     C=1:GOSUB 13200:C=0:ST$=B$:IF ST$="" THEN 540
  39. 660 A$="Hello "+N$+" "+O$+" from "+ST$:GOSUB 13000:
  40.     A$="Did I misspell anything ?":GOSUB 13000:C=1:GOSUB 13200:C=0:
  41.     IF LEFT$(B$,1)="Y" THEN 520
  42. 680 A$="This checking is only done the first time you call.":GOSUB 13000
  43. 700 S$="  "+N$+" "+O$+" "+ST$:RL=62:GOSUB 14000:NU=NU+1:PUT#1,NU+1:
  44.     S$=STR$(NU):GOSUB 14000:PUT#1,1:CLOSE
  45. 720 GOSUB 13000:OPEN "I",1,"A:NEWCOM":BK=0
  46. 740 IF EOF(1) OR BK THEN 760 ELSE LINE INPUT#1,A$:GOSUB 13000:GOTO 740
  47. 760 CLOSE:GOSUB 13000:MF$=" "
  48. 780 A$="Logging name to disk...":N=1:GOSUB 13000:OPEN "R",1,"A:CALLERS",60:
  49.     FIELD#1,60 AS RR$:GET#1,1
  50. 800 RE=VAL(RR$)+1:S$=STR$(RE):RL=60:GOSUB 14000:PUT#1,1:RE=RE+1
  51. 820 S$=N$+" "+O$+" "+ST$:GOSUB 14000:PUT#1,RE:CLOSE#1
  52. 840 BK=0:GOSUB 13000:A$="Active # of msg's ":N=1:GOSUB 13000:
  53.     OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MSGS:M=VAL(RR$)
  54. 860 A$=STR$(M)+".":GOSUB 13000
  55. 880 A$="You are caller # ":N=1:GOSUB 13000:GET#1,CALLS
  56. 900 A$=STR$(VAL(RR$)+1):LSET RR$=A$:GOSUB 13000:PUT#1,CALLS
  57. 920 A$="Next msg # will be ":N=1:GOSUB 13000:GET#1,MNUM:U=VAL(RR$)
  58. 940 A$=STR$(U+1):GOSUB 13000:CLOSE:GOSUB 13000
  59. 1000 REM
  60. 1020 REM LOOK FOR MSGS FOR THIS CALLER
  61. 1030 REM AND BUILD MESSAGE INDEX
  62. 1040 REM
  63. 1060 FT=1:MX=0:MZ=0:'FLAG FIRST TIME FOR PRINTING HEADING
  64. 1080 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,28 AS RR$
  65. 1100 BK=0:GET#1,RE:IF EOF(1) THEN 1220
  66. 1120 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 1200
  67. 1130 IF G>9998 THEN MZ=MZ-1:GOTO 1220
  68. 1140 GET#1,RE+3:GOSUB 14100:IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 1160
  69. 1145 IF N$<>"SYSOP" THEN 1200
  70. 1150 IF INSTR(S$,"BRUCE")=0 THEN 1200
  71. 1160 IF FT THEN A$="Please retrieve and kill the following message(s) left for you:":GOSUB 13000:FT=0
  72. 1180 A$=STR$(G):N=1:GOSUB 13000
  73. 1200 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 1100
  74. 1220 CLOSE:GOSUB 13000:GOSUB 13000
  75. 2000 REM
  76. 2020 REM *** MAIN COMMAND ACCEPTOR/DISPATCHER ***
  77. 2040 REM
  78. 2060 A$="Function B,E,R,S,K,G,W,C,U (or '?' if not known)?":GOSUB 13000:
  79.      C=1:GOSUB 13200:C=0
  80. 2080 IF B$="" THEN 2000
  81. 2100 FF=INSTR("BER?SKGWCU",B$)
  82. 2120 IF FF=0 THEN 2160
  83. 2140 ON FF GOTO 4000,7000,9000,6000,10000,12000,11000,5000,3000,12500
  84. 2160 A$="I don't understand '"+B$+"', "+N$+".":GOSUB 13000:GOSUB 13000:GOTO 2000
  85. 3000 REM
  86. 3020 REM ***EXIT TO CP/M***
  87. 3040 REM
  88. 3050 IF MF$="*" THEN A$="You've lost that privelege, "+N$:GOSUB 13000:GOTO 2000
  89. 3060 'A$="Password ?":GOSUB 13000:C=1:GOSUB 13200:C=0
  90. 3080 'IF B$<>"THERAT" THEN A$="+++INVALID+++":GOSUB 13000:GOSUB 13000:GOTO 2000
  91. 3100 A$="Please remember to type BYE before hanging up the phone.":GOSUB 13000:GOSUB 13000
  92. 3120 A$="To re-enter RIBBS, type:":GOSUB 13000:
  93.     A$="A>USER 3":GOSUB 13000:
  94.     A$="A>RIBBS":GOSUB 13000:GOSUB 13000
  95. 3140 A$="For info on software exchange, type:":GOSUB 13000:
  96.      A$="A>MLIST THIS-SYS.DOC":GOSUB 13000:GOSUB 13000
  97. 3160 A$="For general info, type:":GOSUB 13000:
  98.      A$="A>HELP":GOSUB 13000:GOSUB 13000
  99. 3280 POKE 4,0:A$="Entering CP/M...":GOSUB 13000:POKE 0,&HC3:SYSTEM
  100. 4000 REM
  101. 4020 REM ***DISPLAY BULLETINS***
  102. 4040 REM
  103. 4060 GOSUB 13000:A$="Use ctl-K to abort, ctl-S to pause.":GOSUB 13000
  104. 4080 OPEN "I",1,"A:BULLETIN"
  105. 4100 IF EOF(1) OR BK THEN 4120 ELSE LINE INPUT#1,A$:GOSUB 13000:GOTO 4100
  106. 4120 GOSUB 13000:CLOSE#1:GOTO 2000
  107. 5000 REM
  108. 5020 REM ***DISPLAY WELCOME MESSAGE***
  109. 5040 REM
  110. 5060 GOSUB 13000:A$="Use ctl-K to abort, ctl-S to pause.":GOSUB 13000
  111. 5080 OPEN "I",1,"A:INFO"
  112. 5100 IF EOF(1) OR BK THEN 5120 ELSE LINE INPUT#1,A$:GOSUB 13000:B=0:GOTO 5100
  113. 5120 CLOSE#1:GOSUB 13000:GOTO 2000
  114. 6000 REM
  115. 6020 REM *** DISPLAY MENU OF FUNCTIONS ***
  116. 6040 REM
  117. 6060 GOSUB 13000:A$="Functions supported:":GOSUB 13000:IF BK THEN 2000
  118. 6080 A$="S--> Scan messages     R--> Retrieve message":GOSUB 13000:IF BK THEN 2000
  119. 6100 A$="E--> Enter message     K--> Kill message":GOSUB 13000:IF BK THEN 2000
  120. 6120 A$="B--> retype Bulletins  W--> retype Welcome":GOSUB 13000:IF BK THEN 2000
  121. 6140 A$="C--> exit to CP/M      U--> list User file":GOSUB 13000:IF BK THEN 2000
  122. 6160 A$="G--> Goodbye (signoff)":GOSUB 13000:IF BK THEN 2000
  123. 6180 GOSUB 13000:A$="Software exchange is done under CP/M using":GOSUB 13000:
  124.      A$="the XMODEM program (for intelligent transfer)":GOSUB 13000:
  125.      A$="or the MLIST program (simple ASCII listing).":GOSUB 13000
  126. 6190 IF BK THEN 2000
  127. 6200 GOSUB 13000:A$="BASIC programs are stored in binary and must":GOSUB 13000:
  128.      A$="be listed using MBASIC instead of MLIST.":GOSUB 13000
  129. 6210 IF BK THEN 2000
  130. 6280 GOSUB 13000:GOTO 2000
  131. 7000 REM
  132. 7020 REM ***ENTER A NEW MESSAGE***
  133. 7040 REM
  134. 7060 F=0:GOSUB 13000:OPEN "R",1,"A:COUNTERS",5:A$="Msg # will be ":N=1:
  135.      GOSUB 13000:FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
  136. 7080 A$=STR$(V+1):GOSUB 13000:CLOSE
  137. 7100 A$="To enter msg, type in lines.":GOSUB 13000:A$="To edit, hit blank C/R.":GOSUB 13000:GOSUB 13000:F=0
  138. 7120 IF F=16 THEN A$="Msg full.":GOSUB 13000:GOTO 7180
  139. 7140 F=F+1:A$=STR$(F)+" ":N=1:GOSUB 13000:GOSUB 13200:IF B$="" THEN F=F-1:GOTO 7180
  140. 7160 A$(F)=B$+" ":GOTO 7120
  141. 7180 GOSUB 13000:A$="(L)ist, (E)dit, (Q)uit, (C)ontinue, (S)ave; Select?":GOSUB 13000:C=1:GOSUB 13200:C=0
  142. 7200 IF B$<>"L" THEN 7280 ELSE A$="Use ctl-K to abort, ctl-S to pause.":GOSUB 13000
  143. 7220 GOSUB 13000:FOR L=1 TO F:A$=STR$(L)+" "+A$(L)
  144. 7240 IF BK THEN 7180 ELSE GOSUB 13000:NEXT L
  145. 7260 GOSUB 13000:GOTO 7180
  146. 7280 IF B$="Q" THEN A$="Aborted":GOSUB 13000:GOTO 2000
  147. 7300 IF B$="C" THEN 7120
  148. 7320 IF B$="E" THEN 7380
  149. 7340 IF B$="S" THEN 7460
  150. 7360 GOTO 7180
  151. 7380 GOSUB 13000:A$="Line #?":GOSUB 13000:GOSUB 13200:L=VAL(B$)
  152. 7400 IF L=0 OR L>F THEN 7180 ELSE A$="Was:":GOSUB 13000:A$=A$(L):GOSUB 13000
  153. 7420 A$="Enter new line (C/R for no change):":GOSUB 13000:GOSUB 13200
  154. 7440 IF B$="" THEN 7180 ELSE A$(L)=B$+" ":GOTO 7180
  155. 7460 GOSUB 13000:A$="Todays date (MM/DD/YY)?":GOSUB 13000:GOSUB 13200:D$=B$
  156. 7480 A$="Who to (C/R for ALL)?":GOSUB 13000:C=1:GOSUB 13200:C=0:IF B$="" THEN T$="ALL" ELSE T$=B$
  157. 7500 A$="Subject?":GOSUB 13000:C=1:GOSUB 13200:C=0:K$=B$:
  158.     A$="Password ?":GOSUB 13000:C=1:GOSUB 13200:C=0:PW$=B$:
  159.     A$="Want to make any changes (Y/N)?":GOSUB 13000:C=1:GOSUB 13200:C=0:
  160.     IF LEFT$(B$,1)="Y" THEN 7180
  161. 7510 IF PW$<>"" THEN PW$=";"+PW$
  162. 7520 A$="Updating summary file, ":N=1:GOSUB 13000
  163. 7540 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  164. 7620 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 14000:PUT#1,RE
  165. 7640 RE=RE+1:S$=D$:GOSUB 14000:PUT#1,RE
  166. 7660 RE=RE+1:S$=N$+" "+O$:GOSUB 14000:PUT#1,RE
  167. 7680 RE=RE+1:S$=T$:GOSUB 14000:PUT#1,RE
  168. 7700 RE=RE+1:S$=K$:GOSUB 14000:PUT#1,RE
  169. 7720 RE=RE+1:S$=STR$(F):GOSUB 14000:PUT#1,RE
  170. 7730 RE=RE+1:S$=" 9999":GOSUB 14000:PUT#1,RE
  171. 7740 CLOSE#1
  172. 7760 A$="next msg #, ":N=1:GOSUB 13000:
  173.      OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$
  174. 7780 GET#1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MNUM
  175. 7800 A$="active msg's, ":N=1:GOSUB 13000
  176. 7820 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MSGS:CLOSE#1
  177. 7840 A$="and msg file.":N=1:GOSUB 13000:OPEN "R",1,"A:MESSAGES",65:RL=65
  178. 7860 FIELD#1,65 AS RR$
  179. 7880 RE=MX+1
  180. 7960 S$=STR$(V+1):GOSUB 14000:PUT#1,RE
  181. 7980 RE=RE+1:S$=D$:GOSUB 14000:PUT#1,RE
  182. 8000 RE=RE+1:S$=N$+" "+O$:GOSUB 14000:PUT#1,RE
  183. 8020 RE=RE+1:S$=T$:GOSUB 14000:PUT#1,RE
  184. 8040 RE=RE+1:S$=K$:GOSUB 14000:PUT#1,RE
  185. 8060 RE=RE+1:S$=STR$(F):GOSUB 14000:PUT#1,RE
  186. 8080 RE=RE+1
  187. 8100 FOR P=1 TO F:S$=A$(P):GOSUB 14000:PUT#1,RE:RE=RE+1:NEXT P:
  188.      S$=" 9999":GOSUB 14000:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:
  189.      M(MZ,1)=V+1:M(MZ,2)=F
  190. 8120 GOSUB 13000:GOSUB 13000:U=U+1:GOTO 2000
  191. 9000 REM
  192. 9020 REM ***RETRIEVE MESSAGE***
  193. 9040 REM
  194. 9060 GOSUB 13000:A$="Msg # to retrieve (C/R to end)?":GOSUB 13000:GOSUB 13200:GOSUB 13000
  195. 9080 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  196. 9100 IF M<1 THEN GOSUB 13000:GOTO 2000
  197. 9120 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13000:GOTO 9060
  198. 9140 A$="Use ctl-K to abort, ctl-S to pause.":GOSUB 13000:GOSUB 13000
  199. 9160 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,63 AS RR$:MI=0
  200. 9180 MI=MI+1:IF (MI>MZ) OR BK THEN 9540 ELSE G=M(MI,1)
  201. 9200 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 9180
  202. 9220 IF G>M THEN 9460
  203. 9260 RE=RE+1:GET#1,RE:GOSUB 14100:D$=S$
  204. 9280 RE=RE+1:GET#1,RE:GOSUB 14100:NO$=S$
  205. 9300 RE=RE+1:GET#1,RE:GOSUB 14100:T$=S$
  206. 9320 RE=RE+1:GET#1,RE:GOSUB 14100:K$=S$
  207. 9340 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 13000
  208. 9360 A$="Msg #"+STR$(G)+" was entered on date "+D$+" from "+NO$:GOSUB 13000
  209. 9380 A$="To "+T$+" about "+K$:GOSUB 13000:GOSUB 13000
  210. 9400 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 14100:A$=S$:GOSUB 13000
  211. 9420 IF BK THEN 9540
  212. 9440 RE=RE+1:NEXT P:GOSUB 13000
  213. 9460 IF INSTR(B$,";") THEN B$=MID$(B$,INSTR(B$,";")+1):
  214.      M=VAL(B$):RE=1:IF M>0 THEN MI=0:GOTO 9180
  215. 9480 IF RIGHT$(B$,1)<>"+" THEN CLOSE:GOTO 9020
  216. 9500 M=M+1:MI=0:RE=1
  217. 9520 IF M<=U AND NOT BK THEN 9180
  218. 9540 CLOSE:A$="End of msg's.":GOSUB 13000:GOSUB 13000:D$="":NO$="":GOTO 2000
  219. 10000 REM
  220. 10020 REM ***SUMMARIZE MESSAGES***
  221. 10040 REM
  222. 10060 A$="Selective scan ?":GOSUB 13000:C=1:GOSUB 13200:C=0:B$=LEFT$(B$,1):
  223.      IF B$<>"Y" THEN ST=0:GOTO 10140
  224. 10080 A$="(F)rom, (T)o, or (S)ubject ?":GOSUB 13000:C=1:GOSUB 13200:C=0:
  225.      B$=LEFT$(B$,1):ST=INSTR("FTS",B$):IF ST=0 THEN 2000
  226. 10100 A$="Search string ?":GOSUB 13000:C=1:GOSUB 13200:C=0:SV$=B$:
  227.      IF SV$="" THEN 2000
  228. 10120 M=1:GOTO 10240
  229. 10140 GOSUB 13000:A$="Msg # to start (C/R to end)?":GOSUB 13000:GOSUB 13200:GOSUB 13000
  230. 10160 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  231. 10180 GOSUB 13160
  232. 10200 IF M<1 THEN 2000
  233. 10220 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13000:GOTO 10020
  234. 10240 A$="Use ctl-K to abort, ctl-S to pause.":GOSUB 13000:GOSUB 13000
  235. 10260 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,28 AS RR$
  236. 10280 GET#1,RE
  237. 10300 IF EOF(1) OR BK THEN 10660 ELSE G=VAL(RR$)
  238. 10310 IF G>9998 THEN 10660
  239. 10320 IF G<M THEN RE=RE+6:GOTO 10280
  240. 10340 IF ST=0 THEN 10380
  241. 10360 GET#1,RE+ST+1:GOSUB 14100:IF INSTR(S$,SV$)=0 THEN RE=RE+6:GOTO 10280
  242. 10380 A$="Msg #"+STR$(G)+"  Date entered: ":N=1:GOSUB 13000
  243. 10400 IF BK THEN 10660
  244. 10420 RE=RE+1:GET#1,RE:GOSUB 14100:A$=S$+"  From: ":N=1:GOSUB 13000
  245. 10440 IF BK THEN 10660
  246. 10460 RE=RE+1:GET#1,RE:GOSUB 14100:A$=S$:GOSUB 13000
  247. 10480 IF BK THEN 10660
  248. 10500 A$="To: ":N=1:GOSUB 13000:RE=RE+1:GET#1,RE:GOSUB 14100:A$=S$:GOSUB 13000
  249. 10520 IF BK THEN 10660
  250. 10540 A$="About: ":N=1:GOSUB 13000:RE=RE+1:GET#1,RE:GOSUB 14100:A$=S$:GOSUB 13000
  251. 10560 IF BK THEN 10660
  252. 10580 A$="Size: ":N=1:GOSUB 13000:RE=RE+1:GET#1,RE:GOSUB 14100:A$=S$:GOSUB 13000
  253. 10600 IF BK THEN 10660
  254. 10620 GOSUB 13000
  255. 10640 IF U=G OR BK THEN 10660 ELSE RE=RE+1:GOTO 10280
  256. 10660 GOSUB 13000:A$="***** End of summary *****":GOSUB 13000:
  257.      GOSUB 13000:GOSUB 13000:CLOSE:GOTO 2000
  258. 11000 REM
  259. 11020 REM ***GOODBYE***
  260. 11040 REM
  261. 11060 GOSUB 13000:A$="Want to leave any comments?":GOSUB 13000:C=1:GOSUB 13200:C=0
  262. 11080 IF LEFT$(B$,1)<>"Y" THEN 11240
  263. 11100 OPEN "R",1,"A:COMMENTS",65:FIELD#1,65 AS RR$:GET#1,1:RE=VAL(RR$)+1:RL=65
  264. 11110 IF RE=1 THEN RE=2
  265. 11120 S$="From: "+N$+" "+O$:GOSUB 14000
  266. 11140 PUT#1,RE
  267. 11160 A$="Enter comments; to end, hit C/R.":GOSUB 13000
  268. 11180 A$="Ok>":N=1:GOSUB 13000:GOSUB 13200
  269. 11200 IF B$="" THEN 11220 ELSE RE=RE+1:S$=B$:RL=65:GOSUB 14000:PUT#1,RE:GOTO 11180
  270. 11220 S$=STR$(RE):RL=65:GOSUB 14000:PUT#1,1:CLOSE
  271. 11240 GOSUB 13000:
  272.      A$="Character count:  "+STR$(A)+" typed by system - "+STR$(D)+
  273.      " typed by you.":GOSUB 13000:
  274.      A$="From Bruce: thanks for calling, "+N$+".":GOSUB 13000
  275. 11260 A$="***** End of connection ******":GOSUB 13000:GOSUB 13000:SYSTEM
  276. 12000 REM
  277. 12020 REM ***KILL A MESSAGE***
  278. 12040 REM
  279. 12060 GOSUB 13000:A$="Message # to kill?":GOSUB 13000:GOSUB 13200
  280. 12080 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  281. 12100 IF M<1 THEN GOSUB 13000:GOTO 2000
  282. 12120 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 13000:GOTO 12040
  283. 12140 A$="Scanning summary file...":GOSUB 13000:
  284.      OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  285. 12160 GET#1,RE
  286. 12180 IF EOF(1) THEN 12420 ELSE G=VAL(RR$)
  287. 12190 IF G>9998 THEN 12420
  288. 12200 IF G<M THEN RE=RE+6:GOTO 12160
  289. 12220 IF G>M THEN 12420 ELSE GOSUB 14100:PW=INSTR(S$,";"):PW$="":
  290.       IF PW=0 OR N$+O$="SYSOP" THEN 12230 ELSE PW$=MID$(S$,PW+1)
  291. 12225 A$="Password ?":GOSUB 13000:C=1:GOSUB 13200:C=0:
  292.       IF B$<>PW$ THEN A$="Incorrect.":GOSUB 13000:GOSUB 13000:CLOSE:GOTO 2000
  293. 12230 S$=" 0":GOSUB 14000:PUT#1,RE:CLOSE
  294. 12240 A$="Updating message file...":GOSUB 13000
  295. 12260 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
  296. 12280 MI=MI+1:IF MI>MZ THEN 12420 ELSE G=M(MI,1)
  297. 12300 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 12280
  298. 12320 IF G=M THEN S$="0":RL=65:GOSUB 14000:PUT#1,RE:M(MI,1)=0
  299. 12360 CLOSE#1:A$="Updating message count...":GOSUB 13000
  300. 12380 OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:
  301.      GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS:CLOSE
  302. 12400 GOSUB 13000:A$="Message killed.":GOSUB 13000:GOSUB 13000:GOTO 2000
  303. 12420 CLOSE:A$="Message not found.":GOSUB 13000:GOSUB 13000:GOTO 2000
  304. 12500 REM
  305. 12520 REM ***DISPLAY USER FILE***
  306. 12540 REM
  307. 12560 GOSUB 13000:A$="Use ctl-K to abort, ctl-S to pause.":GOSUB 13000:GOSUB 13000
  308. 12580 OPEN "R",1,"A:USERS",62:FIELD#1,1 AS MU$,1 AS SU$,60 AS RR$:
  309.       FIELD#1,10 AS NN$:GET#1,1:NU=VAL(NN$)
  310. 12600 FOR I=NU+1 TO 2 STEP -1:
  311.       GET#1,I:IF SU$<>"*" THEN GOSUB 14100:A$=S$:GOSUB 13000
  312. 12620 IF BK THEN 12660
  313. 12640 NEXT I
  314. 12660 CLOSE:GOSUB 13000:GOTO 2000
  315. 13000 REM
  316. 13020 REM ***PRINT STRING FROM A$ ON CONSOLE***
  317. 13040 REM
  318. 13060 IF RIGHT$(A$,1)="?" OR N=1 THEN PRINT A$;:PP$=A$:GOTO 13140
  319. 13080 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
  320. 13100 IF BI=11 THEN BK=-1:GOTO 13160 ELSE PRINT A$
  321. 13140 A=A+LEN(A$)
  322. 13150 IF N$+O$="SYSOP" AND INP(255)=1 THEN LPRINT A$;:
  323.          IF N=0 AND RIGHT$(A$,1)<>"?" THEN LPRINT
  324. 13160 A$="":N=0
  325. 13180 RETURN
  326. 13200 REM
  327. 13220 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
  328. 13240 REM
  329. 13260 PRINT CHR$(7);:B$="":BK=0
  330. 13280 LINE INPUT B$:IF LEN(B$)=0 THEN RETURN
  331. 13300 IF C=0 THEN 13340
  332. 13320 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
  333. 13340 IF LEN(B$)<63 THEN 13440
  334. 13360 A$="Input line too long - would be truncated to:":GOSUB 13000
  335. 13380 B$=LEFT$(B$,62):PRINT B$
  336. 13400 LINE INPUT "Retype line (Y/N)?";QQ$:QQ$=LEFT$(QQ$,1)
  337. 13420 IF QQ$="Y" OR QQ$="y" THEN PRINT PP$;:GOTO 13200
  338. 13440 D=D+LEN(B$):RETURN
  339. 13500 REM
  340. 13520 REM ***ON ERROR HANDLER***
  341. 13540 REM
  342. 13560 IF ERL=400 THEN RESUME 440
  343. 13580 IF ERL=440 THEN RESUME 480
  344. 13600 IF ERL=720 THEN RESUME 760
  345. 13620 IF ERL=4080 THEN RESUME 4120
  346. 13640 IF ERL=5080 THEN RESUME 5120
  347. 13660 IF ERL=780 THEN RE=0:RESUME 800
  348. 13680 IF ERL=840 THEN M=0:RESUME 860
  349. 13700 IF ERL=880 THEN C=0:RESUME 900
  350. 13720 IF ERL=920 THEN U=0:RESUME 940
  351. 13740 IF ERL=7060 THEN V=0:RESUME 7080
  352. 13760 IF ERL=7760 THEN C=0:RESUME 7780
  353. 13780 IF ERL=7800 THEN C=0:RESUME 7820
  354. 13800 RESUME NEXT
  355. 14000 REM
  356. 14020 REM FILL AND STORE DISK RECORD
  357. 14040 REM
  358. 14060 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  359. 14080 RETURN
  360. 14100 REM
  361. 14120 REM UNPACK DISK RECORD
  362. 14140 REM
  363. 14160 ZZ=LEN(RR$)-2
  364. 14180 WHILE MID$(RR$,ZZ,1)=" "
  365. 14200 ZZ=ZZ-1:IF ZZ=1 THEN 14240
  366. 14220 WEND
  367. 14240 S$=LEFT$(RR$,ZZ)
  368. 14260 RETURN
  369. 14280 END
  370.