home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol092 / rbbs31.asc < prev    next >
Text File  |  1984-04-29  |  26KB  |  716 lines
  1. 10 REM RBBS VERSION 3.1 (Last updated: 09/12/82)
  2. 20 REM *****RBBS - "Remote Bulletin Board System"*****
  3. 30 REM
  4. 40 REM  MODS BY SFK 08/01/82
  5. 50 REM  MORE MODS BY FJW 08/15/82
  6. 60 REM  STILL MORE MODS BY FJW 09/06/82
  7. 70 REM
  8. 80 REM FOR MORE REMARKS, SEE ORIGINAL VERSION 2.4, PLUS RBBS-RTN.001,
  9. 90 REM PLUS THE DOC FILE FOR THIS VERSION (TO BE WRITTEN)
  10. 100 REM
  11. 110 REM CUSTOMIZED VERSION FOR THE ARMTE HYBRID COMPUTER FACILITY RBBS
  12. 120 REM
  13. 130 REM  **********************************************
  14. 140 DEFINT A-Z
  15. 150 DIM A$(25),M(200,2)
  16. 160 REM
  17. 170 REM   LOCAL MODS SECTION  (SEE ALSO EXIT ROUTINE)
  18. 180 REM
  19. 190 VERS1$="ARMTE Hybrid Computer Facility RBBS ...."
  20. 200 SYS1$="FRANK":SYS2$="WANCHO" 'SYSOP'S NAME FOR NORMAL SIGNON
  21. 210 P1$="CPM":P2$="WANCHO":P3$="NOPASS":PC$="" 'DEFAULT PWDS
  22. 220 DSK$="B:":ERS$=CHR$(8)+" "+CHR$(8):BSL$=CHR$(8)+"/"+CHR$(8)
  23. 230 REM
  24. 240 REM   START OF CODE
  25. 250 REM
  26. 260 POKE 0,&HCD  ' CHANGE JMP TO CALL AT 0
  27. 270 INC=1
  28. 280 ON ERROR GOTO 5130
  29. 290 RFLG=PEEK(&H5D):POKE &H5D,&H20
  30. 300 RTNOKFLG=PEEK(&H5B):POKE &H5B,120 'Legal return flag.
  31. 310 REM
  32. 320 REM SIGNON FUNCTIONS
  33. 330 REM
  34. 340 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1:NW=0
  35. 350 BK=0:GOSUB 4870:A$=VERS1$:N=1:GOSUB 4870
  36. 360 OPEN "I",1,DSK$+"PWDS":IF EOF(1) THEN 380
  37. 370 INPUT #1,P1$,P2$,P3$,PC$ : REM DIRECT PW, SYSOP PW, CP/M PW, PROMPT
  38. 380 CLOSE #1
  39. 390 BEL=-1:XPR=0  'INITIAL BELL ON, NOT EXPERT
  40. 400 A$="Version 3.1":N=1:GOSUB 4870:GOSUB 4870:GOSUB 4870:SAV$=""
  41. 410 IF RFLG<>ASC("P") THEN 510
  42. 420 IF RTNOKFLG<>ASC("x") THEN 510
  43. 430 V=0:INC=0 ' SO CALLER NUMBER SAYS SAME
  44. 440 OPEN "I",1,DSK$+"LASTCALR":INPUT #1,N$,O$:CLOSE
  45. 450 A$="Welcome back, "
  46. 460 IF N$<>"SYSOP" THEN 480
  47. 470 CN$=N$:O$="":CO$=O$:A$=A$+N$+".":GOSUB 4870:GOSUB 4870:V=1:GOTO 870
  48. 480 GOSUB 7130:V=1
  49. 490 A$=A$+CN$+" "+CO$+".":GOSUB 4870:GOSUB 4870
  50. 500 T01$=N$:T02$=O$:GOSUB 6480:MF$=MFJ$:GOTO 870
  51. 510 GOSUB 1740:IF NOT BK THEN NW=1:GOSUB 1700'REM PRINT INFO, THEN BULLETINS
  52. 520 GOSUB 4870:BK=0
  53. 530 GOSUB 4870
  54. 540 A1$="Enter your FIRST Name: ":N=1:GOSUB 4870
  55. 550 C=1:GOSUB 5000:N$=B$:IF N$="" THEN 540
  56. 560 IF N$=P1$ THEN POKE &H5B,0:GOTO 1660 ' DIRECT CPM EXIT
  57. 570 IF N$<"A" OR LEN(N$)=1 THEN 540
  58. 580 A1$="Enter your LAST Name:  ":N=1:GOSUB 4870
  59. 590 C=1:IF N$="SYSOP" THEN C=2
  60. 600 GOSUB 5000:O$=B$:IF O$="" THEN 540
  61. 610 IF O$<"A" OR LEN(O$)=1 THEN 540
  62. 620 IF N$="SYSOP" AND O$=P2$ THEN O$="":CN$=N$:CO$="":GOTO 820
  63. 630 IF N$="SYSOP" THEN 540
  64. 640 A$="Checking User file...":GOSUB 4870
  65. 650 V=0:T01$=N$:T02$=O$:OK=0:GOSUB 6480:IF OK THEN MF$=MFJ$:GOTO 660 ELSE 700
  66. 660 T=0
  67. 670 T=T+1:IF T=4 THEN 4260 ELSE A1$="Enter your PASSWORD: "
  68. 680 N=1:GOSUB 4870:C=2:GOSUB 5000:UPW$=B$:IF UPW$="" THEN 670
  69. 690 IF UPW$=S04$ THEN 820 ELSE 670
  70. 700 A1$="Are you a New User? ":GOSUB 6710
  71. 710 IF NOT OK THEN A$="OK, let's try again.":GOSUB 4870:GOTO 540
  72. 720 V=1:GOSUB 6290 'GET USER TO SET HIS OWN PASSWORD
  73. 730 A1$="Enter YOUR City, State: ":N=1:GOSUB 4870
  74. 740 C=1:GOSUB 5000:S03$=B$:IF S03$="" THEN 730
  75. 750 GOSUB 7130
  76. 760 A$="Hello "+CN$+" "+CO$+" from "+S03$:GOSUB 4870
  77. 770 A1$="Is anything misspelled? ":GOSUB 6710:IF OK THEN 540
  78. 780 HM=0:S05$=STR$(HM):S$="  "+N$+";"+O$+";"+S03$+";"+S04$+";"+S05$
  79. 790 OPEN "R",1,DSK$+"USERS",62:FIELD#1,62 AS RR$
  80. 800 RL=62:GOSUB 5280:NU=NU+1:PUT#1,NU+1:S$=STR$(NU):GOSUB 5280:PUT#1,1:CLOSE
  81. 810 FIL$="NEWCOM":GOSUB 5510:MF$=" "
  82. 820 A$="Logging name to disk...":GOSUB 4870:RE=1
  83. 830 OPEN "R",1,DSK$+"CALLERS",60:FIELD#1,60 AS RR$:GET#1,1:RE=VAL(RR$)+1
  84. 840 S$=STR$(RE):RL=60:GOSUB 5280:PUT#1,1:RE=RE+1
  85. 850 S$=N$+" "+O$+" "+S03$:GOSUB 5280:PUT#1,RE:CLOSE#1
  86. 860 OPEN "O",1,DSK$+"LASTCALR":PRINT #1,N$;",";O$:CLOSE
  87. 870 PRINT
  88. 880 IF V=0 THEN IF N$<>"SYSOP" THEN GOSUB 7130
  89. 890 REM GOSUB 7140
  90. 900 BK=0:GOSUB 4870:CN=1:M=0:U=0
  91. 910 OPEN "R",1,DSK$+"COUNTERS",5:FIELD#1,5 AS RR$
  92. 920 GET#1,CALLS:CN=VAL(RR$)+INC
  93. 930 GET#1,MSGS:M=VAL(RR$)
  94. 940 GET#1,MNUM:U=VAL(RR$)
  95. 950 A$="You are caller number:      ":N=1:GOSUB 4870
  96. 960 A$=STR$(CN):LSET RR$=A$
  97. 970 A$=SPACE$(4-LEN(STR$(CN)))+STR$(CN):GOSUB 4870:PUT#1,CALLS:GOSUB 4870
  98. 980 A$="Number of Active Messages:  ":N=1:GOSUB 4870
  99. 990 A$=SPACE$(4-LEN(STR$(M)))+STR$(M):GOSUB 4870
  100. 1000 A$="Last System Message Number: ":N=1:GOSUB 4870
  101. 1010 A$=SPACE$(4-LEN(STR$(U)))+STR$(U):GOSUB 4870:CLOSE
  102. 1020 IF HM=0 THEN 1050
  103. 1030 A$="Your Last Message Number:   ":N=1:GOSUB 4870
  104. 1040 A$=SPACE$(4-LEN(STR$(HM)))+STR$(HM):GOSUB 4870
  105. 1050 GOSUB 4870:IHM=HM
  106. 1060 REM
  107. 1070 REM LOOK FOR MSGS FOR THIS CALLER
  108. 1080 REM AND BUILD MESSAGE INDEX
  109. 1090 REM
  110. 1100 FT=-1:MX=0:MZ=0:IU=0:CNT=0:G=0
  111. 1110 OPEN "R",1,DSK$+"SUMMARY",30:RE=1:FIELD#1,28 AS RR$
  112. 1120 BK=0:GET#1,RE:IF EOF(1) THEN 1260
  113. 1130 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 1250 ' G=0 =DELETED
  114. 1140 IF IU=0 THEN IU=G
  115. 1150 IF G>9998 THEN MZ=MZ-1:GOTO 1260
  116. 1160 GET#1,RE+3:GOSUB 5330
  117. 1170 I=INSTR(S$," "):IF I=0 THEN S1$=S$:S2$="":GOTO 1190
  118. 1180 S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
  119. 1190 IF S1$=N$ AND S2$=O$ THEN 1220
  120. 1200 IF N$<>"SYSOP" THEN 1250
  121. 1210 IF S1$<>SYS1$ AND S2$<>SYS2$ THEN 1250
  122. 1220 IF NOT FT THEN 1240
  123. 1230 GOSUB 4870:A$=CN$+", you have mail:":GOSUB 4870:GOSUB 4870:FT=0
  124. 1240 RX=RE:GOSUB 3770:RE=RX:CNT=CNT+1
  125. 1250 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 1120
  126. 1260 IF CNT=0 THEN 1300 ELSE GOSUB 4870:A$="Please Retrieve and Kill "
  127. 1270 IF CNT=1 THEN A$=A$+"this message."
  128. 1280 IF CNT>1 THEN A$=A$+"these messages."
  129. 1290 GOSUB 4870:GOSUB 4870
  130. 1300 CLOSE
  131. 1310 REM
  132. 1320 REM *** MAIN COMMAND ACCEPTOR/DISPATCHER ***
  133. 1330 REM
  134. 1340 A1$="Command: "
  135. 1350 IF NOT XPR THEN A1$=A1$+"B,E,R,S,K,G,W,C,U,T,X,P (or ? if not known): "
  136. 1360 N=1:GOSUB 4870:C=1:GOSUB 5000
  137. 1370 IF B$="" THEN 1340
  138. 1380 FF=INSTR("BER?SKGWCUTXP",B$):GOSUB 1390:GOTO 1340
  139. 1390 IF FF=0 THEN 1410
  140. 1400 ON FF GOTO 1700,1820,3000,1780,3510,4330,3990,1740,1470,4650,5470,5430,6380
  141. 1410 IF N$<>"SYSOP" THEN 1440
  142. 1420 IF B$="L" THEN GOSUB 5600:RETURN
  143. 1430 IF B$="Z" THEN GOSUB 5870:RETURN
  144. 1440 GOSUB 4870
  145. 1450 A$="I don't understand '"+B$+"', "+CN$+".":GOSUB 4870:GOSUB 4870
  146. 1460 SAV$="":RETURN
  147. 1470 REM
  148. 1480 REM ***EXIT TO CP/M***
  149. 1490 REM
  150. 1500 GOSUB 4870:T=0
  151. 1510 IF N$="SYSOP" THEN 1670
  152. 1520 IF MF$<>"*" THEN 1540
  153. 1530 A$=">>>ACCESS DENIED<<<":GOSUB 4870:SAV$="":RETURN
  154. 1540 IF MF$="!" THEN A$="*** Privileged user ***":GOSUB 4870:GOTO 1650
  155. 1550 IF P3$="NOPASS" THEN 1590
  156. 1560 T=T+1:IF T=4 THEN A1$="Too many errors.":GOSUB 4870:GOSUB 4870:RETURN
  157. 1570 A1$=PC$:N=1:GOSUB 4870:C=2:GOSUB 5000
  158. 1580 IF B$="" OR B$<>P3$ THEN 1560
  159. 1590 IF XPR THEN 1650
  160. 1600 REM
  161. 1610 REM ***DISPLAY ENTERCPM***
  162. 1620 REM
  163. 1630 GOSUB 4870:FIL$="ENTERCPM":NW=1:GOSUB 5510:GOSUB 4870
  164. 1640 REM
  165. 1650 IF IHM<>HM THEN MFJ$=MF$:GOSUB 6680
  166. 1660 GOSUB 4070
  167. 1670 POKE 4,0
  168. 1680 A$="Entering CP/M...":GOSUB 4870
  169. 1690 POKE 0,&HC3:SYSTEM ' RESTORE JMP AT 0
  170. 1700 REM
  171. 1710 REM ***DISPLAY BULLETINS***
  172. 1720 REM
  173. 1730 FIL$="BULLETIN":GOSUB 5510:RETURN
  174. 1740 REM
  175. 1750 REM ***DISPLAY WELCOME MESSAGE***
  176. 1760 REM
  177. 1770 FIL$="INFO":GOSUB 5510:RETURN
  178. 1780 REM
  179. 1790 REM *** DISPLAY MENU OF FUNCTIONS ***
  180. 1800 REM
  181. 1810 FIL$="MENURBBS":GOSUB 5510:GOSUB 4870:RETURN
  182. 1820 REM
  183. 1830 REM ***ENTER A NEW MESSAGE***
  184. 1840 REM
  185. 1850 F=0:GOSUB 4870:V=0
  186. 1860 OPEN "R",1,DSK$+"COUNTERS",5
  187. 1870 FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
  188. 1880 A$="Msg # will be ":N=1:GOSUB 4870
  189. 1890 A$=STR$(V+1):GOSUB 4870:CLOSE
  190. 1900 GOSUB 4870
  191. 1910 A1$="Today's date (MM/DD/YY): ":N=1:GOSUB 4870:GOSUB 5000
  192. 1920 IF B$="" THEN 1910 ELSE D$=B$
  193. 1930 A1$="To (RETURN for ALL): ":N=1:GOSUB 4870
  194. 1940 C=1:GOSUB 5000:IF B$="" THEN T$="ALL" ELSE T$=B$
  195. 1950 GOSUB 6950:IF NOT OK THEN 1930
  196. 1960 GOSUB 7060
  197. 1970 A1$="Subject: ":N=1:GOSUB 4870
  198. 1980 C=0:GOSUB 5000:IF B$="" THEN 1970 ELSE K$=B$:
  199. 1990 A1$="Password ('*' for personal): ":N=1:GOSUB 4870
  200. 2000 C=1:GOSUB 5000:PW$=B$
  201. 2010 IF T$<>"ALL" OR LEFT$(PW$,1)<>"*" THEN 2030
  202. 2020 A$="Cannot use '*' with ALL.":GOSUB 4870:GOTO 1990
  203. 2030 IF XPR THEN 2070
  204. 2040 GOSUB 4870
  205. 2050 A$="Enter up to 24 lines of text (NO semicolons).":GOSUB 4870
  206. 2060 A$="When finished, hit two RETURNs in a row.":GOSUB 4870
  207. 2070 GOSUB 4870:F=0
  208. 2080 IF F=24 THEN A$="Message full.":GOSUB 4870:GOTO 2150
  209. 2090 F=F+1
  210. 2100 A1$=SPACE$(3-LEN(STR$(F)))+STR$(F)+"> ":N=1:GOSUB 4870
  211. 2110 GOSUB 5000:IF B$="" THEN F=F-1:IF F=0 THEN 2370 ELSE 2150
  212. 2120 IF F=22 THEN PRINT "(2 lines left)"
  213. 2130 IF F=23 THEN PRINT "(Last line)"
  214. 2140 A$(F)=B$+" ":GOTO 2080
  215. 2150 GOSUB 4870
  216. 2160 A1$="Select: (H)eader, (L)ist, (E)dit, (A)bort, (C)ontinue, (S)ave: "
  217. 2170 IF XPR THEN A1$="H,L,E,A,C,S: "
  218. 2180 N=1:GOSUB 4870:C=1:GOSUB 5000
  219. 2190 IF B$="" THEN 2160
  220. 2200 FF=INSTR("HLEACS",B$):IF FF=0 THEN 2160
  221. 2210 ON FF GOTO 2410,2250,2570,2370,2080,2670
  222. 2220 REM
  223. 2230 REM LIST MESSAGE ENTERED
  224. 2240 REM
  225. 2250 GOSUB 4850:GOSUB 4870
  226. 2260 A$="Date: "+D$:GOSUB 4870
  227. 2270 A$="To:   "+TX$:GOSUB 4870
  228. 2280 A$="Re:   "+K$:GOSUB 4870
  229. 2290 A$="PW:   "+PW$:GOSUB 4870
  230. 2300 GOSUB 4910
  231. 2310 FOR L=1 TO F:A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L)
  232. 2320 IF BK THEN 2150 ELSE GOSUB 4870:NEXT L
  233. 2330 GOSUB 4870:GOTO 2150
  234. 2340 REM
  235. 2350 REM ABORT MESSAGE ENTRY
  236. 2360 REM
  237. 2370 GOSUB 4870:A$="Aborted":GOSUB 4870:GOSUB 4870:RETURN
  238. 2380 REM
  239. 2390 REM EDIT HEADER
  240. 2400 REM
  241. 2410 GOSUB 4870:A$="Enter replacement or RETURN for no change.":GOSUB 4870
  242. 2420 A1$="Date: "+D$+": ":N=1:GOSUB 4870:GOSUB 5000
  243. 2430 IF B$<>"" THEN D$=B$
  244. 2440 A1$="To:   "+TX$+": ":N=1:GOSUB 4870:C=1:GOSUB 5000
  245. 2450 IF B$="" THEN 2480
  246. 2460 TSV$=T$:T$=B$:GOSUB 6950:IF NOT OK THEN T$=TSV$:GOTO 2440
  247. 2470 GOSUB 7060
  248. 2480 A1$="Re:   "+K$+": ":N=1:GOSUB 4870:C=0:GOSUB 5000
  249. 2490 IF B$<>"" THEN K$=B$
  250. 2500 A1$="PW:   "+PW$+": ":N=1:GOSUB 4870:C=1:GOSUB 5000
  251. 2510 IF B$="" THEN 2150
  252. 2520 IF T$<>"ALL" OR LEFT$(B$,1)<>"*" THEN PW$=B$:GOTO 2150
  253. 2530 A$="Cannot use '*' with ALL.":GOSUB 4870:GOTO 2500
  254. 2540 REM
  255. 2550 REM EDIT DRAFT MESSAGE
  256. 2560 REM
  257. 2570 IF XPR THEN 2610
  258. 2580 GOSUB 4870
  259. 2590 A$="Enter Line Number to change (RETURN or 0 to end).":GOSUB 4870
  260. 2600 A$="Then enter replacement or RETURN for no change.":GOSUB 4870
  261. 2610 GOSUB 4870:A1$="Line Number: ":N=1:GOSUB 4870:C=3:GOSUB 5000
  262. 2620 L=VAL(B$):IF L=0 OR L>F THEN GOSUB 4870:GOTO 2150
  263. 2630 A$=" was:":GOSUB 4870
  264. 2640 A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L):GOSUB 4870
  265. 2650 A1$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": ":N=1:GOSUB 4870:GOSUB 5000
  266. 2660 IF B$="" THEN 2610 ELSE A$(L)=B$+" ":GOTO 2610
  267. 2670 REM
  268. 2680 REM SAVE NEW MESSAGE
  269. 2690 REM
  270. 2700 IF PW$<>"" THEN PW$=";"+PW$
  271. 2710 A$="Updating Summary file, ":N=1:GOSUB 4870
  272. 2720 OPEN "R",1,DSK$+"SUMMARY",30
  273. 2730 RE=1:FIELD#1,30 AS RR$:RL=30
  274. 2740 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 5280:PUT#1,RE
  275. 2750 RE=RE+1:S$=D$:GOSUB 5280:PUT#1,RE
  276. 2760 RE=RE+1:S$=N$+" "+O$:GOSUB 5280:PUT#1,RE
  277. 2770 RE=RE+1:S$=T$:GOSUB 5280:PUT#1,RE
  278. 2780 RE=RE+1:S$=K$:GOSUB 5280:PUT#1,RE
  279. 2790 RE=RE+1:S$=STR$(F):GOSUB 5280:PUT#1,RE
  280. 2800 RE=RE+1:S$=" 9999":GOSUB 5280:PUT#1,RE
  281. 2810 CLOSE#1
  282. 2820 A$="Next Message #, ":N=1:GOSUB 4870:VV=0
  283. 2830 OPEN "R",1,DSK$+"COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MNUM
  284. 2840 LSET RR$=STR$(V+1):PUT#1,MNUM
  285. 2850 A$="Active Messages, ":N=1:GOSUB 4870
  286. 2860 GET#1,MSGS:VV=VAL(RR$)
  287. 2870 LSET RR$=STR$(VV+1):PUT#1,MSGS:CLOSE#1
  288. 2880 A$="and Message file.":N=1:GOSUB 4870
  289. 2890 OPEN "R",1,DSK$+"MESSAGES",65
  290. 2900 RL=65:FIELD#1,65 AS RR$:RE=MX+1
  291. 2910 S$=STR$(V+1)+PW$:GOSUB 5280:PUT#1,RE
  292. 2920 RE=RE+1:S$=D$:GOSUB 5280:PUT#1,RE
  293. 2930 RE=RE+1:S$=N$+" "+O$:GOSUB 5280:PUT#1,RE
  294. 2940 RE=RE+1:S$=T$:GOSUB 5280:PUT#1,RE
  295. 2950 RE=RE+1:S$=K$:GOSUB 5280:PUT#1,RE
  296. 2960 RE=RE+1:S$=STR$(F):GOSUB 5280:PUT#1,RE
  297. 2970 RE=RE+1
  298. 2980 FOR P=1 TO F:S$=A$(P):GOSUB 5280:PUT#1,RE:RE=RE+1:NEXT P:
  299. 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
  300. 2990 GOSUB 4870:GOSUB 4870:U=U+1:RETURN
  301. 3000 REM
  302. 3010 REM ***RETRIEVE MESSAGE***
  303. 3020 REM
  304. 3030 FT=-1:G=0
  305. 3040 GOSUB 4870
  306. 3050 A2$="Retrieve":GOSUB 3450
  307. 3060 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  308. 3070 IF M<1 THEN GOSUB 4870:RETURN
  309. 3080 IF M>U THEN GOSUB 6780:GOTO 3040
  310. 3090 OPEN "R",1,DSK$+"MESSAGES",65
  311. 3100 RE=1:FIELD#1,65 AS RR$:MI=0
  312. 3110 MI=MI+1:IF (MI>MZ) OR BK THEN 3400 ELSE G=M(MI,1)
  313. 3120 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 3110
  314. 3130 IF G>M THEN 3350
  315. 3140 GOSUB 5760:IF OK OR NOT PERS THEN 3150 ELSE RE=RE+M(MI,2):GOTO 3110
  316. 3150 RE=RE+1:GET#1,RE:GOSUB 5330:D$=S$
  317. 3160 RE=RE+1:GET#1,RE:GOSUB 5330:NO$=S$
  318. 3170 RE=RE+1:GET#1,RE:GOSUB 5330:T$=S$
  319. 3180 RE=RE+1:GET#1,RE:GOSUB 5330:GOSUB 5850:K$=S$
  320. 3190 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 4870
  321. 3200 IF FT THEN GOSUB 4850:GOSUB 4870:FT=0
  322. 3210 A$="Msg #:"+STR$(G):GOSUB 4870
  323. 3220 A$="Date: "+D$:GOSUB 4870
  324. 3230 T01$=NO$:T02$="":TX$=NO$
  325. 3240 I=INSTR(NO$," "):IF I>0 THEN T01$=LEFT$(NO$,I-1):T02$=MID$(NO$,I+1)
  326. 3250 IF T01$<>"SYSOP" THEN GOSUB 7100
  327. 3260 A$="From: "+TX$:GOSUB 4870
  328. 3270 T01$=T$:T02$="":TX$=T$
  329. 3280 I=INSTR(T$," "):IF I>0 THEN T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1)
  330. 3290 GOSUB 7060
  331. 3300 A$="To:   "+TX$:GOSUB 4870
  332. 3310 A$="Re:   "+K$:GOSUB 4870:GOSUB 4870
  333. 3320 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 5330:A$=S$:GOSUB 4870
  334. 3330 IF BK THEN BK=0:GOTO 3350
  335. 3340 RE=RE+1:NEXT P:GOSUB 4870
  336. 3350 IF RIGHT$(B$,1)="+" THEN 3380
  337. 3360 IF G>HM THEN HM=G
  338. 3370 CLOSE:GOTO 3040
  339. 3380 M=M+1:MI=0:RE=1
  340. 3390 IF M<=U AND NOT BK THEN 3110
  341. 3400 IF G>HM THEN HM=G
  342. 3410 CLOSE:A$="End of Messages.":GOSUB 4870:GOSUB 4870:D$="":NO$="":RETURN
  343. 3420 REM
  344. 3430 REM COMMON MESSAGE NUMBER PROMPT
  345. 3440 REM
  346. 3450 A1$="Message Number: ("+STR$(IU)+"-"+STR$(U)+")"
  347. 3460 IF NOT XPR THEN A1$=A1$+" to "+A2$+" (RETURN to quit)"
  348. 3470 A1$=A1$+" : ":N=1:GOSUB 4870:GOSUB 5000:GOSUB 4870:RETURN
  349. 3480 REM
  350. 3490 REM ***SUMMARIZE MESSAGES***
  351. 3500 REM
  352. 3510 GOSUB 4870
  353. 3520 A2$="Start":GOSUB 3450
  354. 3530 IF LEN(B$)=0 THEN M=0:GOSUB 4870:RETURN ELSE M=VAL(B$):GOSUB 4980
  355. 3540 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 3590
  356. 3550 IF LEN(B$)<3 THEN RETURN
  357. 3560 IF MID$(B$,2,1)<>"=" THEN RETURN
  358. 3570 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
  359. 3580 IF ST=0 THEN RETURN
  360. 3590 IF M<1 THEN RETURN
  361. 3600 IF M>U THEN GOSUB 6780:RETURN
  362. 3610 GOSUB 4850:GOSUB 4870
  363. 3620 OPEN "R",1,DSK$+"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
  364. 3630 GET #1,RE
  365. 3640 IF EOF(1) OR BK THEN 3740 ELSE G=VAL(RR$)
  366. 3650 IF G>9998 THEN 3740
  367. 3660 IF G<M THEN RE=RE+6:GOTO 3630
  368. 3670 GOSUB 5730:IF OK OR NOT PERS THEN 3680 ELSE RE=RE+6:GOTO 3630
  369. 3680 GET #1,RE+ST+1
  370. 3690 IF ST=0 THEN 3710
  371. 3700 GOSUB 5330:CY$=S$:GOSUB 6870:IF INSTR(CY$,SV$)=0 THEN RE=RE+6:GOTO 3630
  372. 3710 GOSUB 3770
  373. 3720 IF BK THEN 3740
  374. 3730 IF U=G OR BK THEN 3740 ELSE RE=RE+2:GOTO 3630
  375. 3740 GOSUB 4870
  376. 3750 A$="*** End of Survey ***":GOSUB 4870:GOSUB 4870:GOSUB 4870
  377. 3760 CLOSE:RETURN
  378. 3770 REM
  379. 3780 REM DISPLAY ONE-LINER "FULL" SUMMARY OF MSG G
  380. 3790 REM
  381. 3800 A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+": " ' Msg Number
  382. 3810 GET #1,RE+5:GOSUB 5330
  383. 3820 A$=A$+SPACE$(3-LEN(STR$(VAL(S$))))+STR$(VAL(S$))+"  " ' Lines
  384. 3830 RE=RE+1:GET #1,RE:GOSUB 5330
  385. 3840 A$=A$+S$+"  "  ' Date
  386. 3850 RE=RE+1:GET #1,RE:GOSUB 5330 ' From
  387. 3860 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
  388. 3870 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
  389. 3880 IF S$<>"SYSOP" THEN CX$=S$:GOSUB 6790:S$=CX$
  390. 3890 A$=A$+S$+SPACE$(8-LEN(S$))+" -> "
  391. 3900 RE=RE+1:GET #1,RE:GOSUB 5330 ' To
  392. 3910 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
  393. 3920 IF S$<>"SYSOP" AND S$<>"ALL" THEN CX$=S$:GOSUB 6790:S$=CX$
  394. 3930 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
  395. 3940 A$=A$+S$+SPACE$(8-LEN(S$))+" "
  396. 3950 RE=RE+1:GET #1,RE:GOSUB 5330 ' Subject
  397. 3960 GOSUB 5850
  398. 3970 A$=A$+S$:GOSUB 4870
  399. 3980 RETURN
  400. 3990 REM
  401. 4000 REM ***GOODBYE***
  402. 4010 REM
  403. 4020 BK=0:GOSUB 4070:IF BK THEN 1310
  404. 4030 A$=CN$+", thanks for calling...":GOSUB 4870
  405. 4040 A$="Please call again!  Bye...":GOSUB 4870
  406. 4050 GOSUB 4870:GOSUB 4870:IF IHM<>HM THEN MFJ$=MF$:GOSUB 6680
  407. 4060 GOTO 4280
  408. 4070 REM
  409. 4080 REM COMMENTS FOR SYSOP
  410. 4090 REM
  411. 4100 IF N$="SYSOP" THEN RETURN
  412. 4110 GOSUB 4870
  413. 4120 A1$="Enter confidential comments for the SYSOP? ":GOSUB 6710
  414. 4130 IF NOT OK THEN 4230
  415. 4140 RE=2:RL=65:OPEN "R",1,DSK$+"COMMENTS",65:FIELD#1,65 AS RR$
  416. 4150 GET#1,1:RE=VAL(RR$)+1:IF RE=1 THEN RE=2
  417. 4160 S$=" ":GOSUB 5280:PUT#1,RE:RE=RE+1
  418. 4170 S$="From: "+CN$+" "+CO$:GOSUB 5280:PUT#1,RE
  419. 4180 A$="Enter text; type two RETURNs to end.":GOSUB 4870
  420. 4190 GOSUB 4870
  421. 4200 A1$="> ":N=1:GOSUB 4870:GOSUB 5000
  422. 4210 IF B$<>"" THEN RE=RE+1:S$=B$:RL=65:GOSUB 5280:PUT#1,RE:GOTO 4200
  423. 4220 S$=STR$(RE):RL=65:GOSUB 5280:PUT#1,1:CLOSE
  424. 4230 GOSUB 4870
  425. 4240 A$="Character count: "+STR$(A)+" typed by system - "+STR$(D)+" typed by you.":GOSUB 4870
  426. 4250 GOSUB 4870:RETURN
  427. 4260 A1$="Sorry, too many errors.  Try again another time.  Bye..."
  428. 4270 GOSUB 4870:GOSUB 4870
  429. 4280 REM
  430. 4290 OUT &H82,0 '<--- TURN OFF DTR TO MODEM FOR DISCONNECT.
  431. 4300 POKE 0,&HC3  '<--- Restore jump instruction at WBOOT.
  432. 4310 POKE &H5B,0 '<--- Prevent "RBBS P" until next signin.
  433. 4320 SYSTEM
  434. 4330 REM
  435. 4340 REM ***KILL A MESSAGE***
  436. 4350 REM
  437. 4360 GOSUB 4870
  438. 4370 A2$="Kill":GOSUB 3450
  439. 4380 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  440. 4390 IF M<1 THEN GOSUB 4870:RETURN
  441. 4400 IF M>U THEN GOSUB 6780:GOTO 4350
  442. 4410 A$="Scanning Summary file...":N=1:GOSUB 4870
  443. 4420 OPEN "R",1,DSK$+"SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  444. 4430 GET#1,RE
  445. 4440 IF EOF(1) THEN 4630 ELSE G=VAL(RR$)
  446. 4450 IF G>9998 THEN 4630
  447. 4460 IF G<M THEN RE=RE+6:GOTO 4430
  448. 4470 IF G>M THEN 4630
  449. 4480 GOSUB 5730:IF OK OR NOT PERS THEN 4490 ELSE 4630
  450. 4490 GET#1,RE:GOSUB 5330:PW=INSTR(S$,";"):PW$=""
  451. 4500 IF PW=0 OR N$="SYSOP" OR PERS OR OK THEN PERS=0:GOTO 4530
  452. 4510 PW$=MID$(S$,PW+1):GOSUB 4870:A1$="Password: ":N=1:GOSUB 4870
  453. 4520 C=1:GOSUB 5000:IF B$<>PW$ THEN A$="Incorrect.":GOTO 4640
  454. 4530 S$=" 0"+":"+STR$(G):GOSUB 5280:PUT#1,RE:CLOSE
  455. 4540 A$="Updating Message file...":N=1:GOSUB 4870
  456. 4550 OPEN "R",1,DSK$+"MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
  457. 4560 MI=MI+1:IF MI>MZ THEN 4630 ELSE G=M(MI,1)
  458. 4570 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 4560
  459. 4580 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 5280:PUT#1,RE:M(MI,1)=0
  460. 4590 CLOSE#1:A$="Updating Message count...":GOSUB 4870
  461. 4600 OPEN "R",1,DSK$+"COUNTERS",5:FIELD#1,5 AS RR$
  462. 4610 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS
  463. 4620 GOSUB 4870:A$="Message killed.":GOTO 4640
  464. 4630 A$="Message not found."
  465. 4640 CLOSE:GOSUB 4870:GOTO 4360
  466. 4650 REM
  467. 4660 REM ***DISPLAY USER FILE***
  468. 4670 REM
  469. 4680 GOSUB 4850
  470. 4690 OPEN "R",1,DSK$+"USERS",62:FIELD#1,1 AS MU$,1 AS SU$,60 AS RR$
  471. 4700 FIELD#1,10 AS NN$:GET#1,1:NU=VAL(NN$)
  472. 4710 GOSUB 4870
  473. 4720 FOR J=NU+1 TO 2 STEP -1
  474. 4730 GET#1,J:IF SU$="*" THEN 4790
  475. 4740 GOSUB 5330:S0$=S$
  476. 4750 I=INSTR(S0$,";"): S1$=LEFT$(S0$,I-1):S2$=MID$(S0$,I+1)
  477. 4760 I=INSTR(S2$,";"): S3$=MID$(S2$,I+1):S2$=LEFT$(S2$,I-1)
  478. 4770 I=INSTR(S3$,";"): S3$=LEFT$(S3$,I-1)
  479. 4780 A$=S1$+" "+S2$+", "+S3$:GOSUB 4870
  480. 4790 IF BK THEN 4810
  481. 4800 NEXT J
  482. 4810 CLOSE:GOSUB 4870:RETURN
  483. 4820 REM
  484. 4830 REM **** PRINT CONTROL-CHAR INFO
  485. 4840 REM
  486. 4850 GOSUB 4870
  487. 4860 A$="Use CTL-S or S to PAUSE, CTL-K or K to ABORT."
  488. 4870 REM
  489. 4880 REM ***PRINT STRING FROM A$ ON CONSOLE***
  490. 4890 REM
  491. 4900 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
  492. 4910 IF A1$<>"" THEN A$=A1$:A1$=""
  493. 4920 IF N=1 THEN PRINT A$;:PP$=A$:GOTO 4970
  494. 4930 BI=ASC(INKEY$+" ")
  495. 4940 IF BI=&H13 OR BI=&H53 OR BI=&H73 THEN BI=ASC(INPUT$(1)):GOTO 4960
  496. 4950 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN BK=-1:GOTO 4980 
  497. 4960 PRINT A$
  498. 4970 A=A+LEN(A$)
  499. 4980 A$="":N=0
  500. 4990 RETURN
  501. 5000 REM
  502. 5010 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
  503. 5020 REM
  504. 5030 IF BEL AND SAV$="" THEN PRINT CHR$(7);
  505. 5040 B$="":BK=0
  506. 5050 IF SAV$="" THEN GOSUB 5980:IF C<>3 THEN PRINT
  507. 5060 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 5080
  508. 5070 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
  509. 5080 IF LEN(B$)=0 THEN C=0:RETURN
  510. 5090 IF C=0 THEN 5110
  511. 5100 CY$=B$:GOSUB 6870:B$=CY$
  512. 5110 D=D+LEN(B$):C=0
  513. 5120 RETURN
  514. 5130 REM
  515. 5140 REM ***ON ERROR HANDLER***
  516. 5150 IF ERL=360 THEN RESUME 380
  517. 5160 IF ERL=830 THEN RE=0:RESUME 840
  518. 5170 IF ERL=910 THEN RESUME 950
  519. 5180 IF ERL=1110 THEN RESUME 1260
  520. 5190 IF ERL=1860 THEN RESUME 1880
  521. 5200 IF ERL=2830 THEN RESUME 2840
  522. 5210 IF ERL=2860 THEN RESUME 2870
  523. 5220 IF ERL=3090 THEN RESUME 3400
  524. 5230 IF ERL=3620 THEN RESUME 3740
  525. 5240 IF ERL=4140 THEN RESUME 4170
  526. 5250 IF ERL=5540 THEN RESUME 5590
  527. 5260 IF ERL=6480 THEN RESUME 6620
  528. 5270 RESUME NEXT
  529. 5280 REM
  530. 5290 REM FILL AND STORE DISK RECORD
  531. 5300 REM
  532. 5310 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  533. 5320 RETURN
  534. 5330 REM
  535. 5340 REM UNPACK DISK RECORD
  536. 5350 REM
  537. 5360 ZZ=LEN(RR$)-2
  538. 5370 WHILE MID$(RR$,ZZ,1)=" "
  539. 5380 ZZ=ZZ-1:IF ZZ=1 THEN 5400
  540. 5390 WEND
  541. 5400 S$=LEFT$(RR$,ZZ)
  542. 5410 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
  543. 5420 RETURN
  544. 5430 REM
  545. 5440 REM *** TOGGLE EXPERT USER MODE
  546. 5450 REM
  547. 5460 XPR=NOT XPR:RETURN
  548. 5470 REM
  549. 5480 REM *** TOGGLE BELL PROMPT
  550. 5490 REM
  551. 5500 BEL=NOT BEL:RETURN
  552. 5510 REM
  553. 5520 REM SUBROUTINE TO PRINT A FILE
  554. 5530 REM
  555. 5540 OPEN "I",1,DSK$+FIL$:BK=0:IF EOF(1) THEN 5590
  556. 5550 IF NW=0 THEN GOSUB 4850 ELSE NW=0
  557. 5560 GOSUB 4870
  558. 5570 IF EOF(1) OR BK THEN 5590 ELSE LINE INPUT #1,A$:GOSUB 4870:GOTO 5570
  559. 5580 GOSUB 4870
  560. 5590 CLOSE #1:RETURN
  561. 5600 REM
  562. 5610 REM PRINT "CALLERS" FILE...FOR SYSOP ONLY (PRIVATE L CMD)
  563. 5620 REM
  564. 5630 GOSUB 4870
  565. 5640 OPEN "R",1,DSK$+"CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
  566. 5650 CA=CN
  567. 5660 FOR CNT=SIZ+1 TO 2 STEP -1
  568. 5670 GET #1,CNT:GOSUB 5330
  569. 5680 A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 4870:IF BK THEN 5710
  570. 5690 CA=CA-1
  571. 5700 NEXT CNT
  572. 5710 CLOSE:GOSUB 4870
  573. 5720 A$="*** End of CALLERS ***":GOSUB 4870:GOSUB 4870:RETURN
  574. 5730 REM
  575. 5740 REM TEST FOR PERSONAL MESSAGES
  576. 5750 REM
  577. 5760 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")<>0 THEN PERS=-1
  578. 5770 IF N$="SYSOP" THEN 5800
  579. 5780 GET #1,RE+3:GOSUB 5820:IF OK THEN 5800
  580. 5790 GET #1,RE+2:GOSUB 5820
  581. 5800 RETURN
  582. 5810 REM TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME
  583. 5820 GOSUB 5330:I=INSTR(S$," "):S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
  584. 5830 IF S1$=N$ AND S2$=O$ THEN OK=-1 ELSE OK=0
  585. 5840 RETURN
  586. 5850 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
  587. 5860 RETURN
  588. 5870 REM
  589. 5880 REM PRINT COMMENTS FILE FOR SYSOP (Z COMMAND)
  590. 5890 REM
  591. 5900 GOSUB 4870:OPEN "R",1,DSK$+"COMMENTS",65:RE=1:FIELD#1,65 AS RR$
  592. 5910 GET#1,RE:RE=RE+1:IF EOF(1) THEN 5930
  593. 5920 GOSUB 5330:A$=S$:GOSUB 4870:GOTO 5910
  594. 5930 CLOSE:GOSUB 4870:IF RE=2 THEN RETURN
  595. 5940 A$="*** End of COMMENTS ***":GOSUB 4870:GOSUB 4870
  596. 5950 IF RE>3 THEN 5960 ELSE RETURN
  597. 5960 A1$="Delete COMMENTS file? ":GOSUB 6710:IF OK THEN KILL DSK$+"COMMENTS"
  598. 5970 RETURN
  599. 5980 REM
  600. 5990 REM CHARACTER-AT-A-TIME LINE INPUT WITH EDITING (IF C=2, NO ECHO)
  601. 6000 REM
  602. 6010 CHC=0: SAV$="":DC=0:IC=&H30
  603. 6020 NCH=ASC(INPUT$(1))
  604. 6030 IF NCH=13 THEN RETURN 'CR
  605. 6040 IF NCH=127 THEN 6120
  606. 6050 IF NCH<32 THEN 6140
  607. 6060 IF CHC>=63 THEN PRINT CHR$(7);:GOTO 6020
  608. 6070 SAV$=SAV$+CHR$(NCH): CHC=CHC+1 :IC=IC+1:IF IC=&H3A THEN IC=&H30
  609. 6080 IF DC THEN PRINT CHR$(10);
  610. 6090 IF C<>2 THEN PRINT CHR$(NCH); ELSE PRINT CHR$(IC);
  611. 6100 IF CHC=55 THEN PRINT CHR$(7);
  612. 6110 DC=0:GOTO 6020
  613. 6120 IF CHC=0 THEN 6020 ELSE PRINT BSL$;:DC=-1
  614. 6130 CHC=CHC-1:IC=IC-1: SAV$=LEFT$(SAV$,CHC): GOTO 6020
  615. 6140 IF CHC=0 THEN 6020
  616. 6150 IF NCH=8 THEN PRINT ERS$;:DC=0:GOTO 6130 'BS
  617. 6160 IF NCH=12 THEN GOSUB 6220:GOTO 6230 '^L
  618. 6170 IF NCH=18 THEN PRINT:PRINT PP$;:GOTO 6230 '^Retype
  619. 6180 IF NCH=21 THEN PRINT " #": PRINT PP$;:DC=0:GOTO 6010 '^U
  620. 6190 IF NCH<>24 THEN 6020 '^X
  621. 6200 GOSUB 6220
  622. 6210 GOTO 6010
  623. 6220 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: RETURN
  624. 6230 IF C<>2 THEN PRINT SAV$;: GOTO 6250
  625. 6240 IC=&H30:FOR BCC=1 TO CHC: IC=IC+1: PRINT CHR$(IC);: NEXT BCC
  626. 6250 DC=0:GOTO 6020
  627. 6260 REM
  628. 6270 REM NEW USER PASSWORD PROMPT
  629. 6280 REM
  630. 6290 GOSUB 4870
  631. 6300 A$="Enter at least six alphanumeric characters":GOSUB 4870
  632. 6310 A1$="for your PASSWORD:  "
  633. 6320 N=1:GOSUB 4870:C=2:GOSUB 5000:S04$=B$:IF S04$="" THEN 6290
  634. 6330 IF LEN(S04$)<6 THEN 6290
  635. 6340 A1$="Now enter it again: "
  636. 6350 N=1:GOSUB 4870:C=2:GOSUB 5000
  637. 6360 IF S04$<>B$ THEN A1$="No match.  Try again.":GOSUB 4870:GOTO 6290
  638. 6370 A$="OK, now please remember it.":GOSUB 4870:GOSUB 4870:RETURN
  639. 6380 REM
  640. 6390 REM USER PASSWORD CHANGE ROUTINE
  641. 6400 REM
  642. 6410 IF N$<>"SYSOP" THEN 6630
  643. 6420 A1$="User's FIRST Name: ":N=1:GOSUB 4870
  644. 6430 C=1:GOSUB 5000:T01$=B$:IF T01$="" THEN RETURN
  645. 6440 A1$="User's LAST Name:  ":N=1:GOSUB 4870
  646. 6450 C=1:GOSUB 5000:T02$=B$:IF T02$="" THEN RETURN
  647. 6460 OK=0:GOSUB 6480:IF OK THEN GOSUB 6670:GOTO 6420
  648. 6470 A$="Not found.":GOSUB 4870:GOTO 6420
  649. 6480 REM
  650. 6490 REM CHECK USERS FILE
  651. 6500 REM
  652. 6510 OPEN "R",1,DSK$+"USERS",62:FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
  653. 6520 FOR J=2 TO NU+1:GET#1,J:GOSUB 5330:S00$=MID$(S$,3)
  654. 6530 I=INSTR(S00$,";"): S01$=LEFT$(S00$,I-1):S02$=MID$(S00$,I+1)
  655. 6540 I=INSTR(S02$,";"): S03$=MID$(S02$,I+1):S02$=LEFT$(S02$,I-1)
  656. 6550 I=INSTR(S03$,";"): S04$=MID$(S03$,I+1):S03$=LEFT$(S03$,I-1)
  657. 6560 I=INSTR(S04$,";"): IF I=0 THEN S05$="0":GOTO 6580
  658. 6570 S05$=MID$(S04$,I+1):S04$=LEFT$(S04$,I-1)
  659. 6580 HM=VAL(S05$)
  660. 6590 IF T01$<>S01$ OR T02$<>S02$ THEN 6610
  661. 6600 MFJ$=LEFT$(S$,1):GOSUB 4870:UJ=J:OK=-1:CLOSE:RETURN
  662. 6610 NEXT J
  663. 6620 CLOSE:RETURN
  664. 6630 REM
  665. 6640 REM UPDATE USERS FILE
  666. 6650 REM
  667. 6660 MFJ$=MF$
  668. 6670 GOSUB 6260
  669. 6680 OPEN "R",1,DSK$+"USERS",62:FIELD#1,62 AS RR$
  670. 6690 S$=MFJ$+" "+S01$+";"+S02$+";"+S03$+";"+S04$+";"+STR$(HM)
  671. 6700 RL=62:GOSUB 5280:PUT#1,UJ:CLOSE:RETURN
  672. 6710 REM
  673. 6720 REM PROMPT FOR YES OR NO ANSWER
  674. 6730 REM
  675. 6740 A2$=A1$:OK=0
  676. 6750 A1$=A2$:N=1:GOSUB 4870:C=1:GOSUB 5000:ANS$=LEFT$(B$,1)
  677. 6760 IF ANS$="" THEN 6750 ELSE IF ANS$="Y" THEN OK=-1:RETURN
  678. 6770 IF ANS$<>"N" THEN 6710 ELSE RETURN
  679. 6780 A$="That's an invalid message number, "+CN$+".":GOSUB 4870:SAV$="":RETURN
  680. 6790 REM
  681. 6800 REM CAPITALIZE STRING CX$ (e.g., FRANK -> Frank)
  682. 6810 REM
  683. 6820 FOR ZZ=2 TO LEN(CX$)
  684. 6830 ZA=ASC(MID$(CX$,ZZ,1)):IF ZA<&H41 OR ZA>&H5A THEN 6850
  685. 6840 MID$(CX$,ZZ,1)=CHR$(ZA+&H20)
  686. 6850 NEXT ZZ
  687. 6860 RETURN
  688. 6870 REM
  689. 6880 REM UPPERCASE STRING CY$ (e.g., frank -> FRANK)
  690. 6890 REM
  691. 6900 FOR ZZ=1 TO LEN(CY$)
  692. 6910 ZA=ASC(MID$(CY$,ZZ,1)):IF ZA<&H61 OR ZA>&H7A THEN 6930
  693. 6920 MID$(CY$,ZZ,1)=CHR$(ZA-&H20)
  694. 6930 NEXT ZZ
  695. 6940 RETURN
  696. 6950 REM
  697. 6960 REM CHECK FOR EXISTING USER (FOR "TO:")
  698. 6970 REM
  699. 6980 T01$=T$:T02$=""
  700. 6990 IF T$="SYSOP" OR T$="ALL" THEN OK=-1:RETURN
  701. 7000 U01$=S01$:U02$=S02$:U03$=S03$:U04$=S04$:SHM=HM:SUJ=UJ:SMF$=MF$
  702. 7010 I=INSTR(T$," "): IF I=0 THEN OK=0:GOTO 7040
  703. 7020 T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1):OK=0:GOSUB 6480
  704. 7030 S01$=U01$:S02$=U02$:S03$=U03$:S04$=U04$:HM=SHM:UJ=SUJ:MF$=SMF$
  705. 7040 IF NOT OK THEN A1$="Not a currently known User.  OK? ":GOSUB 6710
  706. 7050 RETURN
  707. 7060 REM
  708. 7070 REM CAPITALIZE "TO:" FOR MESSAGE ENTRY DISPLAY
  709. 7080 REM
  710. 7090 IF T$="SYSOP" OR T$="ALL" THEN TX$=T$:RETURN
  711. 7100 CX$=T01$:GOSUB 6790:T01$=CX$:CX$=T02$:GOSUB 6790:T02$=CX$
  712. 7110 TX$=T01$+" "+T02$
  713. 7120 RETURN
  714. 7130 CX$=N$:GOSUB 6790:CN$=CX$:CX$=O$:GOSUB 6790:CO$=CX$:RETURN
  715. 7140 REM K=1:FOR J=&H40 TO &H43:POKE J,ASC(MID$(O$,K,1)):K=K+1:NEXT J:RETURN
  716.