home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol250 / rbbs38a.asc < prev    next >
Encoding:
Text File  |  1994-07-13  |  38.0 KB  |  1,046 lines
  1. 1  ' Remote Bulletin Board System V 3.8A  (7/30/85)
  2. 2  ' 
  3. 4  ' Revised from RBBS V. 3.7  &  3.8
  4. 5  '
  5. 6  ' By Dennis Recla  Lillypond Softwares  
  6. 8  '                    Garland, Texas  
  7. 9  '
  8. 10 DEFINT A-Z
  9. 20 ' 
  10. 30 DIM A$(25),M(200,2)
  11. 40 ' 
  12. 60 ' 
  13. 70 ' Local mods section and default values
  14. 80 ' 
  15. 90 VERS1$="RBBS v 3.8 without (BOOTPWD) and (pwds) files."
  16. 100 ' 
  17. 110 VERS2$="Lillypond Software RBBS v 3.8A (07/30/85)"
  18. 120 ' 
  19. 130 SYS1$="dennis"    ' name of SYSOP so that when you log in RBBS
  20. 140 ' 
  21. 150 SYS2$="recla"    ' will check for mail to SYSOP and SYS1$,SYS2$
  22. 160 ' 
  23. 170 SYS3$="SYSOP"    ' this is the FIRST NAME for SYSOP entry to system
  24. 180 ' 
  25. 190 P2$="supersysop"    ' this is the LAST NAME for SYSOP entry to system
  26. 200 ' 
  27. 210 P1$="goto-cpm"    ' this is the FIRST NAME for direct entry to CP/M
  28. 220 ' 
  29. 230 P3$="ddt"        ' CP/M entry password
  30. 240 ' 
  31. 250 VAP$="password"    ' password for use of validation software by SYSOP
  32. 260 ' 
  33. 270 PC$="What is the DRI debugger? " ' CP/M entry password prompt
  34. 280 ' 
  35. 290 DSK$="A:"        ' drive to first look for non DSK2$ or DSK3$ files. 
  36. 300 ' 
  37. 310 DSK2$="A:"        ' if no PWDS file default to drive A:
  38. 320 ' 
  39. 330 DSK3$="A:"        ' additional drive area for files
  40. 340 ' 
  41. 350 DSK4$="A:"        ' location for HELP files
  42. 360 ' 
  43. 370 DSK5$="A:"        ' location for NEWS files
  44. 375 ' 
  45. 380 DSK6$=DSK$        ' store DSK$
  46. 385 '
  47. 390 DFIL$="DUMMY"    ' file to run from 'D' command
  48. 395 '
  49. 400 EPRG$="NOFILE"    ' Name of file to run on EXIT to CP/M
  50. 405 ' 
  51. 410 ANS1$=" >> You can not do that << "
  52. 415 ' 
  53. 420 NSP$="No spaces."
  54. 425 '
  55. 430 EXIT$="BYE.COM"    ' program to run on exit 
  56. 435 '
  57. 440 ERS$=CHR$(8)+" "+CHR$(8)
  58. 445 ' 
  59. 450 BSL$=CHR$(8)+"/"+CHR$(8)
  60. 455 '
  61. 460 TWIT=-1        ' logout TWITs
  62. 465 ' 
  63. 470 DATIM=0        ' no external clock
  64. 480 ' 
  65. 490 BEEP=20000        ' 20,000 counts for CHAT
  66. 500 ' 
  67. 510 SIZE=15        ' 15 line messages
  68. 520 ' 
  69. 530 WHEEL=0        ' Do not set WHEEL on SYSOP exit
  70. 560 ' 
  71. 570 MSYS=0        ' not multi-SYSOPs
  72. 600 ' 
  73. 610 NNUM=0        ' number of NEWS files
  74. 620 ' 
  75. 630 HNUM=0        ' number of HELP files
  76. 640 ' 
  77. 650 SEC=-1        ' secure mode
  78. 660 ' 
  79. 670 SKIP=-1        ' skip "highest message read" info
  80. 680 ' 
  81. 690 LMSG=3        ' only SUPER users can enter messages
  82. 700 ' 
  83. 710 GOCPM=3        ' only SUPER users can go to CP/M
  84. 720 ' 
  85. 730 SHOLOC=0        ' do not store CALLERS or show USERS locations
  86. 740 ' 
  87. 750 LOGALL=0        ' do not put unvalidated in CALLERS file
  88. 760 ' 
  89. 770 SHOALL=0        ' do not show unvalidated in USERS file
  90. 780 ' 
  91. 790 ' This is the official start of the program
  92. 800 ' 
  93. 810 POKE 0,&HCD        ' change the JUMP (C3) at 0 to a CALL (CD)
  94. 820 '                   this prevents the system from rebooting
  95. 830 ' 
  96. 840 INC=1
  97. 850 ON ERROR GOTO 7390
  98. 860 RFLG=PEEK(&H5D):POKE &H5D,&H20
  99. 870 RTNOKFLG=PEEK(&H5B):POKE &H5B,120    ' legal return flag.
  100. 880 ' 
  101. 890 ' Signon functions
  102. 900 ' 
  103. 910 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1:NW=0
  104. 920 BK=0:GOSUB 7130
  105. 930 ' 
  106. 940 ' Original file loaded with passwords
  107. 950 ' 
  108. 960 OPEN "I",1,DSK$+"BOOTPWD":IF EOF(1) THEN 1000
  109. 970 ' 
  110. 980 INPUT #1,DSK2$,DSK3$,DSK4$,DSK5$,SYS1$,SYS2$,VERS1$,TWIT
  111. 985 INPUT #1,DATIM,SEC,SHOLOC,DFIL$,EPRG$,WHEEL 
  112. 990 ' 
  113. 1000 CLOSE #1
  114. 1010 ' 
  115. 1020 PRINT VERS1$    ' print name of system
  116. 1030 ' 
  117. 1040 GOSUB 7130:GOSUB 7130  ' put a space between VERS1 & VERS2
  118. 1050 ' 
  119. 1060 ' Second passwords file loaded
  120. 1070 ' 
  121. 1080 OPEN "I",1,DSK2$+"pwds":IF EOF(1) THEN 1130
  122. 1090 ' 
  123. 1100 INPUT #1,P1$,P2$,P3$,PC$,VAP$,EXIT$,LOGALL,SHOALL
  124. 1110 INPUT #1,BEEP,SIZE,MSYS,NNUM,HNUM,SKIP,LMSG,GOCPM
  125. 1120 ' 
  126. 1130 CLOSE #1
  127. 1140 ' 
  128. 1150 BEL=-1:XPR=0    ' initial bell on, not expert
  129. 1155 '
  130. 1160 NEWUSER=0
  131. 1165 ' 
  132. 1170 PRINT VERS2$    ' print the program id
  133. 1180 ' 
  134. 1190 GOSUB 7130:GOSUB 7130:SAV$=""
  135. 1200 IF RFLG<>ASC("P") THEN 1300
  136. 1210 IF RTNOKFLG<>ASC("x") THEN 1300
  137. 1220 V=0:INC=0        ' so caller number says same
  138. 1230 OPEN "I",1,DSK3$+"LASTCALR":INPUT #1,N$,O$,D$:CLOSE
  139. 1240 A$="Welcome back, "
  140. 1250 IF N$<>SYS3$ THEN 1270
  141. 1260 CN$=N$:O$="":CO$=O$:A$=A$+N$+".":GOSUB 7130:GOSUB 7130:V=1:GOTO 2160
  142. 1270 GOSUB 9450:V=1
  143. 1280 A$=A$+CN$+" "+CO$+".":GOSUB 7130:GOSUB 7130
  144. 1290 T01$=N$:T02$=O$:GOSUB 8800:MF$=MFJ$:GOTO 2160
  145. 1300 GOSUB 3580:IF NOT BK THEN NW=1:GOSUB 3540                          ' print INFO, then BULLETIN
  146. 1310 GOSUB 7130:BK=0
  147. 1320 ' 
  148. 1330 R=0                        ' only give them three
  149. 1340 S=0:IF R=3 THEN 1690 ELSE 1360     ' chances to get it right
  150. 1350 ' 
  151. 1360 S=S+1:A1$="Enter your FIRST Name: ":N=1:GOSUB 7130
  152. 1370 C=1:GOSUB 7260:N$=B$:IF N$="" THEN 1360
  153. 1380 IF P1$="NOPASS" THEN 1400                                          ' skip past the following
  154. 1390 IF N$=P1$ AND P1$<>"NOPASS" THEN POKE &H5B,0:GOTO 3440             ' direct CP/M exit
  155. 1400 IF N$<"A" OR LEN(N$)=1 THEN 1360
  156. 1410 ' 
  157. 1420 ' Check for spaces in the callers first name
  158. 1430 ' 
  159. 1440 IF INSTR(N$," ")>0 THEN A1$=NSP$:N=1:GOSUB 7130:GOSUB 7130:GOTO 1360
  160. 1450 ' 
  161. 1460 A1$="Enter your LAST Name:  ":N=1:GOSUB 7130
  162. 1470 C=1:IF N$=SYS3$ THEN C=2
  163. 1480 GOSUB 7260:O$=B$:IF O$="" THEN 1360
  164. 1490 IF O$<"A" OR LEN(O$)=1 THEN 1360
  165. 1500 ' 
  166. 1510 IF N$=SYS3$ AND O$=P2$ THEN GOSUB 10310:GOTO 1820                  ' this must be a SYSOP
  167. 1520 ' 
  168. 1530 IF N$=SYS3$ THEN GOSUB 7130:A1$="Not the SYSOP!":GOSUB 7130:GOTO 6370
  169. 1540 ' 
  170. 1550 ' Check for spaces in the callers last name
  171. 1560 ' 
  172. 1570 IF INSTR(O$," ")>0 THEN A1$=NSP$:N=1:GOSUB 7130:GOSUB 7130:GOTO 1460
  173. 1580 ' 
  174. 1590 GOSUB 7130:A$="Checking File...":GOSUB 7130
  175. 1600 V=0:T01$=N$:T02$=O$:OK=0:GOSUB 8800:IF OK THEN MF$=MFJ$:GOTO 1610 ELSE 1650
  176. 1610 T=0
  177. 1620 T=T+1:IF T=4 THEN 1690 ELSE A1$="Enter your PASSWORD: "
  178. 1630 N=1:GOSUB 7130:C=2:GOSUB 7260:UPW$=B$:IF UPW$="" THEN 1620
  179. 1640 IF UPW$=S04$ THEN 1820 ELSE 1620
  180. 1650 IF S=3 THEN 1690 ELSE:GOSUB 7130:A1$="First time caller? (Y/N) ":GOSUB 9030
  181. 1660 IF NOT OK THEN A$="Try again.":GOSUB 7130:GOSUB 7130:GOTO 1360
  182. 1670 IF NOT SEC THEN 1700                                               ' not in secure mode
  183. 1680 GOSUB 7130:A$="Private system!":GOSUB 7130:GOTO 6370
  184. 1690 GOSUB 7130:A1$="Too many errors!":GOSUB 7130:GOTO 6370
  185. 1700 V=1:GOSUB 8560                                                     ' get caller to set their own password
  186. 1710 A1$="Enter your LOCATION (City, State): ":N=1:GOSUB 7130
  187. 1720 C=1:GOSUB 7260:S03$=B$:IF S03$="" THEN 1710
  188. 1730 GOSUB 9450
  189. 1740 GOSUB 7130:A$=CN$+" "+CO$+" from "+S03$:GOSUB 7130
  190. 1750 R=R+1:A1$="All Correct? (Y/N) ":GOSUB 9030:IF NOT OK THEN 1340
  191. 1760 HM=0:S05$=STR$(HM):S$="  "+N$+";"+O$+";"+S03$+";"+S04$+";"+S05$
  192. 1770 OPEN "R",1,DSK3$+"USERS",62:FIELD #1,62 AS RR$
  193. 1780 RL=62:GOSUB 7580:NU=NU+1:PUT #1,NU+1:S$=STR$(NU):GOSUB 7580:PUT #1,1:CLOSE
  194. 1790 ' 
  195. 1800 FIL$="NEWCOM":NW=1:GOSUB 7810:MF$=" ":NEWUSER=-1                   ' flag NEWCOM for new user
  196. 1810 ' 
  197. 1820 GOSUB 7130:A$="Logging to disk...":GOSUB 7130:GOSUB 7130:RE=1
  198. 1830 ' 
  199. 1840 ' Prompt caller for correct date
  200. 1850 ' 
  201. 1860 OPEN "I",1,DSK$+"DATE.DAT":IF EOF(1) THEN 1910
  202. 1870 INPUT #1,D$
  203. 1880 IF DATIM THEN 1950
  204. 1885 IF MF$=" " OR MF$="*" THEN CLOSE #1:GOTO 1990 
  205. 1890 A1$="Is "+D$+" todays date? (Y/N) ":GOSUB 9030:IF NOT OK THEN 1910
  206. 1900 CLOSE #1:GOTO 1990
  207. 1910 A1$="Enter todays date: (MM/DD/YY) ":N=1:GOSUB 7130
  208. 1920 C=1:GOSUB 7260:IF B$="" OR LEN(B$)<>8 THEN 1910
  209. 1930 CLOSE #1:OPEN "O",1,DSK$+"DATE.DAT":PRINT #1,B$
  210. 1940 D$=B$
  211. 1950 CLOSE #1
  212. 1980 ' 
  213. 1990 IF N$=SYS3$ THEN 2140                                              ' do not log SYSOP
  214. 2000 ' 
  215. 2010 IF MF$="*" THEN 2140                                               ' do not log TWITS
  216. 2020 ' 
  217. 2030 IF MF$=" " AND NOT LOGALL THEN 2140                                ' log UNVALIDATED if LOGALL
  218. 2040 ' 
  219. 2050 OPEN "R",1,DSK3$+"CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:RE=VAL(RR$)+1
  220. 2060 S$=STR$(RE):RL=60:GOSUB 7580:PUT #1,1:RE=RE+1
  221. 2070 IF SHOLOC THEN LOC$=S03$ ELSE LOC$=" "                ' store location in CALLERS file
  222. 2100 S$=N$+" "+O$+" "+LOC$+" "+D$:GOSUB 7580:PUT #1,RE:CLOSE #1
  223. 2110 ' 
  224. 2120 ' Put callers name and date/time in the LASTCALR file
  225. 2130 ' 
  226. 2140 OPEN "O",1,DSK3$+"LASTCALR":PRINT #1,N$;",";O$;",";D$:CLOSE
  227. 2150 ' 
  228. 2160 PRINT
  229. 2170 ' 
  230. 2180 ' Check this callers status
  231. 2185 '
  232. 2190 IF MF$="#" THEN GOSUB 7730:GOSUB 7770                 ' SUPER user is XPERT and no bell
  233. 2195 '
  234. 2200 IF MF$="*" AND TWIT THEN 10090                                     ' if it is * then you have a TWIT
  235. 2220                                                            ' if TWIT then log the dummy off
  236. 2230 '                                                                    but first tell him to go away
  237. 2240 ' 
  238. 2250 IF V=0 THEN IF N$<>SYS3$ THEN GOSUB 9450
  239. 2260 BK=0:CN=1:M=0:U=0
  240. 2270 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD #1,5 AS RR$
  241. 2280 GET #1,CALLS:IF N$=SYS3$ THEN CN=VAL(RR$) ELSE CN=VAL(RR$)+INC
  242. 2290 GET #1,MSGS:M=VAL(RR$)
  243. 2300 GET #1,MNUM:U=VAL(RR$)
  244. 2310 A$="Caller number:          ":N=1:GOSUB 7130
  245. 2320 A$=STR$(CN):LSET RR$=A$
  246. 2330 A$=SPACE$(4-LEN(STR$(CN)))+STR$(CN):PUT #1,CALLS:GOSUB 7130
  247. 2340 A$="Active messages:        ":N=1:GOSUB 7130
  248. 2350 A$=SPACE$(4-LEN(STR$(M)))+STR$(M):GOSUB 7130
  249. 2360 A$="Highest message number: ":N=1:GOSUB 7130
  250. 2370 A$=SPACE$(4-LEN(STR$(U)))+STR$(U):GOSUB 7130:CLOSE
  251. 2380 ' 
  252. 2390 IF N$=SYS3$ THEN 2500                                              ' no need to tell SYSOP this
  253. 2400 ' 
  254. 2410 IF SKIP THEN 2500                                                  ' skip over all of this too.
  255. 2420 ' 
  256. 2430 IF HM=0 THEN 2500                                                  ' if callers last message was zero
  257. 2435 '
  258. 2440 IF HM<=U THEN 2460 ELSE HM=0
  259. 2445 A$="Messages have been renumbered: ":N=1:GOSUB 7130:GOTO 2500  
  260. 2450 '                                                                    then skip the next message
  261. 2455 ' 
  262. 2460 A$="Highest message read:   ":N=1:GOSUB 7130
  263. 2470 ' 
  264. 2480 A$=SPACE$(4-LEN(STR$(HM)))+STR$(HM):GOSUB 7130
  265. 2490 ' 
  266. 2500 GOSUB 7130:A$=" ":GOSUB 7130:IHM=HM
  267. 2510 ' 
  268. 2520 ' Look for messages to this caller and build their message index
  269. 2530 ' 
  270. 2540 FT=-1:MX=0:MZ=0:IU=0:CNT=0:G=0
  271. 2550 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
  272. 2560 BK=0:GET #1,RE:IF EOF(1) THEN 2700
  273. 2570 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 2690
  274. 2580 IF IU=0 THEN IU=G
  275. 2590 IF G>9998 THEN MZ=MZ-1:GOTO 2700
  276. 2600 GET #1,RE+3:GOSUB 7630
  277. 2610 I=INSTR(S$," "):IF I=0 THEN S1$=S$:S2$="":GOTO 2630
  278. 2620 S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
  279. 2630 IF S1$=N$ AND S2$=O$ THEN 2660
  280. 2640 IF N$<>SYS3$ THEN 2690
  281. 2650 IF S1$=SYS1$ AND S2$=SYS2$ THEN 2660 ELSE 2690
  282. 2660 IF NOT FT THEN 2680
  283. 2670 A$="You have mail...":GOSUB 7130:GOSUB 7130:FT=0
  284. 2680 RX=RE:GOSUB 5820:RE=RX:CNT=CNT+1
  285. 2690 GET #1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 2560
  286. 2700 IF CNT=0 THEN 2715
  287. 2710 GOSUB 7130
  288. 2715 CLOSE
  289. 2720 '
  290. 2730 IF NEWUSER THEN GOSUB 3620
  291. 2735 ' 
  292. 2740 ' Main command acceptor/dispatcher
  293. 2750 ' 
  294. 2760 A$=CN$+" "+CO$+"?   Your command: "
  295. 2765 IF XPR THEN A1$=A$ ELSE GOSUB 7130
  296. 2770 IF NOT XPR THEN A1$=A1$+"  B,E,F,R,S,K,L,G,H,I,J,U,T,X,P,C,N,D ( or ? ): "
  297. 2780 N=1:GOSUB 7130:C=1:GOSUB 7260
  298. 2790 IF B$="" THEN 2760
  299. 2800 FF=INSTR("BER?SKGIJUTXPDCFNLH",B$):GOSUB 2810:GOTO 2760
  300. 2810 IF FF=0 THEN 2980
  301. 2820 ON FF GOTO 3540,3660,4980,3620,5460,6500,6040,3580,3100,6800,7770,7730,8680,3630,9490,6260,9960,7900,10180
  302. 2830 ' 
  303. 2960 ' Special SYSOP functions
  304. 2970 ' 
  305. 2980 IF B$="Z" AND N$=SYS3$ THEN GOSUB 8200:RETURN                      ' print COMMENTS file
  306. 2990 ' 
  307. 3000 IF B$="XL" AND N$=SYS3$ THEN GOSUB 10140:RETURN                    ' print XMODEM.LOG file
  308. 3010 ' 
  309. 3020 IF B$="UALL" AND N$=SYS3$ THEN 6800                                ' print entire USERS file
  310. 3030 ' 
  311. 3040 GOSUB 7130
  312. 3050 A$="I do not understand ("+B$+").":GOSUB 7130:GOSUB 7130
  313. 3060 SAV$="":RETURN
  314. 3070 ' 
  315. 3080 ' Exit to CP/M
  316. 3090 ' 
  317. 3100 T=0
  318. 3110 ' 
  319. 3120 IF N$=SYS3$ THEN 3440                                              ' SYSOP can always go to CP/M
  320. 3130 ' 
  321. 3140 IF MF$="#" THEN 3340                                               ' SUPER user can always go to CP/M
  322. 3150 ' 
  323. 3160 IF GOCPM=3 THEN 3240                                               ' no one can go to CP/M but SUPER user
  324. 3170 ' 
  325. 3180 IF MF$<>"*" AND GOCPM=1 THEN 3290                                  ' let unvalidated users go to CP/M
  326. 3190 ' 
  327. 3200 IF MF$="!" AND GOCPM=2 THEN 3290                                   ' let validated users go to CP/M
  328. 3210 ' 
  329. 3220 ' Tell caller they cannot go to CP/M
  330. 3230 ' 
  331. 3240 GOSUB 7130
  332. 3250 A$=ANS1$:GOSUB 7130:GOSUB 7130:SAV$="":RETURN
  333. 3260 ' 
  334. 3270 ' If NOPASS then a password is not needed
  335. 3280 ' 
  336. 3290 IF P3$="NOPASS" THEN 3340
  337. 3300 ' 
  338. 3310 T=T+1:IF T=2 THEN GOSUB 7130:GOSUB 7130:RETURN
  339. 3320 A1$=PC$:N=1:GOSUB 7130:C=2:GOSUB 7260
  340. 3330 IF B$="" OR B$<>P3$ THEN 3310
  341. 3340 IF XPR THEN 3400
  342. 3350 ' 
  343. 3360 ' Display ENTERCPM
  344. 3370 ' 
  345. 3380 FIL$="ENTERCPM":NW=1:GOSUB 7810
  346. 3390 ' 
  347. 3400 IF IHM<>HM THEN MFJ$=MF$:GOSUB 8970                                ' update the USERS file
  348. 3410 ' 
  349. 3420 GOSUB 6220
  350. 3430 ' 
  351. 3440 POKE 4,0                                                           ' set up to dump to user 0 
  352. 3450 ' 
  353. 3460 IF N$=SYS3$ THEN GOSUB 7130:A$="Entering CP/M...":GOSUB 7130
  354. 3470 ' 
  355. 3480 POKE 0,&HC3                                                        ' change the CALL (CD) at 0 back to a JMP (C3)
  356. 3482 '
  357. 3485 IF N$=SYS3$ AND WHEEL THEN POKE &H3E,255:PRINT:PRINT "Setting Wheel BYTE "
  358. 3488 '
  359. 3490 IF EPRG$="NOFILE" THEN 3500 ELSE RUN EPRG$                ' Run a file on CP/M entry
  360. 3495 '
  361. 3500 SYSTEM                                                             ' JUMP (C3) to restore system.
  362. 3510 ' 
  363. 3520 ' Display BULLETIN file
  364. 3530 ' 
  365. 3540 FIL$="BULLETIN":NW=1:GOSUB 7810:RETURN
  366. 3550 ' 
  367. 3560 ' Display INFO file
  368. 3570 ' 
  369. 3580 FIL$="INFO":NW=1:GOSUB 7810:RETURN
  370. 3590 ' 
  371. 3600 ' Display MENURBBS file
  372. 3610 ' 
  373. 3620 IF N$=SYS3$ THEN FIL$="SYOPMENU" ELSE FIL$="MENURBBS"
  374. 3625 NW=1:GOSUB 7810:RETURN
  375. 3627 '
  376. 3628 ' Print a selected file for valid users
  377. 3629 '
  378. 3630 IF MF$=" " OR MF$="*" THEN 3250
  379. 3635 FIL$=DFIL$:NW=1:GOSUB 7810: RETURN
  380. 3638 ' 
  381. 3640 ' Enter a new message
  382. 3650 ' 
  383. 3660 IF N$=SYS3$ THEN 3810                                              ' SYSOP can always enter messages
  384. 3670 ' 
  385. 3680 IF MF$="#" THEN 3810                                               ' SUPER users can always enter messages
  386. 3690 ' 
  387. 3700 IF LMSG=3 THEN 3780                                                ' no one can enter messages but SUPER users
  388. 3710 ' 
  389. 3720 IF MF$<>"*" AND LMSG=1 THEN 3810                                   ' let unvalidated users enter messages
  390. 3730 ' 
  391. 3740 IF MF$="!" AND LMSG=2 THEN 3810                                    ' let validated users enter messages
  392. 3750 ' 
  393. 3760 ' Tell caller they cannot enter messages
  394. 3770 ' 
  395. 3780 GOSUB 7130
  396. 3790 GOTO 3250
  397. 3800 ' 
  398. 3810 F=0:GOSUB 7130:V=0
  399. 3820 OPEN "R",1,DSK2$+"COUNTERS",5
  400. 3830 FIELD #1,5 AS RR$:GET #1,MNUM:V=VAL(RR$)
  401. 3840 A$="Msg # will be ":N=1:GOSUB 7130
  402. 3850 A$=STR$(V+1):GOSUB 7130:CLOSE
  403. 3860 GOSUB 7130
  404. 3870 A1$="To (RETURN for ALL): ":N=1:GOSUB 7130
  405. 3880 C=1:GOSUB 7260:IF B$="" THEN T$="ALL" ELSE T$=B$
  406. 3890 GOSUB 9290:IF NOT OK THEN 3870
  407. 3900 GOSUB 9400
  408. 3910 A1$="Subject: ":N=1:GOSUB 7130
  409. 3920 C=0:GOSUB 7260:IF B$="" THEN 3910 ELSE K$=B$:
  410. 3930 IF LEN(K$)>26 THEN PRINT "Too long, 25 character limit":GOTO 3910
  411. 3940 PW$="":IF T$="ALL" THEN 3980
  412. 3950 A1$="Private? (Y/N) ":GOSUB 9030
  413. 3960 IF NOT OK THEN 3980
  414. 3970 PW$="*"
  415. 3980 IF XPR THEN 4020
  416. 3990 GOSUB 7130
  417. 4000 A$="Enter up to"+STR$(SIZE)+" lines of text (NO semicolons).":GOSUB 7130
  418. 4010 A$="When done, hit two RETURNs.":GOSUB 7130
  419. 4020 GOSUB 7130:F=0
  420. 4030 IF F=SIZE THEN A$="Message full.":GOSUB 7130:GOTO 4100
  421. 4040 F=F+1
  422. 4050 A1$=SPACE$(3-LEN(STR$(F)))+STR$(F)+"> ":N=1:GOSUB 7130
  423. 4060 GOSUB 7260:IF B$="" THEN F=F-1:IF F=0 THEN 4320 ELSE 4100
  424. 4070 IF F=SIZE-2 THEN PRINT "(2 lines left)"
  425. 4080 IF F=SIZE-1 THEN PRINT "(Last line)"
  426. 4090 A$(F)=B$+" ":GOTO 4030
  427. 4100 GOSUB 7130
  428. 4110 A1$="Select: (A)bort, (C)ontinue, (E)dit, (H)eader, (L)ist, (S)ave: "
  429. 4120 IF XPR THEN A1$="(A,C,E,H,L,S) "
  430. 4130 N=1:GOSUB 7130:C=1:GOSUB 7260
  431. 4140 IF B$="" THEN 4110
  432. 4150 FF=INSTR("HLEACS",B$):IF FF=0 THEN 4110
  433. 4160 ON FF GOTO 4360,4200,4530,4320,4030,4660
  434. 4170 ' 
  435. 4180 ' List message entered
  436. 4190 ' 
  437. 4200 GOSUB 7080:GOSUB 7130
  438. 4210 A$="Date: "+D$:GOSUB 7130
  439. 4220 A$="To:   "+TX$:GOSUB 7130
  440. 4230 A$="Re:   "+K$:GOSUB 7130
  441. 4240 IF PW$="*" THEN A$="    <PRIVATE>":GOSUB 7130
  442. 4250 GOSUB 7140
  443. 4260 FOR L=1 TO F:A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L)
  444. 4270 IF BK THEN 4100 ELSE GOSUB 7130:NEXT L
  445. 4280 GOSUB 7130:GOTO 4100
  446. 4290 ' 
  447. 4300 ' Abort message entry
  448. 4310 ' 
  449. 4320 GOSUB 7130:A$="Aborted":GOSUB 7130:GOSUB 7130:RETURN
  450. 4330 ' 
  451. 4340 ' Edit header
  452. 4350 ' 
  453. 4360 GOSUB 7130:A$="Enter new data or RETURN for no change.":GOSUB 7130
  454. 4370 A1$="To:   "+TX$+": ":N=1:GOSUB 7130:C=1:GOSUB 7260
  455. 4380 IF B$="" THEN 4410
  456. 4390 TSV$=T$:T$=B$:GOSUB 9290:IF NOT OK THEN T$=TSV$:GOTO 4370
  457. 4400 GOSUB 9400
  458. 4410 A1$="Re:   "+K$+": ":N=1:GOSUB 7130:C=0:GOSUB 7260
  459. 4420 IF B$<>"" THEN K$=B$
  460. 4430 IF T$="ALL" THEN PW$="":GOTO 4100
  461. 4440 IF PW$="*" THEN A$="Yes" ELSE A$="No"
  462. 4450 A1$="Private ("+A$+"): ":N=1:GOSUB 7130:C=1:GOSUB 7260
  463. 4460 IF B$=" " AND A$="Y" THEN 4100
  464. 4470 IF B$=" " AND A$="N" THEN 4100
  465. 4480 IF B$="Y" THEN PW$="*":GOTO 4100
  466. 4490 B$=" ":GOTO 4100
  467. 4500 ' 
  468. 4510 ' Edit draft message
  469. 4520 ' 
  470. 4530 IF XPR THEN 4570
  471. 4540 GOSUB 7130
  472. 4550 A$="Enter Line Number to change or RETURN to end.":GOSUB 7130
  473. 4560 A$="Then enter new line or RETURN for no change.":GOSUB 7130
  474. 4570 GOSUB 7130:A1$="Line Number: ":N=1:GOSUB 7130:C=3:GOSUB 7260
  475. 4580 L=VAL(B$):IF L=0 OR L>F THEN GOSUB 7130:GOTO 4100
  476. 4590 A$=" was:":GOSUB 7130
  477. 4600 A$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": "+A$(L):GOSUB 7130
  478. 4610 A1$=SPACE$(3-LEN(STR$(L)))+STR$(L)+": ":N=1:GOSUB 7130:GOSUB 7260
  479. 4620 IF B$="" THEN 4570 ELSE A$(L)=B$+" ":GOTO 4570
  480. 4630 ' 
  481. 4640 ' Save new message
  482. 4650 ' 
  483. 4660 IF PW$<>"" THEN PW$=";"+PW$
  484. 4670 GOSUB 7130:A$="Saving message...":N=1:GOSUB 7130
  485. 4680 OPEN "R",1,DSK2$+"SUMMARY",30
  486. 4690 RE=1:FIELD #1,30 AS RR$:RL=30
  487. 4700 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 7580:PUT #1,RE
  488. 4710 RE=RE+1:S$=D$:GOSUB 7580:PUT #1,RE
  489. 4720 RE=RE+1:S$=N$+" "+O$:GOSUB 7580:PUT #1,RE
  490. 4730 RE=RE+1:S$=T$:GOSUB 7580:PUT #1,RE
  491. 4740 RE=RE+1:S$=K$:GOSUB 7580:PUT #1,RE
  492. 4750 RE=RE+1:S$=STR$(F):GOSUB 7580:PUT #1,RE
  493. 4760 RE=RE+1:S$=" 9999":GOSUB 7580:PUT #1,RE
  494. 4770 CLOSE #1
  495. 4780 VV=0
  496. 4790 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD #1,5 AS RR$:GET #1,MNUM
  497. 4800 LSET RR$=STR$(V+1):PUT #1,MNUM
  498. 4810 GET #1,MSGS:VV=VAL(RR$)
  499. 4820 LSET RR$=STR$(VV+1):PUT #1,MSGS:CLOSE #1
  500. 4830 OPEN "R",1,DSK2$+"MESSAGES",65
  501. 4840 RL=65:FIELD #1,65 AS RR$:RE=MX+1
  502. 4850 S$=STR$(V+1)+PW$:GOSUB 7580:PUT #1,RE
  503. 4860 RE=RE+1:S$=D$:GOSUB 7580:PUT #1,RE
  504. 4870 RE=RE+1:S$=N$+" "+O$:GOSUB 7580:PUT #1,RE
  505. 4880 RE=RE+1:S$=T$:GOSUB 7580:PUT #1,RE
  506. 4890 RE=RE+1:S$=K$:GOSUB 7580:PUT #1,RE
  507. 4900 RE=RE+1:S$=STR$(F):GOSUB 7580:PUT #1,RE
  508. 4910 RE=RE+1
  509. 4920 FOR P=1 TO F:S$=A$(P):GOSUB 7580:PUT #1,RE:RE=RE+1:NEXT P:SS$=" 9999"
  510. 4930 GOSUB 7580:PUT #1,RE:CLOSE #1:MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F
  511. 4940 GOSUB 7130:GOSUB 7130:U=U+1:RETURN
  512. 4950 ' 
  513. 4960 ' Read message
  514. 4970 ' 
  515. 4980 FT=-1:G=0
  516. 4990 GOSUB 7130
  517. 5000 A2$="Read ":GOSUB 5400
  518. 5010 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  519. 5020 IF M<1 THEN GOSUB 7130:RETURN
  520. 5030 IF M>U THEN GOSUB 9090:GOTO 4990
  521. 5040 OPEN "R",1,DSK2$+"MESSAGES",65
  522. 5050 RE=1:FIELD #1,65 AS RR$:MI=0
  523. 5060 MI=MI+1:IF (MI>MZ) OR BK THEN 5350 ELSE G=M(MI,1)
  524. 5070 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 5060
  525. 5080 IF G>M THEN 5300
  526. 5090 GOSUB 8040:IF OK OR NOT PERS THEN 5100 ELSE RE=RE+M(MI,2):GOTO 5060
  527. 5100 RE=RE+1:GET #1,RE:GOSUB 7630:DM$=S$
  528. 5110 RE=RE+1:GET #1,RE:GOSUB 7630:NO$=S$
  529. 5120 RE=RE+1:GET #1,RE:GOSUB 7630:T$=S$
  530. 5130 RE=RE+1:GET #1,RE:GOSUB 7630:GOSUB 8150:K$=S$
  531. 5140 RE=RE+1:GET #1,RE:J=VAL(RR$):GOSUB 7130
  532. 5150 IF FT THEN GOSUB 7080:GOSUB 7130:FT=0
  533. 5160 A$="Msg #:"+STR$(G):GOSUB 7130
  534. 5170 A$="Date: "+DM$:GOSUB 7130
  535. 5180 T01$=NO$:T02$="":TX$=NO$
  536. 5190 I=INSTR(NO$," "):IF I>0 THEN T01$=LEFT$(NO$,I-1):T02$=MID$(NO$,I+1)
  537. 5200 IF T01$<>SYS3$ THEN GOSUB 9410
  538. 5210 A$="From: "+TX$:GOSUB 7130
  539. 5220 T01$=T$:T02$="":TX$=T$
  540. 5230 I=INSTR(T$," "):IF I>0 THEN T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1)
  541. 5240 GOSUB 9400
  542. 5250 A$="To:   "+TX$:GOSUB 7130
  543. 5260 A$="Re:   "+K$:GOSUB 7130:GOSUB 7130
  544. 5270 RE=RE+1:FOR P=1 TO J:GET #1,RE:GOSUB 7630:A$=S$:GOSUB 7130
  545. 5280 IF BK THEN BK=0:GOTO 5300
  546. 5290 RE=RE+1:NEXT P:GOSUB 7130
  547. 5300 IF RIGHT$(B$,1)="+" THEN 5330
  548. 5310 IF G>HM THEN HM=G
  549. 5320 CLOSE:GOTO 4990
  550. 5330 M=M+1:MI=0:RE=1
  551. 5340 IF M<=U AND NOT BK THEN 5060
  552. 5350 IF G>HM THEN HM=G
  553. 5360 CLOSE:A$="End of Messages.":GOSUB 7130:GOSUB 7130:DM$="":NO$="":RETURN
  554. 5370 ' 
  555. 5380 ' Common message number prompt
  556. 5390 ' 
  557. 5400 A1$="Message Number: ("+STR$(IU)+"-"+STR$(U)+")"
  558. 5410 IF NOT XPR THEN A1$=A1$+" to "+A2$+" (RETURN to quit)"
  559. 5420 A1$=A1$+" : ":N=1:GOSUB 7130:GOSUB 7260:GOSUB 7130:RETURN
  560. 5430 ' 
  561. 5440 ' Summarize messages
  562. 5450 ' 
  563. 5460 GOSUB 7130
  564. 5470 A2$="Start at":GOSUB 5400
  565. 5480 IF LEN(B$)=0 THEN M=0:GOSUB 7130:RETURN ELSE M=VAL(B$):GOSUB 7210
  566. 5490 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 5540
  567. 5500 IF LEN(B$)<3 THEN RETURN
  568. 5510 IF MID$(B$,2,1)<>"=" THEN RETURN
  569. 5520 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
  570. 5530 IF ST=0 THEN RETURN
  571. 5540 IF M<1 THEN RETURN
  572. 5550 IF M>U THEN GOSUB 9090:RETURN
  573. 5560 GOSUB 7080:GOSUB 7130
  574. 5570 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
  575. 5580 GET #1,RE
  576. 5590 GOTO 5650
  577. 5600 IF PERS THEN A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+":   <PRIVATE>":GOSUB 7130
  578. 5610 GOTO 5630
  579. 5620 IF (RE+5)/6<M THEN 5630
  580. 5630 RE=RE+6
  581. 5640 GOTO 5580
  582. 5650 IF EOF(1) OR BK THEN 5760 ELSE G=VAL(RR$)
  583. 5660 IF G>9998 THEN 5760
  584. 5670 IF G=0 THEN 5620
  585. 5680 IF G<M THEN 5630
  586. 5690 GOSUB 8040:IF OK OR NOT PERS THEN 5700 ELSE 5600
  587. 5700 GET #1,RE+ST+1
  588. 5710 IF ST=0 THEN 5730
  589. 5720 GOSUB 7630:CY$=S$:GOSUB 9210:IF INSTR(CY$,SV$)=0 THEN 5620
  590. 5730 GOSUB 5820
  591. 5740 IF BK THEN 5760
  592. 5750 IF U=G OR BK THEN 5760 ELSE RE=RE+2:GOTO 5580
  593. 5760 GOSUB 7130
  594. 5770 A$="End of Survey ":GOSUB 7130:GOSUB 7130
  595. 5780 CLOSE:RETURN
  596. 5790 ' 
  597. 5800 ' Display summary of messages
  598. 5810 ' 
  599. 5820 A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+": "                             ' Msg Number
  600. 5830 GET #1,RE+5:GOSUB 7630
  601. 5840 A$=A$+SPACE$(3-LEN(STR$(VAL(S$))))+STR$(VAL(S$))+"  "              ' Lines
  602. 5850 RE=RE+1:GET #1,RE:GOSUB 7630
  603. 5860 A$=A$+S$+"  "                                                      ' Date
  604. 5870 RE=RE+1:GET #1,RE:GOSUB 7630                                       ' From
  605. 5880 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
  606. 5890 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
  607. 5900 IF S$<>SYS3$ THEN CX$=S$:GOSUB 9130:S$=CX$
  608. 5910 A$=A$+S$+SPACE$(8-LEN(S$))+" to => "
  609. 5920 RE=RE+1:GET #1,RE:GOSUB 7630                                       ' To
  610. 5930 I=INSTR(S$," "):IF I>0 THEN S$=MID$(S$,I+1)
  611. 5940 IF S$<>SYS3$ AND S$<>"ALL" THEN CX$=S$:GOSUB 9130:S$=CX$
  612. 5950 IF LEN(S$) > 8 THEN S$=LEFT$(S$,8)
  613. 5960 A$=A$+S$+SPACE$(8-LEN(S$))+" "
  614. 5970 RE=RE+1:GET #1,RE:GOSUB 7630                                       ' Subject
  615. 5980 GOSUB 8150
  616. 5990 A$=A$+S$:GOSUB 7130
  617. 6000 RETURN
  618. 6010 ' 
  619. 6020 ' Goodbye
  620. 6040 GOSUB 7130:BK=0:GOSUB 6220
  621. 6110 A$="   Goodbye...":GOSUB 7130
  622. 6120 ' 
  623. 6130 ' Update the users file if needed
  624. 6140 ' 
  625. 6150 IF N$=SYS3$ GOTO 6400                                              ' no need to update for SYSOP
  626. 6160 ' 
  627. 6170 GOSUB 7130:GOSUB 7130:IF IHM<>HM THEN MFJ$=MF$:GOSUB 8970
  628. 6180 GOTO 6400
  629. 6190 ' 
  630. 6200 ' COMMENTS or feedback for the SYSOP
  631. 6210 ' 
  632. 6220 IF XPR THEN GOSUB 7130
  633. 6230 IF N$=SYS3$ THEN RETURN
  634. 6240 A$="Leave comments for SYSOP? (Y/N or <R>eturn to RBBS) :":N=1:GOSUB 7130
  635. 6245 C=1:GOSUB 7260:IF B$=" " OR LEFT$(B$,1)="R" THEN 2760
  636. 6250 IF LEFT$(B$,1)="N" THEN 6360
  637. 6260 RE=2:RL=65:OPEN "R",1,DSK2$+"COMMENTS",65:FIELD #1,65 AS RR$
  638. 6270 GET #1,1:RE=VAL(RR$)+1:IF RE=1 THEN RE=2
  639. 6280 S$=" ":GOSUB 7580:PUT #1,RE:RE=RE+1
  640. 6290 S$="From: "+CN$+" "+CO$+" "+D$:GOSUB 7580:PUT #1,RE
  641. 6300 GOSUB 7130:A$="Enter text - type two RETURNs to end.":GOSUB 7130
  642. 6310 A1$="> ":N=1:GOSUB 7130:GOSUB 7260
  643. 6320 IF B$<>"" THEN RE=RE+1:S$=B$:RL=65:GOSUB 7580:PUT #1,RE:GOTO 6310
  644. 6330 GOSUB 7130:A1$="Done? (Y/N) ":GOSUB 9030
  645. 6340 IF NOT OK THEN 6310
  646. 6350 S$=STR$(RE):RL=65:GOSUB 7580:PUT #1,1:CLOSE
  647. 6360 GOSUB 7130:RETURN
  648. 6370 A1$="   Goodbye..."
  649. 6380 GOSUB 7130:GOSUB 7130
  650. 6390 ' 
  651. 6400 POKE 0,&HC3
  652. 6410 ' 
  653. 6420 POKE &H5B,0                                                        ' prevent "RBBS P" until next signin.
  654. 6430 ' 
  655. 6440 RUN EXIT$
  656. 6450 ' 
  657. 6460 SYSTEM                                                             ' return back to the operating system.
  658. 6470 ' 
  659. 6480 ' Kill a message
  660. 6490 ' 
  661. 6500 GOSUB 7130
  662. 6510 A2$="Kill":GOSUB 5400
  663. 6520 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  664. 6530 IF M<1 THEN GOSUB 7130:RETURN
  665. 6540 IF M>U THEN GOSUB 9090:GOTO 6500
  666. 6550 A$="Searching...":N=1:GOSUB 7130
  667. 6560 OPEN "R",1,DSK2$+"SUMMARY",30:RE=1:FIELD #1,30 AS RR$:RL=30
  668. 6570 GET #1,RE
  669. 6580 IF EOF(1) THEN 6750 ELSE G=VAL(RR$)
  670. 6590 IF G>9998 THEN 6750
  671. 6600 IF G<M THEN RE=RE+6:GOTO 6570
  672. 6610 IF G>M THEN 6750
  673. 6620 GOSUB 8040:IF OK OR NOT PERS THEN 6630 ELSE 6750
  674. 6630 GET #1,RE:GOSUB 7630:PW=INSTR(S$,";"):PW$=""
  675. 6640 IF N$=SYS3$ OR PERS OR OK THEN PERS=0:GOTO 6660
  676. 6650 IF PW=0 THEN PRINT "   Protected.":CLOSE #1:PRINT:RETURN 
  677. 6660 S$=" 0"+":"+STR$(G):GOSUB 7580:PUT #1,RE:CLOSE
  678. 6670 OPEN "R",1,DSK2$+"MESSAGES",65:RE=1:FIELD #1,65 AS RR$:MI=0
  679. 6680 MI=MI+1:IF MI>MZ THEN 6750 ELSE G=M(MI,1)
  680. 6690 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 6680
  681. 6700 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 7580:PUT #1,RE:M(MI,1)=0
  682. 6710 CLOSE #1
  683. 6720 OPEN "R",1,DSK2$+"COUNTERS",5:FIELD #1,5 AS RR$
  684. 6730 GET #1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT #1,MSGS
  685. 6740 A$="   Message killed.":GOTO 6760
  686. 6750 A$="   Not found."
  687. 6760 CLOSE:GOSUB 7130:GOTO 6500
  688. 6770 ' 
  689. 6780 ' Display USERS file
  690. 6790 ' 
  691. 6800 GOSUB 7080
  692. 6810 OPEN "R",1,DSK3$+"USERS",62:FIELD #1,1 AS MU$,1 AS SU$,60 AS RR$
  693. 6820 FIELD #1,10 AS NN$:GET #1,1:NU=VAL(NN$)
  694. 6830 GOSUB 7130
  695. 6840 FOR J=NU+1 TO 2 STEP -1
  696. 6850 GET #1,J:IF SU$=" " AND B$="UALL" THEN 6910                        ' SYSOP sees all with UALL
  697. 6860 ' 
  698. 6870 IF MU$="*" THEN 7020                                               ' do not show TWITS
  699. 6880 ' 
  700. 6890 IF MU$=" " AND NOT SHOALL THEN 7020                                ' show UNVALIDATED if SHOALL
  701. 6900 ' 
  702. 6910 GOSUB 7630:S0$=S$
  703. 6920 I=INSTR(S0$,";"): S1$=LEFT$(S0$,I-1):S2$=MID$(S0$,I+1)
  704. 6930 I=INSTR(S2$,";"): S3$=MID$(S2$,I+1):S2$=LEFT$(S2$,I-1)
  705. 6940 I=INSTR(S3$,";"): S3$=LEFT$(S3$,I-1)
  706. 6950 ' 
  707. 6960 ' Show location if SHOLOC, but SYSOP always sees location
  708. 6970 ' 
  709. 6980 IF N$<>SYS3$ AND NOT SHOLOC THEN 7010
  710. 6990 A$=S1$+" "+S2$+", "+S3$:GOSUB 7130
  711. 7000 IF N$=SYS3$ OR SHOLOC THEN 7020
  712. 7010 A$=S1$+" "+S2$:GOSUB 7130
  713. 7020 IF BK THEN 7040
  714. 7030 NEXT J
  715. 7040 CLOSE:GOSUB 7130:RETURN
  716. 7050 ' 
  717. 7060 ' Print control character info
  718. 7070 ' 
  719. 7080 GOSUB 7130
  720. 7090 A$="CTRL-S to PAUSE, CTRL-K to ABORT":GOSUB 7130
  721. 7100 ' 
  722. 7110 ' Print string from A$ on console
  723. 7120 ' 
  724. 7130 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
  725. 7140 IF A1$<>"" THEN A$=A1$:A1$=""
  726. 7150 IF N=1 THEN PRINT A$;:PP$=A$:GOTO 7200
  727. 7160 BI=ASC(INKEY$+" ")
  728. 7170 IF BI=&H13 OR BI=&H53 OR BI=&H73 THEN BI=ASC(INPUT$(1)):GOTO 7190
  729. 7180 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN BK=-1:GOTO 7210 
  730. 7190 PRINT A$
  731. 7200 A=A+LEN(A$)
  732. 7210 A$="":N=0
  733. 7220 RETURN
  734. 7230 ' 
  735. 7240 ' Accept string into B$ from console
  736. 7250 ' 
  737. 7260 IF BEL AND SAV$="" THEN PRINT CHR$(7);
  738. 7270 B$="":BK=0
  739. 7280 IF SAV$="" THEN GOSUB 8250:IF C<>3 THEN PRINT
  740. 7290 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 7310
  741. 7300 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
  742. 7310 IF LEN(B$)=0 THEN C=0:RETURN
  743. 7320 IF C=0 THEN 7340
  744. 7330 CY$=B$:GOSUB 9210:B$=CY$
  745. 7340 D=D+LEN(B$):C=0
  746. 7350 RETURN
  747. 7360 ' 
  748. 7370 ' ON-ERROR handler
  749. 7380 ' 
  750. 7390 IF ERL=960 THEN RESUME 1000
  751. 7400 IF ERL=1080 THEN RESUME 1130
  752. 7410 IF ERL=1870 THEN RESUME 1910
  753. 7420 IF ERL=2050 THEN RE=0:RESUME 2060
  754. 7430 IF ERL=2270 THEN RESUME 2310
  755. 7440 IF ERL=2550 THEN RESUME 2700
  756. 7450 IF ERL=3820 THEN RESUME 3840
  757. 7460 IF ERL=4790 THEN RESUME 4800
  758. 7470 IF ERL=4810 THEN RESUME 4820
  759. 7480 IF ERL=5040 THEN RESUME 5360
  760. 7490 IF ERL=5570 THEN RESUME 5760
  761. 7500 IF ERL=6260 THEN RESUME 6290
  762. 7510 IF ERL=7810 THEN RESUME 7860
  763. 7520 IF ERL=8800 THEN RESUME 8910
  764. 7540 RESUME NEXT
  765. 7550 ' 
  766. 7560 ' Fill and store disk record
  767. 7570 ' 
  768. 7580 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  769. 7590 RETURN
  770. 7600 ' 
  771. 7610 ' Unpack disk record
  772. 7620 ' 
  773. 7630 ZZ=LEN(RR$)-2
  774. 7640 WHILE MID$(RR$,ZZ,1)=" "
  775. 7650 ZZ=ZZ-1:IF ZZ=1 THEN 7670
  776. 7660 WEND
  777. 7670 S$=LEFT$(RR$,ZZ)
  778. 7680 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
  779. 7690 RETURN
  780. 7700 ' 
  781. 7710 ' Toggle expert mode
  782. 7720 ' 
  783. 7730 XPR=NOT XPR:RETURN
  784. 7740 ' 
  785. 7750 ' Toggle bell prompt
  786. 7760 ' 
  787. 7770 BEL=NOT BEL:RETURN
  788. 7780 ' 
  789. 7790 ' Subroutine to print a file
  790. 7800 ' 
  791. 7810 OPEN "I",1,DSK$+FIL$:BK=0:IF EOF(1) THEN 7860
  792. 7820 IF NW=0 THEN GOSUB 7080 ELSE NW=0
  793. 7830 GOSUB 7130
  794. 7840 IF EOF(1) OR BK THEN 7860 ELSE LINE INPUT #1,A$:GOSUB 7130:GOTO 7840
  795. 7850 GOSUB 7130
  796. 7860 CLOSE #1:GOSUB 7130:RETURN
  797. 7870 ' 
  798. 7880 ' Print CALLERS file
  799. 7890 ' 
  800. 7900 GOSUB 7080
  801. 7910 GOSUB 7130
  802. 7920 OPEN "R",1,DSK3$+"CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
  803. 7930 CA=CN
  804. 7940 FOR CNT=SIZ+1 TO 2 STEP -1
  805. 7950 GET #1,CNT:GOSUB 7630
  806. 7960 A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 7130:IF BK THEN 7990
  807. 7970 CA=CA-1
  808. 7980 NEXT CNT
  809. 7990 CLOSE:GOSUB 7130
  810. 8000 A$=" End ":GOSUB 7130:GOSUB 7130:RETURN
  811. 8010 ' 
  812. 8020 ' Test for personal messages
  813. 8030 ' 
  814. 8040 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")<>0 THEN PERS=-1
  815. 8050 IF N$=SYS3$ THEN 8080                                              ' This is the SYSOP let him read anything
  816. 8060 GET #1,RE+3:GOSUB 8120:IF OK THEN 8080
  817. 8070 GET #1,RE+2:GOSUB 8120
  818. 8080 RETURN
  819. 8090 ' 
  820. 8100 ' Test FROM or TO field for callers name
  821. 8110 ' 
  822. 8120 GOSUB 7630:I=INSTR(S$," "):S1$=LEFT$(S$,I-1):S2$=MID$(S$,I+1)
  823. 8130 IF S1$=N$ AND S2$=O$ THEN OK=-1 ELSE OK=0
  824. 8140 RETURN
  825. 8150 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
  826. 8160 RETURN
  827. 8170 ' 
  828. 8180 ' Print COMMENTS file for SYSOP
  829. 8190 ' 
  830. 8200 FIL$="COMMENTS":NW=0:DSK$=DSK2$:GOSUB 7810
  831. 8210 DSK$=DSK6$:RETURN
  832. 8220 ' 
  833. 8230 ' Character-at-a-time line input with editing (IF C=2, NO ECHO)
  834. 8240 ' 
  835. 8250 CHC=0: SAV$="":DC=0:IC=&H30
  836. 8260 NCH=ASC(INPUT$(1))
  837. 8270 IF NCH=13 THEN RETURN                                              ' CR
  838. 8280 IF NCH=127 THEN 8360
  839. 8290 IF NCH<32 THEN 8380
  840. 8300 IF CHC>=63 THEN PRINT CHR$(7);:GOTO 8260
  841. 8310 SAV$=SAV$+CHR$(NCH): CHC=CHC+1 :IC=IC+1:IF IC=&H3A THEN IC=&H30
  842. 8320 IF DC THEN PRINT CHR$(10);
  843. 8330 IF C<>2 THEN PRINT CHR$(NCH); ELSE PRINT CHR$(IC);
  844. 8340 IF CHC=55 THEN PRINT CHR$(7);
  845. 8350 DC=0:GOTO 8260
  846. 8360 IF CHC=0 THEN 8260 ELSE PRINT BSL$;:DC=-1
  847. 8370 CHC=CHC-1:IC=IC-1: SAV$=LEFT$(SAV$,CHC): GOTO 8260
  848. 8380 IF CHC=0 THEN 8260
  849. 8390 IF NCH=8 THEN PRINT ERS$;:DC=0:GOTO 8370                           ' BS
  850. 8400 IF NCH=12 THEN GOSUB 8460:GOTO 8470                                ' ^L
  851. 8410 IF NCH=18 THEN PRINT:PRINT PP$;:GOTO 8470                          ' ^Retype
  852. 8420 IF NCH=21 THEN PRINT " #": PRINT PP$;:DC=0:GOTO 8250               ' ^U
  853. 8430 IF NCH<>24 THEN 8260                                               ' ^X
  854. 8440 GOSUB 8460
  855. 8450 GOTO 8250
  856. 8460 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: RETURN
  857. 8470 IF C<>2 THEN PRINT SAV$;: GOTO 8520
  858. 8480 ' 
  859. 8490 ' Print numbers to hide password
  860. 8500 ' 
  861. 8510 IC=&H30:FOR BCC=1 TO CHC: IC=IC+1: PRINT CHR$(IC);: NEXT BCC
  862. 8520 DC=0:GOTO 8260
  863. 8530 ' 
  864. 8540 ' New user password prompt
  865. 8550 ' 
  866. 8560 GOSUB 7130
  867. 8570 A$="Enter at least six alphanumeric characters":GOSUB 7130
  868. 8580 A1$="for your PASSWORD:  "
  869. 8590 N=1:GOSUB 7130:C=2:GOSUB 7260:S04$=B$:IF S04$="" THEN 8560
  870. 8595 IF INSTR(S04$," ")>0 THEN A1$=NSP$:N=1:GOSUB 7130:GOTO 8560
  871. 8600 IF LEN(S04$)<6 THEN 8560
  872. 8610 A1$="Enter it again:     "
  873. 8620 N=1:GOSUB 7130:C=2:GOSUB 7260
  874. 8630 IF S04$<>B$ THEN A1$="No match, try again.":GOSUB 7130:GOTO 8560
  875. 8640 GOSUB 7130:A$="Please remember it.":GOSUB 7130:GOSUB 7130:RETURN
  876. 8650 ' 
  877. 8660 ' User password change routine
  878. 8670 ' 
  879. 8680 GOSUB 7130
  880. 8690 IF N$<>SYS3$ THEN 8950
  881. 8700 GOSUB 7130
  882. 8710 A1$="FIRST Name: ":N=1:GOSUB 7130
  883. 8720 C=1:GOSUB 7260:T01$=B$:IF T01$="" THEN GOSUB 7130:GOSUB 7130:RETURN
  884. 8730 A1$="LAST Name:  ":N=1:GOSUB 7130
  885. 8740 C=1:GOSUB 7260:T02$=B$:IF T02$="" THEN RETURN
  886. 8750 OK=0:GOSUB 8800:IF OK THEN GOSUB 9680:GOTO 8700
  887. 8760 GOSUB 7130:A$="Not found.":GOSUB 7130:GOTO 8700
  888. 8770 ' 
  889. 8780 ' Check USERS file
  890. 8790 ' 
  891. 8800 OPEN "R",1,DSK3$+"USERS",62:FIELD #1,62 AS RR$:GET #1,1:NU=VAL(RR$)
  892. 8810 FOR J=2 TO NU+1:GET #1,J:GOSUB 7630:S00$=MID$(S$,3)
  893. 8820 I=INSTR(S00$,";"): S01$=LEFT$(S00$,I-1):S02$=MID$(S00$,I+1)
  894. 8830 I=INSTR(S02$,";"): S03$=MID$(S02$,I+1):S02$=LEFT$(S02$,I-1)
  895. 8840 I=INSTR(S03$,";"): S04$=MID$(S03$,I+1):S03$=LEFT$(S03$,I-1)
  896. 8850 I=INSTR(S04$,";"): IF I=0 THEN S05$="0":GOTO 8870
  897. 8860 S05$=MID$(S04$,I+1):S04$=LEFT$(S04$,I-1)
  898. 8870 HM=VAL(S05$)
  899. 8880 IF T01$<>S01$ OR T02$<>S02$ THEN 8900
  900. 8890 MFJ$=LEFT$(S$,1):GOSUB 7130:UJ=J:OK=-1:CLOSE:RETURN
  901. 8900 NEXT J
  902. 8910 CLOSE:RETURN
  903. 8920 ' 
  904. 8930 ' Update USERS file
  905. 8940 ' 
  906. 8950 MFJ$=MF$
  907. 8960 GOSUB 8560
  908. 8970 OPEN "R",1,DSK3$+"USERS",62:FIELD #1,62 AS RR$
  909. 8980 S$=MFJ$+" "+S01$+";"+S02$+";"+S03$+";"+S04$+";"+STR$(HM)
  910. 8990 RL=62:GOSUB 7580:PUT #1,UJ:CLOSE:RETURN
  911. 9000 ' 
  912. 9010 ' Prompt for YES or NO answer
  913. 9020 ' 
  914. 9030 A2$=A1$:OK=0
  915. 9040 A1$=A2$:N=1:GOSUB 7130:C=1:GOSUB 7260:ANS$=LEFT$(B$,1)
  916. 9050 IF ANS$="" THEN 9040 ELSE IF ANS$="Y" THEN OK=-1:RETURN
  917. 9060 IF ANS$="N" THEN RETURN
  918. 9070 A$="<Y or N>":GOSUB 7130:GOTO 9030
  919. 9080 ' 
  920. 9090 A$="Invalid message number.":GOSUB 7130:SAV$="":RETURN
  921. 9100 ' 
  922. 9110 ' Capitalize string CX$ (FRANK -> Frank)
  923. 9120 ' 
  924. 9130 FOR ZZ=2 TO LEN(CX$)
  925. 9140 ZA=ASC(MID$(CX$,ZZ,1)):IF ZA<&H41 OR ZA>&H5A THEN 9160
  926. 9150 MID$(CX$,ZZ,1)=CHR$(ZA+&H20)
  927. 9160 NEXT ZZ
  928. 9170 RETURN
  929. 9180 ' 
  930. 9190 ' Uppercase string CY$ (frank -> FRANK)
  931. 9200 ' 
  932. 9210 FOR ZZ=1 TO LEN(CY$)
  933. 9220 ZA=ASC(MID$(CY$,ZZ,1)):IF ZA<&H61 OR ZA>&H7A THEN 9240
  934. 9230 MID$(CY$,ZZ,1)=CHR$(ZA-&H20)
  935. 9240 NEXT ZZ
  936. 9250 RETURN
  937. 9260 ' 
  938. 9270 ' Check for existing user TO
  939. 9280 ' 
  940. 9290 T01$=T$:T02$=""
  941. 9300 IF T$=SYS3$ OR T$="ALL" THEN OK=-1:RETURN
  942. 9310 U01$=S01$:U02$=S02$:U03$=S03$:U04$=S04$:SHM=HM:SUJ=UJ:SMF$=MF$
  943. 9320 I=INSTR(T$," "): IF I=0 THEN OK=0:GOTO 9350
  944. 9330 T01$=LEFT$(T$,I-1):T02$=MID$(T$,I+1):OK=0:GOSUB 8800
  945. 9340 S01$=U01$:S02$=U02$:S03$=U03$:S04$=U04$:HM=SHM:UJ=SUJ:MF$=SMF$
  946. 9350 IF NOT OK THEN:GOSUB 7130:A1$="Not a known user.":GOSUB 7130:GOSUB 7130:GOTO 2760
  947. 9360 RETURN
  948. 9370 ' 
  949. 9380 ' Capitalize TO for message entry display
  950. 9390 ' 
  951. 9400 IF T$=SYS3$ OR T$="ALL" THEN TX$=T$:RETURN
  952. 9410 CX$=T01$:GOSUB 9130:T01$=CX$:CX$=T02$:GOSUB 9130:T02$=CX$
  953. 9420 TX$=T01$+" "+T02$
  954. 9430 RETURN
  955. 9440 ' 
  956. 9450 CX$=N$:GOSUB 9130:CN$=CX$:CX$=O$:GOSUB 9130:CO$=CX$:RETURN
  957. 9460 ' 
  958. 9470 ' Chat mode
  959. 9480 ' 
  960. 9490 A$=" ":GOSUB 7130:GOSUB 7130
  961. 9500 A$="> "+CN$+" "+CO$+", you have entered the CHAT mode":GOSUB 7130
  962. 9510 A1$="Page the SYSOP? (Y/N) ":GOSUB 9030
  963. 9520 IF NOT OK THEN RETURN
  964. 9530 FOR T1=1 TO 5
  965. 9540 PRINT CHR$(7);
  966. 9550 FOR T2=1 TO BEEP:NEXT T2
  967. 9560 NEXT T1
  968. 9570 GOSUB 7130:GOSUB 7130
  969. 9580 A$="Type /EX to Exit CHAT":GOSUB 7130
  970. 9590 A$="":GOSUB 7130
  971. 9600 BELS=BEL:BEL=0                                                     ' no bell during chat, but save origional value
  972. 9610 A1$=">":N=1:GOSUB 7130:GOSUB 7260
  973. 9620 IF B$="/EX" OR B$="/ex" THEN BEL=BELS:RETURN
  974. 9630 GOTO 9610
  975. 9640 GOTO 2760                                                          ' go back to beginning just in case
  976. 9650 ' 
  977. 9660 ' Program area to validate users by SYSOP
  978. 9670 ' 
  979. 9680 IF N$<>SYS3$ THEN 2760                                             ' DOUBLE CHECK IF SYSOP
  980. 9690 A$=S01$+" "+S02$+","+" password -> "+S04$+" -->> ":N=1:GOSUB 7130
  981. 9700 IF MFJ$=" " THEN A$="Unvalidated User":GOTO 9750
  982. 9710 IF MFJ$="!" THEN A$="Validated User":GOTO 9750
  983. 9720 IF MFJ$="#" THEN A$="SUPER User":GOTO 9750
  984. 9730 IF MFJ$="*" THEN A$="TWIT Status":GOTO 9750
  985. 9740 PRINT "User log error.":RETURN
  986. 9750 N=1:GOSUB 7130
  987. 9760 A$=" ":GOSUB 7130
  988. 9810 IF VAP$="NOPASS" GOTO 9850
  989. 9820 GOSUB 7130:A1$="Enter your validation Password -> ":N=1:GOSUB 7130
  990. 9830 C=2:GOSUB 7260:IF B$=VAP$ THEN 9850
  991. 9840 GOTO 8700                                                          ' go back and try again
  992. 9850 GOSUB 7130:A1$="<P>assword, <T>wit, <V>alidate, <U>nvalidate or <S>uper user -> ":N=1:GOSUB 7130
  993. 9860 C=1:GOSUB 7260
  994. 9865 IF B$="P" THEN 8960
  995. 9870 IF B$="T" THEN MFJ$="*":GOTO 9920                                  ' tag this guy as a TWIT
  996. 9880 IF B$="V" THEN MFJ$="!":GOTO 9920                                  ' tag as a VALID user
  997. 9890 IF B$="S" THEN MFJ$="#":GOTO 9920                                  ' tag him as a SUPER user
  998. 9900 IF B$="U" THEN MFJ$=" ":GOTO 9920                                  ' UNVALIDATE user
  999. 9910 GOSUB 7130:RETURN
  1000. 9920 GOSUB 7130:GOTO 8970                                               ' add it to the USERS file
  1001. 9930 ' 
  1002. 9940 ' Display NEWS files
  1003. 9950 ' 
  1004. 9960 FIL$="NEWS":NW=0:DSK$=DSK5$:GOSUB 7810                             ' Bring up NEWS menu
  1005. 9970 ' 
  1006. 9980 IF NNUM=0 THEN DSK$=DSK6$:RETURN                                   ' If no news files then return
  1007. 9990 ' 
  1008. 10000 A1$="News file number 1 -"
  1009. 10010 A1$=A1$+STR$(NNUM)+",  "+STR$(NNUM+1)+" to Exit  --> "
  1010. 10020 N=1:GOSUB 7130:C=1:GOSUB 7260
  1011. 10030 IF B$="" THEN 10000
  1012. 10040 FQ=VAL(B$):IF FQ<1 OR FQ>NNUM THEN DSK$=DSK6$:RETURN
  1013. 10050 FIL$="NEWS"+MID$(STR$(FQ),2):NW=0:DSK$=DSK5$:GOSUB 7810:GOTO 9960
  1014. 10060 ' 
  1015. 10070 ' Display TWIT file
  1016. 10080 ' 
  1017. 10090 FIL$="TWIT":NW=1:GOSUB 7810
  1018. 10100 GOTO 6400                'Dump the TWIT
  1019. 10110 ' 
  1020. 10120 ' Display XMODEM.LOG file
  1021. 10130 ' 
  1022. 10140 FIL$="XMODEM.LOG":NW=0:GOSUB 7810: RETURN
  1023. 10150 ' 
  1024. 10160 ' Display HELP files
  1025. 10170 ' 
  1026. 10180 FIL$="HELP":NW=0:DSK$=DSK4$:GOSUB 7810                            ' bring up HELP menu
  1027. 10190 ' 
  1028. 10200 IF HNUM=0 THEN DSK$=DSK6$:RETURN                                  ' if no HELP files then return
  1029. 10210 ' 
  1030. 10220 A1$="HELP File number 1 -"
  1031. 10230 A1$=A1$+STR$(HNUM)+",  "+STR$(HNUM+1)+"  to exit -->"
  1032. 10240 N=1:GOSUB 7130:C=1:GOSUB 7260
  1033. 10250 IF B$="" THEN 10220
  1034. 10260 FQ=VAL(B$):IF FQ<1 OR FQ>HNUM THEN DSK$=DSK6$:RETURN
  1035. 10270 FIL$="HELP"+MID$(STR$(FQ),2):NW=0:DSK$=DSK4$:GOSUB 7810:GOTO 10180
  1036. 10280 ' 
  1037. 10290 ' Sub-routine for multi-SYSOP
  1038. 10300 ' 
  1039. 10310 IF NOT MSYS THEN O$="":GOTO 10360                                 ' only one SYSOP
  1040. 10320 ' 
  1041. 10330 GOSUB 7130:A1$="Which SYSOP are you -> ":N=1:GOSUB 7130
  1042. 10340 C=1:GOSUB 7260:IF B$="" THEN 10330
  1043. 10350 O$=B$
  1044. 10360 CN$=N$:CO$=O$:GOSUB 7730:GOSUB 7770:INC=0:RETURN
  1045. 10370 ' THE END 
  1046.