home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / BBSING / RBBS / RBBS37-2.LBR / RBBS37NC.AQC / RBBS37NC.ASC
Text File  |  2000-06-30  |  29KB  |  786 lines
  1. 10 'RBBS Version 3.7
  2. 21 'Comments removed version 
  3. 150 DEFINT A-Z
  4. 160 DIM A$(25),M(200,2)
  5. 200 VERS1$="RBBS 3.7"
  6. 210 VERS2$="Lillypond Software 1984 "
  7. 220 SYS1$="DENNIS"
  8. 225 SYS2$="RECLA" 
  9. 230 SYS3$="SYSOP" 
  10. 235 P2$="LETMEIN?"
  11. 240 P1$="GO2CPM"  
  12. 245 P3$="DDT" 
  13. 250 VAP$="PASSWORD"
  14. 255 PC$="What De-bugger?  "
  15. 260 DSK$="A:"
  16. 265 DSK2$="A:"
  17. 267 DSK3$="A:"
  18. 270 ANS1$=" >> You must be a validated user for access << "
  19. 272 NSP$=" Please no spaces "
  20. 275 TWIT$=" "
  21. 277 DATIM$="N"         
  22. 280 BEEP=20000
  23. 285 SIZE=24
  24. 290 ERS$=CHR$(8)+" "+CHR$(8)
  25. 295 BSL$=CHR$(8)+"/"+CHR$(8)
  26. 300 MSYS=1
  27. 305 SCAN$="N"
  28. 310 NNUM=0
  29. 315 HNUM=0
  30. 317 SKIP=1
  31. 319 LMSG=-1
  32. 321 GOCPM=1
  33. 330 POKE 0,&HCD
  34. 340 INC=1
  35. 350 ON ERROR GOTO 5300
  36. 360 RFLG=PEEK(&H5D):POKE &H5D,&H20
  37. 370 RTNOKFLG=PEEK(&H5B):POKE &H5B,120 
  38. 410 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1:NW=0
  39. 415 BK=0:GOSUB 5040
  40. 420 OPEN "I",1,DSK$+"BOOTPWD":IF EOF(1) THEN 430
  41. 425 INPUT #1,DSK2$,DSK3$,SYS1$,SYS2$,VERS1$,TWIT$,DATIM$
  42. 430 CLOSE #1
  43. 434 A$=VERS1$:N=1:GOSUB 5040  
  44. 436 GOSUB 5040:GOSUB 5040     
  45. 440 OPEN "I",1,DSK2$+"pwds":IF EOF(1) THEN 450
  46. 445 INPUT #1,P1$,P2$,P3$,PC$,VAP$,SCAN$
  47. 446 INPUT #1,BEEP,SIZE,MSYS,NNUM,HNUM,SKIP,LMSG,GOCPM
  48. 450 CLOSE #1
  49. 480 BEL=-1:XPR=0
  50. 485 NEWUSER=1    
  51. 490 A$=VERS2$:N=1:GOSUB 5040
  52. 495 GOSUB 5040:GOSUB 5040:SAV$=""
  53. 500 IF RFLG<>ASC("P") THEN 600
  54. 510 IF RTNOKFLG<>ASC("x") THEN 600
  55. 520 V=0:INC=0 ' SO CALLER NUMBER SAYS SAME
  56. 530 OPEN "I",1,DSK3$+"LASTCALR":INPUT #1,N$,O$,D$:CLOSE
  57. 540 A$="Welcome back, "
  58. 550 IF N$<>SYS3$ THEN 570
  59. 560 CN$=N$:O$="":CO$=O$:A$=A$+N$+".":GOSUB 5040:GOSUB 5040:V=1:GOTO 960
  60. 570 GOSUB 7360:V=1
  61. 580 A$=A$+CN$+" "+CO$+".":GOSUB 5040:GOSUB 5040
  62. 590 T01$=N$:T02$=O$:GOSUB 6710:MF$=MFJ$:GOTO 960
  63. 600 GOSUB 1830:IF NOT BK THEN NW=1:GOSUB 1790'REM PRINT INFO, THEN BULLETINS
  64. 610 GOSUB 5040:BK=0
  65. 620 GOSUB 5040
  66. 630 A1$="Enter your FIRST Name: ":N=1:GOSUB 5040
  67. 640 C=1:GOSUB 5170:N$=B$:IF N$="" THEN 630
  68. 650 IF N$=P1$ THEN POKE &H5B,0:GOTO 1750 ' DIRECT CPM EXIT
  69. 660 IF N$<"A" OR LEN(N$)=1 THEN 630
  70. 665 CK=INSTR(N$," "):IF CK>0 THEN A1$=NSP$:N=1:GOSUB 5040:GOSUB 5040:GOTO 630
  71. 670 A1$="Enter your LAST Name:  ":N=1:GOSUB 5040
  72. 680 C=1:IF N$=SYS3$ THEN C=2
  73. 690 GOSUB 5170:O$=B$:IF O$="" THEN 630
  74. 700 IF O$<"A" OR LEN(O$)=1 THEN 630
  75. 710 IF N$=SYS3$ AND O$=P2$ THEN GOSUB 8000:GOTO 910 ' This must be a SYSOP
  76. 720 IF N$=SYS3$ THEN 630
  77. 725 CK=INSTR(O$," "):IF CK>0 THEN A1$=NSP$:N=1:GOSUB 5040:GOSUB 5040:GOTO 670
  78. 730 A$="Checking User File...":GOSUB 5040
  79. 740 V=0:T01$=N$:T02$=O$:OK=0:GOSUB 6710:IF OK THEN MF$=MFJ$:GOTO 750 ELSE 790
  80. 750 T=0
  81. 760 T=T+1:IF T=4 THEN 4390 ELSE A1$="Enter your PASSWORD: "
  82. 770 N=1:GOSUB 5040:C=2:GOSUB 5170:UPW$=B$:IF UPW$="" THEN 760
  83. 780 IF UPW$=S04$ THEN 910 ELSE 760
  84. 790 A1$="You must be a New User <Y or N> ? ":GOSUB 6940
  85. 800 IF NOT OK THEN A$="REALLY, let's try again.":GOSUB 5040:GOTO 630
  86. 810 V=1:GOSUB 6520 'GET USER TO SET HIS OWN PASSWORD
  87. 820 A1$="Enter YOUR City, State: ":N=1:GOSUB 5040
  88. 830 C=1:GOSUB 5170:S03$=B$:IF S03$="" THEN 820
  89. 840 GOSUB 7360
  90. 850 A$="Hello "+CN$+" "+CO$+" from "+S03$:GOSUB 5040
  91. 860 A1$="Is anything misspelled? ":GOSUB 6940:IF OK THEN 630
  92. 870 HM=0:S05$=STR$(HM):S$="  "+N$+";"+O$+";"+S03$+";"+S04$+";"+S05$
  93. 880 OPEN "R",1,DSK3$+"USERS",62:FIELD#1,62 AS RR$
  94. 890 RL=62:GOSUB 5450:NU=NU+1:PUT#1,NU+1:S$=STR$(NU):GOSUB 5450:PUT#1,1:CLOSE
  95. 900 FIL$="NEWCOM":GOSUB 5680:MF$=" ":NEWUSER=-1   
  96. 910 A$="Writing to User file...":GOSUB 5040:RE=1
  97. 915 IF N$=SYS3$ THEN GOTO 950   'Don't put the SYSOP in Callers file
  98. 920 OPEN "R",1,DSK3$+"CALLERS",60:FIELD#1,60 AS RR$:GET#1,1:RE=VAL(RR$)+1
  99. 930 S$=STR$(RE):RL=60:GOSUB 5450:PUT#1,1:RE=RE+1
  100. 940 S$=N$+" "+O$+" "+S03$:GOSUB 5450:PUT#1,RE:CLOSE#1
  101. 944 IF DATIM$="Y" THEN GOSUB 9070    
  102. 950 OPEN "O",1,DSK3$+"LASTCALR":PRINT #1,N$;",";O$;",";D$:CLOSE
  103. 960 PRINT
  104. 964 IF MF$="#" THEN GOSUB 5600  
  105. 965 IF MF$<>"*" GOTO 970        
  106. 966 IF TWIT$="*" THEN GOTO 7800 
  107. 970 IF V=0 THEN IF N$<>SYS3$ THEN GOSUB 7360
  108. 990 BK=0:GOSUB 5040:CN=1:M=0:U=0
  109. 1000 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD#1,5 AS RR$
  110. 1010 GET#1,CALLS:IF N$=SYS3$ THEN CN=VAL(RR$) ELSE CN=VAL(RR$)+INC
  111. 1020 GET#1,MSGS:M=VAL(RR$)
  112. 1030 GET#1,MNUM:U=VAL(RR$)
  113. 1040 A$="You are caller number:      ":N=1:GOSUB 5040
  114. 1050 A$=STR$(CN):LSET RR$=A$
  115. 1060 A$=SPACE$(4-LEN(STR$(CN)))+STR$(CN):GOSUB 5040:PUT#1,CALLS:GOSUB 5040
  116. 1070 A$="Number of Active Messages:  ":N=1:GOSUB 5040
  117. 1080 A$=SPACE$(4-LEN(STR$(M)))+STR$(M):GOSUB 5040
  118. 1090 A$="Last System Message Number: ":N=1:GOSUB 5040
  119. 1100 A$=SPACE$(4-LEN(STR$(U)))+STR$(U):GOSUB 5040:CLOSE
  120. 1105 IF N$=SYS3$ THEN GOTO 1140         
  121. 1106 IF SKIP=1 THEN GOTO 1140
  122. 1110 IF HM=0 THEN 1140    
  123. 1120 A$="Your last message number  : ":N=1:GOSUB 5040
  124. 1125 A$=SPACE$(4-LEN(STR$(HM)))+STR$(HM):GOSUB 5040
  125. 1130 GOSUB 5040
  126. 1135 IF MF$="#" THEN A$="System SUPER User...":N=1:GOSUB 5040
  127. 1140 GOSUB 5040:A$=" ":GOSUB 5040:IHM=HM
  128. 1190 FT=-1:MX=0:MZ=0:IU=0:CNT=0:G=0
  129. 1200 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD#1,28 AS RR$
  130. 1210 BK=0:GET#1,RE:IF EOF(1) THEN 1350
  131. 1220 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 1340 ' G=0 =DELETED
  132. 1230 IF IU=0 THEN IU=G
  133. 1240 IF G>9998 THEN MZ=MZ-1:GOTO 1350
  134. 1250 GET#1,RE+3:GOSUB 5500
  135. 1260 I=INSTR(S$," "):IF I=0 THEN S1$=S$:S2$="":GOTO 1280
  136. 1270 S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
  137. 1280 IF S1$=N$ AND S2$=O$ THEN 1310
  138. 1290 IF N$<>SYS3$ THEN 1340
  139. 1300 IF S1$=SYS1$ AND S2$=SYS2$ THEN 1310 ELSE 1340
  140. 1310 IF NOT FT THEN 1330
  141. 1320 GOSUB 5040:A$=CN$+", you have mail:":GOSUB 5040:GOSUB 5040:FT=0
  142. 1330 RX=RE:GOSUB 3900:RE=RX:CNT=CNT+1
  143. 1340 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 1210
  144. 1350 IF CNT=0 THEN 1390 ELSE GOSUB 5040:A$="Please Retrieve and Kill "
  145. 1360 IF CNT=1 THEN A$=A$+"this message."
  146. 1370 IF CNT>1 THEN A$=A$+"these messages."
  147. 1380 GOSUB 5040:GOSUB 5040
  148. 1390 CLOSE
  149. 1395 IF NEWUSER=-1 THEN GOSUB 1900      
  150. 1400 '
  151. 1420 '
  152. 1430 A1$=CN$+"?  Your Command: "
  153. 1440 IF NOT XPR THEN A1$=A1$+"B,E,F,R,S,K,L,G,H,W,J,U,T,X,P,C,N ( or ? ): "
  154. 1450 N=1:GOSUB 5040:C=1:GOSUB 5170
  155. 1460 IF B$="" THEN 1430
  156. 1470 FF=INSTR("BER?SKGWJUTXP",B$):GOSUB 1480:GOTO 1430
  157. 1480 IF FF=0 THEN 1500
  158. 1490 ON FF GOTO 1790,1910,3130,1870,3640,4460,4120,1830,1570,4820,5640,5600,6610
  159. 1500 IF B$="C" THEN GOTO 7380        
  160. 1504 IF B$="F" THEN GOSUB 4270:RETURN   
  161. 1510 IF B$="N" THEN GOSUB 7670:RETURN    
  162. 1515 IF B$="UALL" THEN GOTO 4820        
  163. 1520 IF B$="L" THEN GOSUB 5770:RETURN    
  164. 1525 IF B$="H" THEN GOTO 7900           
  165. 1530 IF B$="Z" AND N$=SYS3$ THEN GOSUB 6100:RETURN
  166. 1535 IF B$="XL" AND N$=SYS3$ THEN GOSUB 7830:RETURN
  167. 1540 GOSUB 5040
  168. 1550 A$="I don't understand '"+B$+"', "+CN$+".":GOSUB 5040:GOSUB 5040
  169. 1560 SAV$="":RETURN
  170. 1570 REM
  171. 1580 REM
  172. 1590 REM
  173. 1600 GOSUB 5040:T=0
  174. 1610 IF N$=SYS3$ THEN 1760
  175. 1612 IF MF$="#" THEN 1680        
  176. 1615 IF GOCPM=-1 THEN 1630
  177. 1620 IF MF$<>"*" AND GOCPM=0 THEN 1640
  178. 1625 IF MF$="!" THEN 1640    
  179. 1630 A$=ANS1$:GOSUB 5040:SAV$="":RETURN
  180. 1640 IF P3$="NOPASS" THEN 1680
  181. 1650 T=T+1:IF T=2 THEN GOSUB 5040:GOSUB 5040:RETURN
  182. 1660 A1$=PC$:N=1:GOSUB 5040:C=2:GOSUB 5170
  183. 1670 IF B$="" OR B$<>P3$ THEN 1650
  184. 1680 IF XPR THEN 1740
  185. 1690 REM
  186. 1710 REM
  187. 1720 GOSUB 5040:FIL$="ENTERCPM":NW=1:GOSUB 5680:GOSUB 5040
  188. 1730 REM
  189. 1740 IF IHM<>HM THEN MFJ$=MF$:GOSUB 6910
  190. 1750 GOSUB 4200
  191. 1760 POKE 4,0
  192. 1765 '
  193. 1770 A$="Entering CP/M...":GOSUB 5040
  194. 1771 '
  195. 1780 POKE 0,&HC3:SYSTEM ' 
  196. 1790 '
  197. 1820 FIL$="BULLETIN":GOSUB 5680:RETURN
  198. 1830 REM
  199. 1860 FIL$="INFO":GOSUB 5680:RETURN
  200. 1870 REM
  201. 1900 FIL$="MENURBBS":GOSUB 5680:GOSUB 5040:RETURN
  202. 1910 REM
  203. 1940 IF N$=SYS3$ THEN 1970
  204. 1942 IF LMSG=1 THEN 1970
  205. 1945 IF MF$="#" OR MF$="!" THEN 1970
  206. 1950 GOSUB 5040:GOSUB 5040
  207. 1960 A$=ANS1$:GOSUB 5040:GOSUB 5040:SAV$="":RETURN
  208. 1970 F=0:GOSUB 5040:V=0
  209. 1980 OPEN "R",1,DSK2$+"COUNTERS",5
  210. 1990 FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
  211. 2000 A$="Msg # will be ":N=1:GOSUB 5040
  212. 2010 A$=STR$(V+1):GOSUB 5040:CLOSE
  213. 2020 GOSUB 5040
  214. 2030 GOSUB 9000 
  215. 2060 A1$="To (RETURN for ALL): ":N=1:GOSUB 5040
  216. 2070 C=1:GOSUB 5170:IF B$="" THEN T$="ALL" ELSE T$=B$
  217. 2080 GOSUB 7180:IF NOT OK THEN 2060
  218. 2090 GOSUB 7290
  219. 2100 A1$="Subject: ":N=1:GOSUB 5040
  220. 2110 C=0:GOSUB 5170:IF B$="" THEN 2100 ELSE K$=B$:
  221. 2115 IF LEN(K$)>26 THEN PRINT "To long... 25 character limit":GOTO 2100
  222. 2120 A1$="Password ('*' for Private): ":N=1:GOSUB 5040
  223. 2130 C=1:GOSUB 5170:PW$=B$
  224. 2140 IF T$<>"ALL" OR LEFT$(PW$,1)<>"*" THEN 2160
  225. 2150 A$="Cannot use '*' with ALL.":GOSUB 5040:GOTO 2120
  226. 2160 IF XPR THEN 2200
  227. 2170 GOSUB 5040
  228. 2175 SIZE$=STR$(SIZE)
  229. 2180 A$="Enter up to"+SIZE$+" lines of text (NO semicolons).":GOSUB 5040
  230. 2190 A$="When finished, hit two RETURNs in a row.":GOSUB 5040
  231. 2200 GOSUB 5040:F=0
  232. 2210 IF F=SIZE THEN A$="Message full.":GOSUB 5040:GOTO 2280
  233. 2220 F=F+1
  234. 2230 A1$=SPACE$(3-LEN(STR$(F)))+STR$(F)+"> ":N=1:GOSUB 5040
  235. 2240 GOSUB 5170:IF B$="" THEN F=F-1:IF F=0 THEN 2500 ELSE 2280
  236. 2250 IF F=SIZE-2 THEN PRINT "(2 lines left)"
  237. 2260 IF F=SIZE-1 THEN PRINT "(Last line)"
  238. 2270 A$(F)=B$+" ":GOTO 2210
  239. 2280 GOSUB 5040
  240. 2290 A1$="Select: (H)eader, (L)ist, (E)dit, (A)bort, (C)ontinue, (S)ave: "
  241. 2300 IF XPR THEN A1$="H,L,E,A,C,S: "
  242. 2310 N=1:GOSUB 5040:C=1:GOSUB 5170
  243. 2320 IF B$="" THEN 2290
  244. 2330 FF=INSTR("HLEACS",B$):IF FF=0 THEN 2290
  245. 2340 ON FF GOTO 2540,2380,2700,2500,2210,2800
  246. 2350 REM
  247. 2360 REM LIST MESSAGE ENTERED
  248. 2370 REM
  249. 2380 GOSUB 5020:GOSUB 5040
  250. 2390 A$="Date/Time: "+D$:GOSUB 5040
  251. 2400 A$="To:   "+TX$:GOSUB 5040
  252. 2410 A$="Re:   "+K$:GOSUB 5040
  253. 2420 A$="PW:   "+PW$:GOSUB 5040
  254. 2430 GOSUB 5080
  255. 2440 FOR L=1 TO F:A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L)
  256. 2450 IF BK THEN 2280 ELSE GOSUB 5040:NEXT L
  257. 2460 GOSUB 5040:GOTO 2280
  258. 2470 REM
  259. 2490 REM
  260. 2500 GOSUB 5040:A$="Aborted":GOSUB 5040:GOSUB 5040:RETURN
  261. 2510 REM
  262. 2530 REM
  263. 2540 GOSUB 5040:A$="Enter replacement or RETURN for no change.":GOSUB 5040
  264. 2550 A1$="Date: "+D$+": ":N=1:GOSUB 5040:GOSUB 5170
  265. 2560 IF B$<>"" THEN D$=B$
  266. 2570 A1$="To:   "+TX$+": ":N=1:GOSUB 5040:C=1:GOSUB 5170
  267. 2580 IF B$="" THEN 2610
  268. 2590 TSV$=T$:T$=B$:GOSUB 7180:IF NOT OK THEN T$=TSV$:GOTO 2570
  269. 2600 GOSUB 7290
  270. 2610 A1$="Re:   "+K$+": ":N=1:GOSUB 5040:C=0:GOSUB 5170
  271. 2620 IF B$<>"" THEN K$=B$
  272. 2630 A1$="PW:   "+PW$+": ":N=1:GOSUB 5040:C=1:GOSUB 5170
  273. 2640 IF B$="" THEN 2280
  274. 2650 IF T$<>"ALL" OR LEFT$(B$,1)<>"*" THEN PW$=B$:GOTO 2280
  275. 2660 A$="Cannot use '*' with ALL.":GOSUB 5040:GOTO 2630
  276. 2670 REM
  277. 2690 REM
  278. 2700 IF XPR THEN 2740
  279. 2710 GOSUB 5040
  280. 2720 A$="Enter Line Number to change (RETURN or 0 to end).":GOSUB 5040
  281. 2730 A$="Then enter replacement or RETURN for no change.":GOSUB 5040
  282. 2740 GOSUB 5040:A1$="Line Number: ":N=1:GOSUB 5040:C=3:GOSUB 5170
  283. 2750 L=VAL(B$):IF L=0 OR L>F THEN GOSUB 5040:GOTO 2280
  284. 2760 A$=" was:":GOSUB 5040
  285. 2770 A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L):GOSUB 5040
  286. 2780 A1$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": ":N=1:GOSUB 5040:GOSUB 5170
  287. 2790 IF B$="" THEN 2740 ELSE A$(L)=B$+" ":GOTO 2740
  288. 2800 REM
  289. 2820 REM
  290. 2830 IF PW$<>"" THEN PW$=";"+PW$
  291. 2840 A$="Updating Summary file, ":N=1:GOSUB 5040
  292. 2850 OPEN "R",1,DSK2$+"SUMMARY",30
  293. 2860 RE=1:FIELD#1,30 AS RR$:RL=30
  294. 2870 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 5450:PUT#1,RE
  295. 2880 RE=RE+1:S$=D$:GOSUB 5450:PUT#1,RE
  296. 2890 RE=RE+1:S$=N$+" "+O$:GOSUB 5450:PUT#1,RE
  297. 2900 RE=RE+1:S$=T$:GOSUB 5450:PUT#1,RE
  298. 2910 RE=RE+1:S$=K$:GOSUB 5450:PUT#1,RE
  299. 2920 RE=RE+1:S$=STR$(F):GOSUB 5450:PUT#1,RE
  300. 2930 RE=RE+1:S$=" 9999":GOSUB 5450:PUT#1,RE
  301. 2940 CLOSE#1
  302. 2950 A$="Next Message #, ":N=1:GOSUB 5040:VV=0
  303. 2960 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MNUM
  304. 2970 LSET RR$=STR$(V+1):PUT#1,MNUM
  305. 2980 A$="Active Messages, ":N=1:GOSUB 5040
  306. 2990 GET#1,MSGS:VV=VAL(RR$)
  307. 3000 LSET RR$=STR$(VV+1):PUT#1,MSGS:CLOSE#1
  308. 3010 A$="and Message file.":N=1:GOSUB 5040
  309. 3020 OPEN "R",1,DSK2$+"MESSAGES",65
  310. 3030 RL=65:FIELD#1,65 AS RR$:RE=MX+1
  311. 3040 S$=STR$(V+1)+PW$:GOSUB 5450:PUT#1,RE
  312. 3050 RE=RE+1:S$=D$:GOSUB 5450:PUT#1,RE
  313. 3060 RE=RE+1:S$=N$+" "+O$:GOSUB 5450:PUT#1,RE
  314. 3070 RE=RE+1:S$=T$:GOSUB 5450:PUT#1,RE
  315. 3080 RE=RE+1:S$=K$:GOSUB 5450:PUT#1,RE
  316. 3090 RE=RE+1:S$=STR$(F):GOSUB 5450:PUT#1,RE
  317. 3100 RE=RE+1
  318. 3110 FOR P=1 TO F:S$=A$(P):GOSUB 5450:PUT#1,RE:RE=RE+1:NEXT P:SS$=" 9999":GOSUB 5450:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F
  319. 3120 GOSUB 5040:GOSUB 5040:U=U+1:RETURN
  320. 3130 REM
  321. 3150 REM
  322. 3155 FLG=0
  323. 3160 FT=-1:G=0
  324. 3170 GOSUB 5040
  325. 3180 A2$="Retrieve":GOSUB 3580
  326. 3190 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  327. 3200 IF M<1 THEN GOSUB 5040:RETURN
  328. 3210 IF M>U THEN GOSUB 7010:GOTO 3170
  329. 3220 OPEN "R",1,DSK2$+"MESSAGES",65
  330. 3230 RE=1:FIELD#1,65 AS RR$:MI=0
  331. 3240 MI=MI+1:IF (MI>MZ) OR BK THEN 3530 ELSE G=M(MI,1)
  332. 3250 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 3240
  333. 3260 IF G>M THEN 3480
  334. 3270 GOSUB 5990:IF OK OR NOT PERS THEN 3280 ELSE RE=RE+M(MI,2):GOTO 3240
  335. 3280 RE=RE+1:GET#1,RE:GOSUB 5500:D$=S$
  336. 3290 RE=RE+1:GET#1,RE:GOSUB 5500:NO$=S$
  337. 3300 RE=RE+1:GET#1,RE:GOSUB 5500:T$=S$
  338. 3310 RE=RE+1:GET#1,RE:GOSUB 5500:GOSUB 6080:K$=S$
  339. 3320 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 5040
  340. 3330 IF FT THEN GOSUB 5020:GOSUB 5040:FT=0
  341. 3340 A$="Msg #:"+STR$(G):GOSUB 5040
  342. 3350 A$="Date/Time: "+D$:GOSUB 5040
  343. 3360 T01$=NO$:T02$="":TX$=NO$
  344. 3370 I=INSTR(NO$," "):IF I>0 THEN T01$=LEFT$(NO$,I-1):T02$=MID$(NO$,I+1)
  345. 3380 IF T01$<>SYS3$ THEN GOSUB 7330
  346. 3390 A$="From: "+TX$:GOSUB 5040
  347. 3400 T01$=T$:T02$="":TX$=T$
  348. 3410 I=INSTR(T$," "):IF I>0 THEN T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1)
  349. 3420 GOSUB 7290
  350. 3430 A$="To:   "+TX$:GOSUB 5040
  351. 3440 A$="Re:   "+K$:GOSUB 5040:GOSUB 5040
  352. 3450 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 5500:A$=S$:GOSUB 5040
  353. 3460 IF BK THEN BK=0:GOTO 3480
  354. 3470 RE=RE+1:NEXT P:GOSUB 5040
  355. 3480 IF RIGHT$(B$,1)="+" THEN 3510
  356. 3490 IF G>HM THEN HM=G
  357. 3500 CLOSE:GOTO 3170
  358. 3510 M=M+1:MI=0:RE=1
  359. 3520 IF M<=U AND NOT BK THEN 3240
  360. 3530 IF G>HM THEN HM=G
  361. 3540 CLOSE:A$="End of Messages.":GOSUB 5040:GOSUB 5040:D$="":NO$="":RETURN
  362. 3550 REM
  363. 3570 REM
  364. 3580 A1$="Message Number: ("+STR$(IU)+"-"+STR$(U)+")"
  365. 3590 IF NOT XPR THEN A1$=A1$+" to "+A2$+" (RETURN to quit)"
  366. 3600 A1$=A1$+" : ":N=1:GOSUB 5040:GOSUB 5170:GOSUB 5040:RETURN
  367. 3640 GOSUB 5040
  368. 3645 FLG=1
  369. 3650 A2$="Start":GOSUB 3580
  370. 3660 IF LEN(B$)=0 THEN M=0:GOSUB 5040:RETURN ELSE M=VAL(B$):GOSUB 5150
  371. 3670 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 3720
  372. 3680 IF LEN(B$)<3 THEN RETURN
  373. 3690 IF MID$(B$,2,1)<>"=" THEN RETURN
  374. 3700 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
  375. 3710 IF ST=0 THEN RETURN
  376. 3720 IF M<1 THEN RETURN
  377. 3730 IF M>U THEN GOSUB 7010:RETURN
  378. 3740 GOSUB 5020:GOSUB 5040
  379. 3750 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
  380. 3760 GET #1,RE
  381. 3770 IF EOF(1) OR BK THEN 3870 ELSE G=VAL(RR$)
  382. 3780 IF G>9998 THEN 3870
  383. 3790 IF G<M THEN RE=RE+6:GOTO 3760
  384. 3800 GOSUB 5960:IF OK OR NOT PERS THEN 3810 ELSE RE=RE+6:GOTO 3760
  385. 3810 GET #1,RE+ST+1
  386. 3820 IF ST=0 THEN 3840
  387. 3830 GOSUB 5500:CY$=S$:GOSUB 7100:IF INSTR(CY$,SV$)=0 THEN RE=RE+6:GOTO 3760
  388. 3840 GOSUB 3900
  389. 3850 IF BK THEN 3870
  390. 3860 IF U=G OR BK THEN 3870 ELSE RE=RE+2:GOTO 3760
  391. 3870 GOSUB 5040
  392. 3880 A$="*** End of Survey ***":GOSUB 5040:GOSUB 5040:GOSUB 5040
  393. 3890 CLOSE:RETURN
  394. 3900 REM
  395. 3920 REM
  396. 3930 A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+": " ' Msg Number
  397. 3940 GET #1,RE+5:GOSUB 5500
  398. 3950 A$=A$+SPACE$(3-LEN(STR$(VAL(S$))))+STR$(VAL(S$))+"  " ' Lines
  399. 3960 RE=RE+1:GET #1,RE:GOSUB 5500
  400. 3970 A$=A$+S$+"  "  ' Date
  401. 3980 RE=RE+1:GET #1,RE:GOSUB 5500 ' From
  402. 3990 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
  403. 4000 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
  404. 4010 IF S$<>SYS3$ THEN CX$=S$:GOSUB 7020:S$=CX$
  405. 4020 A$=A$+S$+SPACE$(8-LEN(S$))+" to => "
  406. 4030 RE=RE+1:GET #1,RE:GOSUB 5500 ' To
  407. 4040 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
  408. 4050 IF S$<>SYS3$ AND S$<>"ALL" THEN CX$=S$:GOSUB 7020:S$=CX$
  409. 4060 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
  410. 4070 A$=A$+S$+SPACE$(8-LEN(S$))+" "
  411. 4080 RE=RE+1:GET #1,RE:GOSUB 5500 ' Subject
  412. 4090 GOSUB 6080
  413. 4100 A$=A$+S$:GOSUB 5040
  414. 4110 RETURN
  415. 4120 '
  416. 4130 '
  417. 4150 BK=0:GOSUB 4200:IF BK THEN 1400
  418. 4155 IF MF$="*" THEN A$=N$+", Don't call back Again ! ":GOSUB 5040:GOTO 4180
  419. 4160 A$=CN$+", thanks for calling...":GOSUB 5040
  420. 4170 A$="Please call again!  Bye...":GOSUB 5040
  421. 4175 IF N$=SYS3$ GOTO 4410
  422. 4180 GOSUB 5040:GOSUB 5040:IF IHM<>HM THEN MFJ$=MF$:GOSUB 6910
  423. 4190 GOTO 4410
  424. 4200 '
  425. 4210 '
  426. 4230 IF N$=SYS3$ THEN RETURN
  427. 4240 GOSUB 5040
  428. 4250 A1$="Enter confidential comments for the SYSOP <Y or N> ":GOSUB 6940
  429. 4260 IF NOT OK THEN 4360
  430. 4270 RE=2:RL=65:OPEN "R",1,DSK2$+"COMMENTS",65:FIELD#1,65 AS RR$
  431. 4280 GET#1,1:RE=VAL(RR$)+1:IF RE=1 THEN RE=2
  432. 4290 S$=" ":GOSUB 5450:PUT#1,RE:RE=RE+1
  433. 4300 S$="From: "+CN$+" "+CO$:GOSUB 5450:PUT#1,RE
  434. 4310 A$="Enter text; type two RETURNs to exit":GOSUB 5040
  435. 4320 GOSUB 5040
  436. 4330 A1$="> ":N=1:GOSUB 5040:GOSUB 5170
  437. 4340 IF B$<>"" THEN RE=RE+1:S$=B$:RL=65:GOSUB 5450:PUT#1,RE:GOTO 4330
  438. 4345 A1$="Done <Y or N> ":GOSUB 6940
  439. 4346 IF NOT OK THEN GOTO 4330
  440. 4350 S$=STR$(RE):RL=65:GOSUB 5450:PUT#1,1:CLOSE
  441. 4360 GOSUB 5040
  442. 4380 GOSUB 5040:RETURN
  443. 4390 A1$="Sorry, too many errors.  Try again another time.  Bye..."
  444. 4400 GOSUB 5040:GOSUB 5040
  445. 4410 '
  446. 4423 '
  447. 4430 POKE 0,&HC3
  448. 4440 POKE &H5B,0
  449. 4445 RUN "BYE.COM"    
  450. 4450 SYSTEM
  451. 4460 '
  452. 4490 IF N$=SYS3$ GOTO 4530
  453. 4495 IF MF$="!" OR MF$="#" THEN GOTO 4530
  454. 4500 GOSUB 5040:GOSUB 5040
  455. 4510 A$=ANS1$:GOSUB 5040:GOSUB 5040:SAV$="":RETURN
  456. 4520 REM
  457. 4530 GOSUB 5040
  458. 4540 A2$="Kill":GOSUB 3580
  459. 4550 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  460. 4560 IF M<1 THEN GOSUB 5040:RETURN
  461. 4570 IF M>U THEN GOSUB 7010:GOTO 4520
  462. 4580 A$="Scanning Summary file...":N=1:GOSUB 5040
  463. 4590 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  464. 4600 GET#1,RE
  465. 4610 IF EOF(1) THEN 4800 ELSE G=VAL(RR$)
  466. 4620 IF G>9998 THEN 4800
  467. 4630 IF G<M THEN RE=RE+6:GOTO 4600
  468. 4640 IF G>M THEN 4800
  469. 4650 GOSUB 5960:IF OK OR NOT PERS THEN 4660 ELSE 4800
  470. 4660 GET#1,RE:GOSUB 5500:PW=INSTR(S$,";"):PW$=""
  471. 4670 IF PW=0 OR N$=SYS3$ OR PERS OR OK THEN PERS=0:GOTO 4700
  472. 4680 PW$=MID$(S$,PW+1):GOSUB 5040:A1$="Password: ":N=1:GOSUB 5040
  473. 4690 C=1:GOSUB 5170:IF B$<>PW$ THEN A$="Incorrect.":GOTO 4810
  474. 4700 S$=" 0"+":"+STR$(G):GOSUB 5450:PUT#1,RE:CLOSE
  475. 4710 A$="Updating Message file...":N=1:GOSUB 5040
  476. 4720 OPEN "R",1,DSK2$+"MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
  477. 4730 MI=MI+1:IF MI>MZ THEN 4800 ELSE G=M(MI,1)
  478. 4740 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 4730
  479. 4750 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 5450:PUT#1,RE:M(MI,1)=0
  480. 4760 CLOSE#1:A$="Updating Message count...":GOSUB 5040
  481. 4770 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD#1,5 AS RR$
  482. 4780 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS
  483. 4790 GOSUB 5040:A$="Message killed.":GOTO 4810
  484. 4800 A$="Message not found."
  485. 4810 CLOSE:GOSUB 5040:GOTO 4530
  486. 4820 REM
  487. 4850 GOSUB 5020
  488. 4860 OPEN "R",1,DSK3$+"USERS",62:FIELD#1,1 AS MU$,1 AS SU$,60 AS RR$
  489. 4870 FIELD#1,10 AS NN$:GET#1,1:NU=VAL(NN$)
  490. 4880 GOSUB 5040
  491. 4890 FOR J=NU+1 TO 2 STEP -1
  492. 4900 GET#1,J:IF SU$="*" THEN 4960
  493. 4902 IF N$=SYS3$ THEN 4910
  494. 4904 IF B$="UALL" THEN 4910
  495. 4906 IF MU$=" " THEN 4960 
  496. 4910 GOSUB 5500:S0$=S$
  497. 4920 I=INSTR(S0$,";"): S1$=LEFT$(S0$,I-1):S2$=MID$(S0$,I+1)
  498. 4930 I=INSTR(S2$,";"): S3$=MID$(S2$,I+1):S2$=LEFT$(S2$,I-1)
  499. 4940 I=INSTR(S3$,";"): S3$=LEFT$(S3$,I-1)
  500. 4950 A$=S1$+" "+S2$+", "+S3$:GOSUB 5040
  501. 4960 IF BK THEN 4980
  502. 4970 NEXT J
  503. 4980 CLOSE:GOSUB 5040:RETURN
  504. 4990 REM
  505. 5010 REM
  506. 5020 GOSUB 5040
  507. 5030 A$="Use CTL-S or S to PAUSE, CTL-K or K to ABORT."
  508. 5040 REM
  509. 5070 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
  510. 5080 IF A1$<>"" THEN A$=A1$:A1$=""
  511. 5090 IF N=1 THEN PRINT A$;:PP$=A$:GOTO 5140
  512. 5100 BI=ASC(INKEY$+" ")
  513. 5110 IF BI=&H13 OR BI=&H53 OR BI=&H73 THEN BI=ASC(INPUT$(1)):GOTO 5130
  514. 5120 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN BK=-1:GOTO 5150 
  515. 5130 PRINT A$
  516. 5140 A=A+LEN(A$)
  517. 5150 A$="":N=0
  518. 5160 RETURN
  519. 5170 REM
  520. 5200 IF BEL AND SAV$="" THEN PRINT CHR$(7);
  521. 5210 B$="":BK=0
  522. 5220 IF SAV$="" THEN GOSUB 6210:IF C<>3 THEN PRINT
  523. 5230 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 5250
  524. 5240 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
  525. 5250 IF LEN(B$)=0 THEN C=0:RETURN
  526. 5260 IF C=0 THEN 5280
  527. 5270 CY$=B$:GOSUB 7100:B$=CY$
  528. 5280 D=D+LEN(B$):C=0
  529. 5290 RETURN
  530. 5300 REM
  531. 5310 REM
  532. 5315 IF ERL=420 THEN RESUME 430
  533. 5320 IF ERL=440 THEN RESUME 450
  534. 5330 IF ERL=920 THEN RE=0:RESUME 930
  535. 5340 IF ERL=1000 THEN RESUME 1040
  536. 5350 IF ERL=1200 THEN RESUME 1350
  537. 5360 IF ERL=1980 THEN RESUME 2000
  538. 5370 IF ERL=2960 THEN RESUME 2970
  539. 5380 IF ERL=2990 THEN RESUME 3000
  540. 5390 IF ERL=3220 THEN RESUME 3540
  541. 5400 IF ERL=3750 THEN RESUME 3870
  542. 5410 IF ERL=4270 THEN RESUME 4300
  543. 5420 IF ERL=5710 THEN RESUME 5760
  544. 5430 IF ERL=6740 THEN RESUME 6850
  545. 5435 IF ERL=9070 THEN RESUME 9090
  546. 5440 RESUME NEXT
  547. 5450 REM
  548. 5470 REM
  549. 5480 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  550. 5490 RETURN
  551. 5500 REM
  552. 5530 ZZ=LEN(RR$)-2
  553. 5540 WHILE MID$(RR$,ZZ,1)=" "
  554. 5550 ZZ=ZZ-1:IF ZZ=1 THEN 5570
  555. 5560 WEND
  556. 5570 S$=LEFT$(RR$,ZZ)
  557. 5580 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
  558. 5590 RETURN
  559. 5600 REM
  560. 5630 XPR=NOT XPR:RETURN
  561. 5640 REM
  562. 5670 BEL=NOT BEL:RETURN
  563. 5680 REM
  564. 5710 OPEN "I",1,DSK$+FIL$:BK=0:IF EOF(1) THEN 5760
  565. 5720 IF NW=0 THEN GOSUB 5020 ELSE NW=0
  566. 5730 GOSUB 5040
  567. 5740 IF EOF(1) OR BK THEN 5760 ELSE LINE INPUT #1,A$:GOSUB 5040:GOTO 5740
  568. 5750 GOSUB 5040
  569. 5760 CLOSE #1:RETURN
  570. 5770 REM
  571. 5800 IF N$=SYS3$ GOTO 5840
  572. 5805 IF MF$="#" OR MF$="!" THEN GOTO 5840
  573. 5810 GOSUB 5040
  574. 5820 A$=ANS1$:GOSUB 5040:GOSUB 5040:RETURN
  575. 5830 REM
  576. 5840 GOSUB 5040
  577. 5850 A$="Hit Ctrl K to Abort listing":GOSUB 5040
  578. 5860 GOSUB 5040
  579. 5870 OPEN "R",1,DSK3$+"CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
  580. 5880 CA=CN
  581. 5890 FOR CNT=SIZ+1 TO 2 STEP -1
  582. 5900 GET #1,CNT:GOSUB 5500
  583. 5910 A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 5040:IF BK THEN 5940
  584. 5920 CA=CA-1
  585. 5930 NEXT CNT
  586. 5940 CLOSE:GOSUB 5040
  587. 5950 A$="*** End of CALLERS ***":GOSUB 5040:GOSUB 5040:RETURN
  588. 5960 REM
  589. 5980 REM
  590. 5990 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")<>0 THEN PERS=-1
  591. 6000 IF N$=SYS3$ THEN 6030    
  592. 6005 IF MF$="#" AND FLG=1 THEN 6030
  593. 6008 IF FLG=1 AND MF$>" " AND SCAN$="Y" THEN 6030  'Let valid users see 
  594. 6010 GET #1,RE+3:GOSUB 6050:IF OK THEN 6030
  595. 6020 GET #1,RE+2:GOSUB 6050
  596. 6030 RETURN
  597. 6050 GOSUB 5500:I=INSTR(S$," "):S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
  598. 6060 IF S1$=N$ AND S2$=O$ THEN OK=-1 ELSE OK=0
  599. 6070 RETURN
  600. 6080 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
  601. 6090 RETURN
  602. 6100 REM
  603. 6130 GOSUB 5040:OPEN "R",1,DSK2$+"COMMENTS",65:RE=1:FIELD#1,65 AS RR$
  604. 6140 GET#1,RE:RE=RE+1:IF EOF(1) THEN 6160
  605. 6150 GOSUB 5500:A$=S$:GOSUB 5040:GOTO 6140
  606. 6160 CLOSE:GOSUB 5040:IF RE=2 THEN RETURN
  607. 6170 A$="*** End of COMMENTS ***":GOSUB 5040:GOSUB 5040
  608. 6180 IF RE>3 THEN 6190 ELSE RETURN
  609. 6190 A1$="Delete COMMENTS file? ":GOSUB 6940:IF OK THEN KILL DSK2$+"COMMENTS"
  610. 6200 RETURN
  611. 6210 REM
  612. 6240 CHC=0: SAV$="":DC=0:IC=&H30
  613. 6250 NCH=ASC(INPUT$(1))
  614. 6260 IF NCH=13 THEN RETURN 'CR
  615. 6270 IF NCH=127 THEN 6350
  616. 6280 IF NCH<32 THEN 6370
  617. 6290 IF CHC>=63 THEN PRINT CHR$(7);:GOTO 6250
  618. 6300 SAV$=SAV$+CHR$(NCH): CHC=CHC+1 :IC=IC+1:IF IC=&H3A THEN IC=&H30
  619. 6310 IF DC THEN PRINT CHR$(10);
  620. 6320 IF C<>2 THEN PRINT CHR$(NCH); ELSE PRINT CHR$(IC);
  621. 6330 IF CHC=55 THEN PRINT CHR$(7);
  622. 6340 DC=0:GOTO 6250
  623. 6350 IF CHC=0 THEN 6250 ELSE PRINT BSL$;:DC=-1
  624. 6360 CHC=CHC-1:IC=IC-1: SAV$=LEFT$(SAV$,CHC): GOTO 6250
  625. 6370 IF CHC=0 THEN 6250
  626. 6380 IF NCH=8 THEN PRINT ERS$;:DC=0:GOTO 6360 'BS
  627. 6390 IF NCH=12 THEN GOSUB 6450:GOTO 6460 '^L
  628. 6400 IF NCH=18 THEN PRINT:PRINT PP$;:GOTO 6460 '^Retype
  629. 6410 IF NCH=21 THEN PRINT " #": PRINT PP$;:DC=0:GOTO 6240 '^U
  630. 6420 IF NCH<>24 THEN 6250 '^X
  631. 6430 GOSUB 6450
  632. 6440 GOTO 6240
  633. 6450 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: RETURN
  634. 6460 IF C<>2 THEN PRINT SAV$;: GOTO 6480
  635. 6470 IC=&H30:FOR BCC=1 TO CHC: IC=IC+1: PRINT CHR$(IC);: NEXT BCC
  636. 6480 DC=0:GOTO 6250
  637. 6490 REM
  638. 6520 GOSUB 5040
  639. 6530 A$="Enter at least six alphanumeric characters":GOSUB 5040
  640. 6540 A1$="for your PASSWORD:  "
  641. 6550 N=1:GOSUB 5040:C=2:GOSUB 5170:S04$=B$:IF S04$="" THEN 6520
  642. 6560 IF LEN(S04$)<6 THEN 6520
  643. 6570 A1$="Now enter it again: "
  644. 6580 N=1:GOSUB 5040:C=2:GOSUB 5170
  645. 6590 IF S04$<>B$ THEN A1$="No match.  Try again.":GOSUB 5040:GOTO 6520
  646. 6600 A$="OK, now please remember it.":GOSUB 5040:GOSUB 5040:RETURN
  647. 6610 REM
  648. 6640 IF N$<>SYS3$ THEN 6860
  649. 6650 A1$="User's FIRST Name: ":N=1:GOSUB 5040
  650. 6660 C=1:GOSUB 5170:T01$=B$:IF T01$="" THEN RETURN
  651. 6670 A1$="User's LAST Name:  ":N=1:GOSUB 5040
  652. 6680 C=1:GOSUB 5170:T02$=B$:IF T02$="" THEN RETURN
  653. 6690 OK=0:GOSUB 6710:IF OK THEN GOSUB 7550:GOTO 6650
  654. 6700 A$="Not found.":GOSUB 5040:GOTO 6650
  655. 6710 REM
  656. 6740 OPEN "R",1,DSK3$+"USERS",62:FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
  657. 6750 FOR J=2 TO NU+1:GET#1,J:GOSUB 5500:S00$=MID$(S$,3)
  658. 6760 I=INSTR(S00$,";"): S01$=LEFT$(S00$,I-1):S02$=MID$(S00$,I+1)
  659. 6770 I=INSTR(S02$,";"): S03$=MID$(S02$,I+1):S02$=LEFT$(S02$,I-1)
  660. 6780 I=INSTR(S03$,";"): S04$=MID$(S03$,I+1):S03$=LEFT$(S03$,I-1)
  661. 6790 I=INSTR(S04$,";"): IF I=0 THEN S05$="0":GOTO 6810
  662. 6800 S05$=MID$(S04$,I+1):S04$=LEFT$(S04$,I-1)
  663. 6810 HM=VAL(S05$)
  664. 6820 IF T01$<>S01$ OR T02$<>S02$ THEN 6840
  665. 6830 MFJ$=LEFT$(S$,1):GOSUB 5040:UJ=J:OK=-1:CLOSE:RETURN
  666. 6840 NEXT J
  667. 6850 CLOSE:RETURN
  668. 6860 REM
  669. 6890 MFJ$=MF$
  670. 6900 GOSUB 6490
  671. 6910 OPEN "R",1,DSK3$+"USERS",62:FIELD#1,62 AS RR$
  672. 6920 S$=MFJ$+" "+S01$+";"+S02$+";"+S03$+";"+S04$+";"+STR$(HM)
  673. 6930 RL=62:GOSUB 5450:PUT#1,UJ:CLOSE:RETURN
  674. 6940 '
  675. 6970 A2$=A1$:OK=0
  676. 6980 A1$=A2$:N=1:GOSUB 5040:C=1:GOSUB 5170:ANS$=LEFT$(B$,1)
  677. 6990 IF ANS$="" THEN 6980 ELSE IF ANS$="Y" THEN OK=-1:RETURN
  678. 7000 IF ANS$="N" THEN RETURN
  679. 7005 A$="<Y or N>":GOSUB 5040:GOTO 6940
  680. 7010 A$="That's an invalid message number, "+CN$+".":GOSUB 5040:SAV$="":RETURN
  681. 7020 '
  682. 7050 FOR ZZ=2 TO LEN(CX$)
  683. 7060 ZA=ASC(MID$(CX$,ZZ,1)):IF ZA<&H41 OR ZA>&H5A THEN 7080
  684. 7070 MID$(CX$,ZZ,1)=CHR$(ZA+&H20)
  685. 7080 NEXT ZZ
  686. 7090 RETURN
  687. 7100 REM
  688. 7130 FOR ZZ=1 TO LEN(CY$)
  689. 7140 ZA=ASC(MID$(CY$,ZZ,1)):IF ZA<&H61 OR ZA>&H7A THEN 7160
  690. 7150 MID$(CY$,ZZ,1)=CHR$(ZA-&H20)
  691. 7160 NEXT ZZ
  692. 7170 RETURN
  693. 7180 REM
  694. 7210 T01$=T$:T02$=""
  695. 7220 IF T$=SYS3$ OR T$="ALL" THEN OK=-1:RETURN
  696. 7230 U01$=S01$:U02$=S02$:U03$=S03$:U04$=S04$:SHM=HM:SUJ=UJ:SMF$=MF$
  697. 7240 I=INSTR(T$," "): IF I=0 THEN OK=0:GOTO 7270
  698. 7250 T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1):OK=0:GOSUB 6710
  699. 7260 S01$=U01$:S02$=U02$:S03$=U03$:S04$=U04$:HM=SHM:UJ=SUJ:MF$=SMF$
  700. 7270 IF NOT OK THEN A1$="Not a currently known User.  OK? ":GOSUB 6940
  701. 7280 RETURN
  702. 7290 REM
  703. 7320 IF T$=SYS3$ OR T$="ALL" THEN TX$=T$:RETURN
  704. 7330 CX$=T01$:GOSUB 7020:T01$=CX$:CX$=T02$:GOSUB 7020:T02$=CX$
  705. 7340 TX$=T01$+" "+T02$
  706. 7350 RETURN
  707. 7360 CX$=N$:GOSUB 7020:CN$=CX$:CX$=O$:GOSUB 7020:CO$=CX$:RETURN
  708. 7370 REM
  709. 7380 A$=" ":GOSUB 5040:GOSUB 5040:GOSUB 5040
  710. 7390 A$="> "+CN$+" "+CO$+" <...You have entered the CHAT mode":GOSUB 5040
  711. 7400 A1$="Shall I page the SYSOP  <Y OR N>  ":GOSUB 6940
  712. 7410 IF NOT OK THEN RETURN
  713. 7420 FOR T1=1 TO 5
  714. 7430 PRINT CHR$(7);
  715. 7440 FOR T2=1 TO BEEP:NEXT T2
  716. 7450 NEXT T1
  717. 7460 GOSUB 5040:GOSUB 5040
  718. 7470 A$="Type /EX to Exit the CHAT mode":GOSUB 5040
  719. 7480 A$="":GOSUB 5040
  720. 7490 BELS=BEL:BEL=0
  721. 7500 A1$=">":N=1:GOSUB 5040:GOSUB 5170
  722. 7510 IF B$="/EX" OR B$="/ex" THEN BEL=BELS:RETURN
  723. 7520 GOTO 7500
  724. 7530 GOTO 1420
  725. 7550 '
  726. 7570 IF N$<>SYS3$ THEN GOTO 1420 'DOUBLE CHECK IF SYSOP
  727. 7571 GOSUB 5040
  728. 7572 A$=S01$+" "+S02$+" "+"   password-> "+S04$+" < ====>> ":N=1:GOSUB 5040
  729. 7573 IF MFJ$=" " THEN A$="Unvalidated User":GOTO 7578
  730. 7574 IF MFJ$="!" THEN A$="Validated User":GOTO 7578
  731. 7575 IF MFJ$="#" THEN A$="SUPER User":GOTO 7578
  732. 7576 IF MFJ$="*" THEN A$="TWIT Status":GOTO 7578
  733. 7577 A$="User log ERROR"
  734. 7578 N=1:GOSUB 5040
  735. 7579 GOSUB 5040:A$=" ":GOSUB 5040
  736. 7580 A1$="Change <P>assword or <V>alidate this user ->":N=1:GOSUB 5040
  737. 7585 C=1:GOSUB 5170:IF B$="P" THEN GOTO 6900
  738. 7590 IF B$="V" THEN 7600
  739. 7595 B$="":GOTO 6650
  740. 7600 GOSUB 5040
  741. 7610 A1$="Enter validation authorization Password ->":N=1:GOSUB 5040
  742. 7620 C=2:GOSUB 5170:IF B$=VAP$ THEN 7640
  743. 7630 GOTO 6650 'GO BACK AND TRY AGAIN
  744. 7640 A1$="<T>wit, <V>alid user or <S>uper user ->":N=1:GOSUB 5040
  745. 7650 C=1:GOSUB 5170
  746. 7652 IF B$="T" THEN MFJ$="*":GOTO 7660
  747. 7654 IF B$="S" THEN MFJ$="#":GOTO 7660
  748. 7655 MFJ$="!"
  749. 7660 GOTO 6910
  750. 7670 REM
  751. 7700 FIL$="NEWS":NW=0:GOSUB 5680
  752. 7705 IF NNUM=0 THEN RETURN
  753. 7710 A1$="News file number 1 -"
  754. 7715 A1$=A1$+STR$(NNUM)+",  "+STR$(NNUM+1)+" to Exit  --> "
  755. 7720 N=1:GOSUB 5040:C=1:GOSUB 5170
  756. 7730 IF B$="" THEN 7710
  757. 7740 FQ=VAL(B$):IF FQ<1 OR FQ>NNUM THEN RETURN
  758. 7750 FIL$="NEWS"+MID$(STR$(FQ),2):NW=0:GOSUB 5680:GOTO 7700
  759. 7800 FIL$="TWIT":NW=1:GOSUB 5680
  760. 7810 GOTO 4130
  761. 7830 FIL$="XMODEM.LOG":NW=0:GOSUB 5680: RETURN
  762. 7900 FIL$="HELP":NW=0:GOSUB 5680
  763. 7905 IF HNUM=0 THEN RETURN
  764. 7910 A1$="HELP File number 1 -"
  765. 7915 A1$=A1$+STR$(HNUM)+",  "+STR$(HNUM+1)+"  to exit -->"
  766. 7920 N=1:GOSUB 5040:C=1:GOSUB 5170
  767. 7930 IF B$="" THEN 7910
  768. 7940 FQ=VAL(B$):IF FQ<1 OR FQ>HNUM THEN RETURN
  769. 7950 FIL$="HELP"+MID$(STR$(FQ),2):NW=0:GOSUB 5680:GOTO 7900
  770. 8000 IF MSYS=1 THEN O$="":GOTO 8030
  771. 8005 GOSUB 5040:A1$="Which SYSOP are you -> ":N=1:GOSUB 5040
  772. 8010 C=1:GOSUB 5170:IF B$="" THEN 8005
  773. 8020 O$=B$
  774. 8030 CN$=N$:CO$=O$:GOSUB 5600:RETURN
  775. 9000 '
  776. 9005 IF DATIM$="Y" THEN GOTO 9070
  777. 9030 A1$="Today's Date/Time (MM/DD|HH:MM) ":N=1:GOSUB 5040:GOSUB 5170
  778. 9040 IF B$="" THEN 9030 ELSE D$=B$
  779. 9050 IF LEN(D$) >11 THEN PRINT "Please use correct format":GOTO 9030
  780. 9060 RETURN
  781. 9070 OPEN "I",1,DSK$+"DATETIME.DAT":IF EOF(1) THEN 9090
  782. 9080 INPUT #1,D$
  783. 9090 CLOSE #1
  784. 9095 RETURN
  785.  
  786.