home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol060 / rbbs25.asc < prev    next >
Text File  |  1984-04-29  |  23KB  |  537 lines
  1. 10 REM RBBS VERSION 2.5
  2. 20 REM *****RBBS - "Remote Bulletin Board System"*****
  3. 21 REM by Bruce R. Ratoff
  4. 22 REM adapted from Xitan Basic SJBBS by Howard Moulton
  5. 29 REM 
  6. 30 REM 08/18/81
  7. 31 REM Changed time/date logic to look at in-memory time
  8. 32 REM and date maintained by my interrupt-driven time/date
  9. 33 REM routines.  Commented out Bill E.'s code.  (Bruce Ratoff)
  10. 39 REM
  11. 40 REM more changes by Bill Earnest, 3/24/81
  12. 41 REM   NOTE CHGS AT 510-520,580,590,720,                
  13. 42 REM   3650-3670,4600-4730,6000-. MY BYE INCLUDES THE @ ON
  14. 43 REM   FIRST ENTRY SO USER NEEDNT REMEMBER "P". SYS. CLOCK
  15. 44 REM   IS CALLED AROUND 4600 & LEAVES DATA IN 0F400H++. CALL
  16. 45 REM   @ 580 AREA FORCES USER 0 FOR THOSE CARELESS FOLKS
  17. 46 REM   THAT SAY RIBBS FROM ANYWHERE. LINE INPUT PROCESSING @
  18. 47 REM   6000++ INCLUDES THE NEAR-LINE-END BELL. I USED SOME
  19. 48 REM   PIECES FROM RBBS24 ALSO. THE LINE INPUT ISNT TOO VERY
  20. 49 REM   SLOW EVEN UNDER MBASIC, BUT COMPILED IS BETTER.        
  21. 50 REM      Note that the program contains 2 calls to external
  22. 51 REM      routines which are special to Bill Earnest's
  23. 52 REM      system, at
  24. 53 REM        580-590 and
  25. 54 REM        4610-4730 (to call in a clock)
  26. 55 REM        These calls will cause the program to crash unless
  27. 56 REM      you implement similar routines and thus have been
  28. 57 REM      disabled with REM statements.  Remove the REMs if
  29. 58 REM      if you have a use for them.  Note too that several
  30. 59 REM        of the RBBS2.4 routines are omitted in this version;
  31. 60 REM      you may want to replace them.  And note that Bill
  32. 61 REM      has figured how to use the clock to put times into
  33. 62 REM      the CALLERS file!   --Ben Bronson
  34. 65 REM changes of 12/10/80 by Bruce Ratoff
  35. 66 REM    FIXED BUG THAT PREVENTED "NEWCOM" FROM PRINTING
  36. 70 REM    MADE "LASTCALR" A $SYS FILE
  37. 80 REM    IMPROVED CONTROL-K RESPONSE (STILL NOT PERFECT BUT BETTER)
  38. 90 REM changes of 11/14/80 by Ron Fowler
  39. 100 REM    ADDED PERSONAL MESSAGE FUNCTION
  40. 110 REM    K FUNCTION STORES NAME OF ERASING USER IN MSG# RECORD
  41. 120 REM changes of 11/9/80  by Ron Fowler
  42. 130 REM  1: PRINT CALLERS FOR SYSOP
  43. 140 REM  2: SAVE KILLED MSG #S, PUT PWD'S IN MSG FILE
  44. 150 REM  3: RE-ENTRY OPTION, FILE "LASTCALR"
  45. 160 REM 10/21/80 --> Fix several minor bugs in P and S cmds.  (BRR)
  46. 170 REM Changes 10/15/80 by Ron Fowler:
  47. 180 REM    1) added "Q", quick summary command
  48. 190 REM    2) added "X", "P" cmds - expert user mode, and bell toggle
  49. 200 REM    3) rearranged message entry for CBBS compatibility
  50. 210 REM    4) added ";" delimitation - "command anticipation"
  51. 220 REM    5) added password file access at 3 levels:
  52. 230 REM       a. p1$ is high-level quick-access to cp/m
  53. 240 REM       b. p2$ is sysop 'last name' (sysop has special priveliges)
  54. 250 REM       c. p3$ is the normal cpm access password:
  55. 260 REM          (IF P3$ IS "NOPASS", THEN CPM ACCESS IS UNRESTRICTED)
  56. 270 REM    6) coded several sequences as subroutines, to shorten code
  57. 280 REM    7) made several cosmetic changes
  58. 290 REM note: the file "PWDS" can be created by a text editor.  The
  59. 300 REM       passwords are sequential..e.g.,"GOTOCPM,FOWLER,NOPASS"
  60. 310 REM *** put the shortest version of your first name in line 920
  61. 320 REM
  62. 330 REM
  63. 500 DEFINT A-Z
  64. 510 REM [disabled] FOR I=8 TO 15: READ J: POKE I,J: NEXT I
  65. 520 REM [disabled] DATA 14,0,17,0,0,&HC3,5,0
  66. 530 VERS$="vers 2.5"' VERSION NUMBER
  67. 540 DIM A$(17),M(400,2)
  68. 550 POKE 0,&HCD
  69. 560 INC=1: ERS$=CHR$(8)+" "+CHR$(8)
  70. 570 ON ERROR GOTO 4810
  71. 580 RFLG=PEEK(&H5D):POKE &H5D,32
  72. 590 REM [disabled:] POKE 9,32: POKE 11,0: CALL BDCAL
  73. 600 REM
  74. 610 REM SIGNON FUNCTIONS
  75. 620 REM
  76. 630 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
  77. 640 P2$="xxxxxx":P3$="NOPASS" 'DEFAULT PWDS
  78. 650 BK=0:GOSUB 4200:N=1:A$="Cranford, NJ RIBBS...":GOSUB 4200:N=0
  79. 660 OPEN "I",1,"A:PWDS":IF EOF(1) THEN 680
  80. 670 INPUT #1,P1$,P2$,P3$
  81. 680 CLOSE #1
  82. 690 BEL=-1:XPR=0'INITIAL BEL ON, NOT EXPERT
  83. 700 A$=VERS$:GOSUB 4200:GOSUB 4200
  84. 710 SAV$=""
  85. 720 IF RFLG<>ASC("P") THEN 770
  86. 730 INC=0
  87. 740 OPEN "I",1,"A:LASTCALR":IF EOF(1) THEN 790
  88. 750 INPUT #1,N$,O$,TON:CLOSE
  89. 760 A$="Welcome back, "+N$+" "+O$+".":GOSUB 4200:GOSUB 4200:GOTO 990
  90. 770 GOSUB 1840:GOSUB 1740'REM PRINT INFO, THEN BULLETINS
  91. 780 BK=0:A$="(Prompting bell means system is ready for input).":GOSUB 4200:GOSUB 4200
  92. 790 A$="What is your FIRST name ?":GOSUB 4200:C=1:GOSUB 4400:C=0:N$=B$:
  93.     IF N$="" THEN 790
  94. 800 IF N$=P1$ THEN 1620 ' DIRECT CPM EXIT
  95. 805 IF LEFT$(N$,1)=" " OR RIGHT$(N$,1)=" " THEN 790
  96. 810 IF N$<"A" OR LEN(N$)=1 THEN 790
  97. 820 A1$="What is your LAST name ?":GOSUB 4200:C=1:GOSUB 4400:C=0:O$=B$:
  98.     IF O$="" THEN 790
  99. 830 IF O$<"A" OR LEN(O$)=1 THEN 790
  100. 835 IF LEFT$(O$,1)=" " OR RIGHT$(O$,1)=" " THEN 790
  101. 840 IF N$="SYSOP" AND O$=P2$ THEN O$="":GOTO 940
  102. 850 IF N$="SYSOP" THEN 790
  103. 860 A$="Checking user file...":GOSUB 4200:V=0:OPEN "R",1,"A:USERS",62:
  104.     FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
  105. 870 FOR I=2 TO NU+1:GET#1,I:
  106.     IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN MF$=LEFT$(RR$,1):CLOSE:
  107.        GOSUB 4200:GOTO 940
  108. 880 NEXT I
  109. 890 V=1:A1$="Where (City,State) are you calling from ?":GOSUB 4200:
  110.     C=1:GOSUB 4400:C=0:ST$=B$:IF ST$="" THEN 820
  111. 900 A$="Hello "+N$+" "+O$+" from "+ST$:GOSUB 4200:
  112.     A1$="Did I misspell anything ?":GOSUB 4200:C=1:GOSUB 4400:C=0:
  113.     IF LEFT$(B$,1)="Y" THEN 790
  114. 910 A1$="This checking is only done the first time you call.":GOSUB 4200
  115. 920 S$="  "+N$+" "+O$+" "+ST$:RL=62:GOSUB 5000:NU=NU+1:PUT#1,NU+1:
  116.     S$=STR$(NU):GOSUB 5000:PUT#1,1:CLOSE
  117. 930 FIL$="NEWCOM":GOSUB 5400:MF$=" "
  118. 940 A$="Logging "+N$+" "+O$+" to disk...":N=1:GOSUB 4200:
  119.     OPEN "R",1,"A:CALLERS",60:FIELD#1,60 AS RR$:GET#1,1
  120. 950 RE=VAL(RR$)+1:S$=STR$(RE):RL=60:GOSUB 5000:PUT#1,1:RE=RE+1
  121. 960 GOSUB 4610
  122. 970 S$=N$+" "+O$+" "+ST$+" "+D$+" "+DT$:GOSUB 5000:PUT#1,RE:CLOSE#1
  123. 980 OPEN "O",1,"A:LASTCALR. "+CHR$(&HA0):PRINT #1,N$;",";O$;",";TON:CLOSE
  124. 990 BK=0:GOSUB 4200:A$="Active # of msg's ":N=1:GOSUB 4200:
  125.     OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MSGS:M=VAL(RR$)
  126. 1000 A$=STR$(M)+".":GOSUB 4200
  127. 1010 A$="You are caller # ":N=1:GOSUB 4200:GET#1,CALLS
  128. 1020 CN=VAL(RR$)+INC:A$=STR$(CN):LSET RR$=A$:GOSUB 4200:PUT#1,CALLS
  129. 1030 A$="Next msg # will be ":N=1:GOSUB 4200:GET#1,MNUM:U=VAL(RR$)
  130. 1040 A$=STR$(U+1):GOSUB 4200:CLOSE:GOSUB 4200
  131. 1100 REM
  132. 1110 REM LOOK FOR MSGS FOR THIS CALLER
  133. 1120 REM AND BUILD MESSAGE INDEX
  134. 1130 REM
  135. 1140 FT=1:MX=0:MZ=0:IU=0:'FLAG FIRST TIME FOR PRINTING HEADING
  136. 1150 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,28 AS RR$
  137. 1160 BK=0:GET#1,RE:IF EOF(1) THEN 1260
  138. 1170 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 1250
  139. 1180 IF IU=0 THEN IU=G
  140. 1190 IF G>9998 THEN MZ=MZ-1:GOTO 1260
  141. 1200 GET#1,RE+3:GOSUB 5100:IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 1230
  142. 1210 IF N$<>"SYSOP" THEN 1250
  143. 1220 IF INSTR(S$,"BRUCE")=0 THEN 1250
  144. 1230 IF FT THEN A$="Please retrieve and kill the following message(s) left for you:":GOSUB 4200:FT=0
  145. 1240 A$=STR$(G):N=1:GOSUB 4200
  146. 1250 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 1160
  147. 1260 CLOSE:GOSUB 4200:GOSUB 4200
  148. 1300 REM
  149. 1310 REM *** MAIN COMMAND ACCEPTOR/DISPATCHER ***
  150. 1320 REM
  151. 1330 A1$="Function":IF NOT XPR THEN A1$=A1$+" (B,E,R,S,K,G,W,C,U,P,X,Q (or '?' if not known)"
  152. 1340 A1$=A1$+"?":GOSUB 4200:C=1:GOSUB 4400:C=0
  153. 1350 IF B$="" THEN 1300
  154. 1360 FF=INSTR("BER?SKGWCUPXQL",B$):GOSUB 1370:GOTO 1300
  155. 1370 IF FF=0 THEN 1390
  156. 1380 ON FF GOTO 1700,2100,2800,1900,5500,3700,3500,1800,1500,4000,
  157.      5300,5200,5600,5700
  158. 1390 IF N$+O$="SYSOP" THEN IF B$="%" THEN GOSUB 5700:GOTO 1300
  159. 1400 A$="I don't understand '"+B$+"', "+N$+".":GOSUB 4200:GOSUB 4200:
  160.      SAV$="":RETURN
  161. 1500 REM
  162. 1510 REM ***EXIT TO CP/M***
  163. 1520 REM
  164. 1530 IF MF$="*" THEN A$="You've lost that privelege, "+N$:GOSUB 4200:
  165.      SAV$="":RETURN
  166. 1540 IF P3$="NOPASS" THEN 1570
  167. 1550 A1$="Password ?":GOSUB 4200:C=1:GOSUB 4400:C=0
  168. 1560 IF B$<>P3$ THEN A$="+++INVALID+++":GOSUB 4200:GOSUB 4200:RETURN
  169. 1570 IF XPR THEN 1620
  170. 1580 A$="Please remember to type BYE before hanging up the phone.":GOSUB 4200:GOSUB 4200
  171. 1590 A$="To re-enter RIBBS, type:":GOSUB 4200:A$="A>USER 3":GOSUB 4200:
  172.    A$="A>RIBBS P":GOSUB 4200:GOSUB 4200
  173. 1600 A$="For info on software exchange, type:":GOSUB 4200:
  174.      A$="A>TYPE THIS-SYS.DOC":GOSUB 4200:GOSUB 4200
  175. 1610 A$="For general info, type:":GOSUB 4200:
  176.      A$="A>HELP":GOSUB 4200:GOSUB 4200
  177. 1620 GOSUB 4200:POKE 4,0:A$="Entering CP/M...":GOSUB 4200:POKE 0,&HC3:SYSTEM
  178. 1700 REM
  179. 1710 REM ***DISPLAY BULLETINS***
  180. 1720 REM
  181. 1730 GOSUB 4130
  182. 1740 FIL$="A:BULLETIN":GOSUB 5400:RETURN
  183. 1800 REM
  184. 1810 REM ***DISPLAY WELCOME MESSAGE***
  185. 1820 REM
  186. 1830 GOSUB 4130
  187. 1840 FIL$="A:INFO":GOSUB 5400:RETURN
  188. 1900 REM
  189. 1910 REM *** DISPLAY MENU OF FUNCTIONS ***
  190. 1920 REM
  191. 1930 GOSUB 4200:A$="Functions supported:":GOSUB 4200:IF BK THEN RETURN
  192. 1940 A$="S--> Scan messages     R--> Retrieve message":GOSUB 4200:
  193.      IF BK THEN RETURN
  194. 1950 A$="E--> Enter message     K--> Kill message":GOSUB 4200:IF BK THEN RETURN
  195. 1960 A$="B--> retype Bulletins  W--> retype welcome":GOSUB 4200:IF BK THEN RETURN
  196. 1970 A$="C--> exit to CP/M      U--> list User file":GOSUB 4200:IF BK THEN RETURN
  197. 1980 A$="P--> Prompt (bel) togl X--> eXpert user mode":GOSUB 4200:IF BK THEN RETURN
  198. 1990 A$="Q--> Quick summary     G--> Goodbye (signoff)":GOSUB 4200:IF BK THEN RETURN
  199. 2000 GOSUB 4200:A$="Commands may be strung together, separated by semicolons.":
  200.      GOSUB 4200:A$="For example, 'R;123' retrieves message # 123.":GOSUB 4200:
  201.      IF BK THEN RETURN
  202. 2010 GOSUB 4200:A$="Software exchange is done under CP/M using":GOSUB 4200:
  203.      A$="the XMODEM program (for intelligent transfer)":GOSUB 4200:
  204.      A$="or the TYPE command (simple ASCII listing).":GOSUB 4200
  205. 2020 IF BK THEN RETURN
  206. 2030 GOSUB 4200:RETURN
  207. 2100 REM
  208. 2110 REM ***ENTER A NEW MESSAGE***
  209. 2120 REM
  210. 2130 F=0:GOSUB 4200:OPEN "R",1,"A:COUNTERS",5:A$="Msg # will be ":N=1:
  211.      GOSUB 4200:FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
  212. 2140 A$=STR$(V+1):GOSUB 4200:CLOSE
  213. 2150 GOSUB 4610
  214. 2160 GOSUB 4200: A1$="Today's date is "+D$: GOSUB 4200
  215. 2170 A1$="Who to (C/R for ALL)?":GOSUB 4200:C=1:GOSUB 4400:C=0:IF B$="" THEN T$="ALL" ELSE T$=B$
  216. 2180 A1$="Subject?(26 char in summary)":GOSUB 4200:C=1:GOSUB 4400:C=0:K$=B$
  217. 2190 IF LEN(K$)>30 THEN GOTO 2180
  218. 2200 A1$="Password?":GOSUB 4200:C=1:GOSUB 4400:C=0:PW$=B$
  219. 2210 A1$="To enter msg,type in lines. (Bell @ end-8)":GOSUB 4200
  220. 2220 A1$="To edit,hit only C/R.       (16 lines max)":GOSUB 4200
  221. 2230 A1$="No semicolons,please.":GOSUB 4200:GOSUB 4200:F=0
  222. 2240 IF F=16 THEN A$="Msg full.":GOSUB 4200:GOTO 2300
  223. 2250 F=F+1:A1$=STR$(F)+" ":N=1:GOSUB 4200:GOSUB 4400:IF B$="" THEN F=F-1:GOTO 2300
  224. 2260 IF F=12 THEN PRINT "(4 lines left)"
  225. 2270 IF F=14 THEN PRINT "(2 lines left)"
  226. 2280 IF F=15 THEN PRINT "(last line)"
  227. 2290 A$(F)=B$+" ":GOTO 2240
  228. 2300 GOSUB 4200:A1$="(L)ist, (E)dit, (Q)uit, (C)ontinue, (S)ave; Select?":
  229.      IF XPR THEN A1$="L,E,Q,C,S?"
  230. 2310 GOSUB 4200:C=1:GOSUB 4400:C=0
  231. 2320 IF B$<>"L" THEN 2360 ELSE GOSUB 4130
  232. 2330 GOSUB 4200:FOR L=1 TO F:A$=STR$(L)+" "+A$(L)
  233. 2340 IF BK THEN 2300 ELSE GOSUB 4200:NEXT L
  234. 2350 GOSUB 4200:GOTO 2300
  235. 2360 IF B$="Q" THEN A$="Aborted":GOSUB 4200:RETURN
  236. 2370 IF B$="C" THEN 2240
  237. 2380 IF B$="E" THEN 2410
  238. 2390 IF B$="S" THEN 2460
  239. 2400 GOTO 2300
  240. 2410 GOSUB 4200:A1$="Line #?":GOSUB 4200:GOSUB 4400:L=VAL(B$):PP$=""
  241. 2420 IF L=0 OR L>F THEN 2300 ELSE A$="Was:":GOSUB 4200:A$=A$(L):GOSUB 4200
  242. 2430 A1$="Enter new line":IF NOT XPR THEN A1$=A1$+" (C/R for no change)"
  243. 2440 A1$=A1$+":":GOSUB 4200:GOSUB 4400
  244. 2450 IF B$="" THEN 2300 ELSE A$(L)=B$+" ":GOTO 2300
  245. 2460 REM
  246. 2470 IF PW$<>"" THEN PW$=";"+PW$
  247. 2480 A$="Updating summary file, ":N=1:GOSUB 4200
  248. 2490 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  249. 2500 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 5000:PUT#1,RE
  250. 2510 RE=RE+1:S$=D$:GOSUB 5000:PUT#1,RE
  251. 2520 RE=RE+1:S$=N$+" "+O$:GOSUB 5000:PUT#1,RE
  252. 2530 RE=RE+1:S$=T$:GOSUB 5000:PUT#1,RE
  253. 2540 RE=RE+1:S$=K$:GOSUB 5000:PUT#1,RE
  254. 2550 RE=RE+1:S$=STR$(F):GOSUB 5000:PUT#1,RE
  255. 2560 RE=RE+1:S$=" 9999":GOSUB 5000:PUT#1,RE
  256. 2570 CLOSE#1
  257. 2580 A$="next msg #, ":N=1:GOSUB 4200:
  258.      OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$
  259. 2590 GET#1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MNUM
  260. 2600 A$="active msg's, ":N=1:GOSUB 4200
  261. 2610 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MSGS:CLOSE#1
  262. 2620 A$="and msg file.":N=1:GOSUB 4200:OPEN "R",1,"A:MESSAGES",65:RL=65
  263. 2630 FIELD#1,65 AS RR$
  264. 2640 RE=MX+1
  265. 2650 S$=STR$(V+1)+PW$:GOSUB 5000:PUT#1,RE
  266. 2660 RE=RE+1:S$=D$:GOSUB 5000:PUT#1,RE
  267. 2670 RE=RE+1:S$=N$+" "+O$:GOSUB 5000:PUT#1,RE
  268. 2680 RE=RE+1:S$=T$:GOSUB 5000:PUT#1,RE
  269. 2690 RE=RE+1:S$=K$:GOSUB 5000:PUT#1,RE
  270. 2700 RE=RE+1:S$=STR$(F):GOSUB 5000:PUT#1,RE
  271. 2710 RE=RE+1
  272. 2720 FOR P=1 TO F:S$=A$(P):GOSUB 5000:PUT#1,RE:RE=RE+1:NEXT P:
  273.      S$=" 9999":GOSUB 5000:PUT#1,RE:CLOSE#1:MX=MX+F+6:MZ=MZ+1:
  274.      M(MZ,1)=V+1:M(MZ,2)=F
  275. 2730 GOSUB 4200:GOSUB 4200:U=U+1:RETURN
  276. 2800 REM
  277. 2810 REM ***RETRIEVE MESSAGE***
  278. 2820 REM
  279. 2830 GOSUB 4200:A1$="MSG # ("+STR$(IU)+" -"+STR$(U)+" )":
  280.      IF NOT XPR THEN A1$=A1$+" to retrieve (c/r to end)"
  281. 2840 A1$=A1$+"?":GOSUB 4200:GOSUB 4400:GOSUB 4200
  282. 2850 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  283. 2860 IF M<1 THEN GOSUB 4200:RETURN
  284. 2870 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 4200:SAV$="":GOTO 2830
  285. 2880 GOSUB 4130:GOSUB 4200
  286. 2890 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
  287. 2900 MI=MI+1:IF (MI>MZ) OR BK THEN 3070 ELSE G=M(MI,1)
  288. 2910 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 2900
  289. 2920 IF G>M THEN 3040
  290. 2930 GOSUB 5800:IF OK THEN 2940 ELSE RE=RE+M(MI,2):GOTO 2900
  291. 2940 RE=RE+1:GET#1,RE:GOSUB 5100:D$=S$
  292. 2950 RE=RE+1:GET#1,RE:GOSUB 5100:NO$=S$
  293. 2960 RE=RE+1:GET#1,RE:GOSUB 5100:T$=S$
  294. 2970 RE=RE+1:GET#1,RE:GOSUB 5100:GOSUB 5930:K$=S$
  295. 2980 RE=RE+1:GET#1,RE:J=VAL(RR$):GOSUB 4200
  296. 2990 A$="Msg #"+STR$(G)+" was entered on date "+D$+" from "+NO$:GOSUB 4200
  297. 3000 A$="To "+T$+" about "+K$:GOSUB 4200:GOSUB 4200
  298. 3010 RE=RE+1:FOR P=1 TO J:GET#1,RE:GOSUB 5100:A$=S$:GOSUB 4200
  299. 3020 IF BK THEN 3070
  300. 3030 RE=RE+1:NEXT P:GOSUB 4200
  301. 3040 IF RIGHT$(B$,1)<>"+" THEN CLOSE:GOTO 2810
  302. 3050 M=M+1:MI=0:RE=1
  303. 3060 IF M<=U AND NOT BK THEN 2900
  304. 3070 CLOSE:A$="End of msg's.":GOSUB 4200:GOSUB 4200:D$="":NO$="":RETURN
  305. 3100 REM
  306. 3110 REM ***SUMMARIZE MESSAGES***
  307. 3120 REM COMMON CODE FOR S AND Q CMDS
  308. 3130 REM
  309. 3140 GOSUB 4200:
  310.       A1$="Msg # ("+STR$(IU)+" -"+STR$(U)+" ) to start (C/R to end)?":
  311.       GOSUB 4200:C=1:GOSUB 4400:C=0:GOSUB 4200
  312. 3150 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$):GOSUB 4300
  313. 3160 IP=INSTR(B$,","):IF IP>0 THEN B$=MID$(B$,IP+1) ELSE ST=0:GOTO 3210
  314. 3170 IF LEN(B$)<3 THEN RETURN
  315. 3180 IF MID$(B$,2,1)<>"=" THEN RETURN
  316. 3190 SV$=MID$(B$,3):B$=LEFT$(B$,1):ST=INSTR("FTS",B$)
  317. 3200 IF ST=0 THEN RETURN
  318. 3210 IF M<1 THEN RETURN
  319. 3220 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 4200:SAV$="":RETURN
  320. 3230 IF NOT QU THEN GOSUB 4130:GOSUB 4200
  321. 3240 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD #1,28 AS RR$
  322. 3250 GET #1,RE
  323. 3260 IF EOF(1) OR BK THEN 3430 ELSE G=VAL(RR$)
  324. 3270 IF G>9998 THEN 3430
  325. 3280 IF G<M THEN RE=RE+6:GOTO 3250
  326. 3290 GOSUB 5800:IF OK THEN 3300 ELSE RE=RE+6:GOTO 3250
  327. 3300 GET #1,RE+ST+1:IF ST=0 THEN 3310 ELSE GOSUB 5100:IF INSTR(S$,SV$)=0 THEN RE=RE+6:GOTO 3250
  328. 3310 IF NOT QU THEN 3350
  329. 3320 REM quick summary
  330. 3330 GET #1,RE+4:GOSUB 5100:GOSUB 5930:
  331.       A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+" "+S$:GOSUB 4200
  332. 3340 IF U=G OR BK THEN 3430 ELSE RE=RE+6:GOTO 3250
  333. 3350 REM full summary
  334. 3360 A$="Msg #"+STR$(G)+"    Date entered: ":N=1:GOSUB 4200:IF BK THEN 3430
  335. 3370 RE=RE+1:GET #1,RE:GOSUB 5100:A$=S$+"   From: ":N=1:GOSUB 4200:IF BK THEN 3430
  336. 3380 RE=RE+1:GET #1,RE:GOSUB 5100:A$=S$:GOSUB 4200:IF BK THEN 3430
  337. 3390 A$="To: ":N=1:GOSUB 4200:RE=RE+1:GET #1,RE:GOSUB 5100:A$=S$:GOSUB 4200:IF BK THEN 3430
  338. 3400 A$="About: ":N=1:GOSUB 4200:RE=RE+1:GET #1,RE:
  339.       GOSUB 5100:GOSUB 5930:A$=S$:GOSUB 4200:IF BK THEN 3430
  340. 3410 A$="Size: ":N=1:GOSUB 4200:RE=RE+1:GET #1,RE:GOSUB 5100:A$=S$:GOSUB 4200:IF BK THEN 3430
  341. 3420 GOSUB 4200:IF U=G OR BK THEN 3430 ELSE RE=RE+1:GOTO 3250
  342. 3430 GOSUB 4200:A$="***** End of summary *****":GOSUB 4200:GOSUB 4200:GOSUB 4200:CLOSE:RETURN
  343. 3500 REM
  344. 3510 REM ***GOODBYE***
  345. 3520 REM
  346. 3530 GOSUB 4200:A1$="Want to leave any comments?":GOSUB 4200:C=1:GOSUB 4400:C=0
  347. 3540 IF LEFT$(B$,1)="N" THEN 3640
  348. 3550 IF LEFT$(B$,1)<>"Y" THEN 3530
  349. 3560 OPEN "R",1,"A:COMMENTS",65:FIELD#1,65 AS RR$:GET#1,1:RE=VAL(RR$)+1:RL=65
  350. 3570 IF RE=1 THEN RE=2
  351. 3580 S$="From: "+N$+" "+O$:GOSUB 5000
  352. 3590 PUT#1,RE
  353. 3600 A$="Enter comments; to end, hit C/R.":GOSUB 4200
  354. 3610 A$="Ok>":N=1:GOSUB 4200:GOSUB 4400
  355. 3620 IF B$="" THEN 3630 ELSE RE=RE+1:S$=B$:RL=65:GOSUB 5000:PUT#1,RE:GOTO 3610
  356. 3630 S$=STR$(RE):RL=65:GOSUB 5000:PUT#1,1:CLOSE
  357. 3640 GOSUB 4200:
  358.      A$="Character count:  "+STR$(A)+" typed by system - "+STR$(D)+
  359.      " typed by you.":GOSUB 4200:
  360.      A$="From Bruce: thanks for calling, "+N$+".":GOSUB 4200
  361. 3650 GOSUB 4680: TAC=CURT-TON
  362. 3660 IF TAC < 0 THEN TAC=TAC+1440
  363. 3670 A$="I enjoyed your call the past"+STR$(TAC)+" minutes.":GOSUB 4200
  364. 3680 A$="***** End of connection ******":GOSUB 4200:GOSUB 4200:SYSTEM
  365. 3700 REM
  366. 3710 REM ***KILL A MESSAGE***
  367. 3720 REM
  368. 3730 GOSUB 4200:A1$="Message # to kill?":GOSUB 4200:GOSUB 4400
  369. 3740 IF LEN(B$)=0 THEN M=0 ELSE M=VAL(B$)
  370. 3750 IF M<1 THEN GOSUB 4200:RETURN
  371. 3760 IF M>U THEN A$="There aren't that many msg's, "+N$+".":GOSUB 4200:SAV$="":GOTO 3720
  372. 3770 A$="Scanning summary file...":GOSUB 4200:
  373.      OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  374. 3780 GET#1,RE
  375. 3790 IF EOF(1) THEN 3960 ELSE G=VAL(RR$)
  376. 3800 IF G>9998 THEN 3960
  377. 3810 IF G<M THEN RE=RE+6:GOTO 3780
  378. 3820 IF G>M THEN 3960
  379. 3830 GOSUB 5800:IF NOT OK THEN 3960
  380. 3840 GOSUB 5100:PW=INSTR(S$,";"):PW$=""
  381. 3850 IF PW=0 OR N$+O$="SYSOP" OR PERS THEN PERS=0:GOTO 3870
  382. 3860 PW$=MID$(S$,PW+1):A1$="Password ?":GOSUB 4200:C=1:GOSUB 4400:C=0:
  383.       IF B$<>PW$ THEN A$="Incorrect.":GOSUB 4200:GOSUB 4200:CLOSE:RETURN
  384. 3870 S$=" 0"+":"+STR$(G):GOSUB 5000:PUT#1,RE:CLOSE
  385. 3880 A$="Updating message file...":GOSUB 4200
  386. 3890 OPEN "R",1,"A:MESSAGES",65:RE=1:FIELD#1,65 AS RR$:MI=0
  387. 3900 MI=MI+1:IF MI>MZ THEN 3960 ELSE G=M(MI,1)
  388. 3910 IF G<M THEN RE=RE+M(MI,2)+6:GOTO 3900
  389. 3920 IF G=M THEN S$="0"+":"+STR$(G)+":"+N$+","+O$:RL=65:GOSUB 5000:PUT#1,RE:M(MI,1)=0
  390. 3930 CLOSE#1:A$="Updating message count...":GOSUB 4200
  391. 3940 OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$:
  392.      GET#1,MSGS:LSET RR$=STR$(VAL(RR$)-1):PUT#1,MSGS:CLOSE
  393. 3950 GOSUB 4200:A$="Message killed.":GOSUB 4200:GOSUB 4200:RETURN
  394. 3960 CLOSE:A$="Message not found.":GOSUB 4200:GOSUB 4200:RETURN
  395. 4000 REM
  396. 4010 REM ***DISPLAY USER FILE***
  397. 4020 REM
  398. 4030 GOSUB 4130:OPEN "R",1,"A:USERS",62:FIELD#1,1 AS MU$,1 AS SU$,60 AS RR$:
  399.       FIELD#1,10 AS NN$:GET#1,1:NU=VAL(NN$)
  400. 4040 FOR I=NU+1 TO 2 STEP -1:
  401.       GET#1,I:IF SU$<>"*" THEN GOSUB 5100:A$=S$:GOSUB 4200
  402. 4050 IF BK THEN 4070
  403. 4060 NEXT I
  404. 4070 CLOSE:GOSUB 4200:RETURN
  405. 4100 REM
  406. 4110 REM **** PRINT CONTROL-CHAR INFO
  407. 4120 REM
  408. 4130 GOSUB 4200
  409. 4140 A$="Use ctl-K to abort, ctl-S to pause."
  410. 4200 REM
  411. 4210 REM ***PRINT STRING FROM A$ ON CONSOLE***
  412. 4220 REM
  413. 4230 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
  414. 4240 IF A1$<>"" THEN A$=A1$:A1$=""
  415. 4250 IF RIGHT$(A$,1)="?" OR N=1 THEN PRINT A$;:PP$=A$:GOTO 4280
  416. 4260 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
  417. 4270 IF BI=11 THEN BK=-1:GOTO 4300 ELSE PRINT A$
  418. 4280 A=A+LEN(A$)
  419. 4290 IF N$+O$="SYSOP" AND INP(255)=1 THEN LPRINT A$;:
  420.          IF N=0 AND RIGHT$(A$,1)<>"?" THEN LPRINT
  421. 4300 A$="":N=0
  422. 4310 RETURN
  423. 4400 REM
  424. 4410 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
  425. 4420 REM
  426. 4430 IF BEL AND SAV$="" THEN PRINT CHR$(7);
  427. 4440 B$="":BK=0
  428. 4450 IF SAV$="" THEN GOSUB 6000
  429. 4460 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 4480
  430. 4470 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
  431. 4480 IF LEN(B$)=0 THEN RETURN
  432. 4490 IF C=0 THEN 4510
  433. 4500 FOR ZZ=1 TO LEN(B$):MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):NEXT ZZ
  434. 4510 IF LEN(B$)<64 THEN 4560
  435. 4520 A$="Input line too long - would be truncated to:":GOSUB 4200
  436. 4530 B$=LEFT$(B$,63):PRINT B$
  437. 4540 LINE INPUT "Retype line (Y/N)?";QQ$:QQ$=LEFT$(QQ$,1)
  438. 4550 IF QQ$="Y" OR QQ$="y" THEN PRINT PP$;:SAV$="":GOTO 4400
  439. 4560 D=D+LEN(B$):RETURN
  440. 4570 RETURN
  441. 4600 REM
  442. 4610 REM READ ENTER REAL TIME CLOCK/CALENDER
  443. 4620 REM
  444. 4630 GOSUB 4710: TON=CURT
  445. 4640 DM$=HEX$(PEEK(&H52)):DD$=HEX$(PEEK(&H53))
  446. 4650 DY$="81":D$=DM$+"/"+DD$+"/"+DY$
  447. 4660 DH$=HEX$(PEEK(&H50)):DM$=HEX$(PEEK(&H51))
  448. 4670 DT$=DH$+":"+DM$: RETURN
  449. 4680 REM READ CLOCK NOW
  450. 4690 REM CLOCK=&HEDE3
  451. 4700 REM CALL CLOCK
  452. 4710 REM GET LAST CLOCK VALUE
  453. 4720 CURT = VAL(HEX$(PEEK(&H50)))*60+VAL(HEX$(PEEK(&H51)))
  454. 4730 RETURN
  455. 4800 REM ***ON ERROR HANDLER***
  456. 4810 IF ERL=660 THEN RESUME 680
  457. 4820 IF ERL=5430 THEN RESUME 5450
  458. 4830 IF ERL=940 THEN RE=0:RESUME 950
  459. 4840 IF ERL=990 THEN M=0:RESUME 1000
  460. 4850 IF ERL=1010 THEN C=0:RESUME 1020
  461. 4860 IF ERL=1030 THEN U=0:RESUME 1040
  462. 4870 IF ERL=2130 THEN V=0:RESUME 2140
  463. 4880 IF ERL=2580 THEN C=0:RESUME 2590
  464. 4890 IF ERL=2600 THEN C=0:RESUME 2610
  465. 4900 RESUME NEXT
  466. 5000 REM
  467. 5010 REM FILL AND STORE DISK RECORD
  468. 5020 REM
  469. 5030 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  470. 5040 RETURN
  471. 5100 REM
  472. 5110 REM UNPACK DISK RECORD
  473. 5120 REM
  474. 5130 ZZ=LEN(RR$)-2
  475. 5140 WHILE MID$(RR$,ZZ,1)=" "
  476. 5150 ZZ=ZZ-1:IF ZZ=1 THEN 5170
  477. 5160 WEND
  478. 5170 S$=LEFT$(RR$,ZZ)
  479. 5180 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
  480. 5190 RETURN
  481. 5200 REM
  482. 5210 REM *** TOGGLE EXPERT USER MODE
  483. 5220 REM
  484. 5230 XPR=NOT XPR:RETURN
  485. 5300 REM
  486. 5310 REM *** TOGGLE BELL PROMPT
  487. 5320 REM
  488. 5330 BEL=NOT BEL:RETURN
  489. 5400 REM
  490. 5410 REM SUBROUTINE TO PRINT A FILE
  491. 5420 REM
  492. 5430 OPEN "I",1,FIL$:BK=0
  493. 5440 IF EOF(1) OR BK THEN 5450 ELSE LINE INPUT #1,A$:GOSUB 4200:GOTO 5440
  494. 5450 CLOSE #1:RETURN
  495. 5500 REM FULL SUMMARY
  496. 5510 QU=0:GOSUB 3100:RETURN
  497. 5600 REM QUICK SUMMARY
  498. 5610 QU=-1:GOSUB 3100:RETURN
  499. 5700 REM PRINT "CALLERS" FILE...FOR SYSOP ONLY (PRIVATE CMD)
  500. 5710 GOSUB 4200
  501. 5720 IF N$+O$<>"SYSOP" THEN 1400' IF NOT SYSOP, SAY "I DON'T UNDERSTAND".
  502. 5730 OPEN "R",1,"A:CALLERS",60:FIELD #1,60 AS RR$:GET #1,1:SIZ=VAL(RR$)
  503. 5740 CA=CN
  504. 5750 FOR CNT=SIZ+1 TO 2 STEP -1
  505. 5760 GET #1,CNT:GOSUB 5100:A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:GOSUB 4200:IF BK THEN 5790
  506. 5770 CA=CA-1
  507. 5780 NEXT CNT
  508. 5790 CLOSE:A$= "END OF CALLERS.":GOSUB 4200:GOSUB 4200:RETURN
  509. 5800 REM TEST FOR PERSONAL MESSAGES
  510. 5810 PERS=0:OK=-1:GET #1,RE:IF INSTR(RR$,";*")=0 THEN 5860
  511. 5820 PERS=-1
  512. 5830 IF N$+O$="SYSOP" THEN 5860
  513. 5840 GET #1,RE+3:GOSUB 5900:IF OK THEN 5860
  514. 5850 GET #1,RE+2:GOSUB 5900
  515. 5860 RETURN
  516. 5900 REM TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME
  517. 5910 IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN OK=-1 ELSE OK=0
  518. 5920 RETURN
  519. 5930 IF PERS THEN S$="("+S$:S$=S$+")":PERS=0
  520. 5940 RETURN
  521. 6000 CHC=0: SAV$=""
  522. 6010 NCH=ASC(INPUT$(1))
  523. 6020 IF NCH=127 THEN 6080
  524. 6030 IF NCH<32 THEN 6110
  525. 6040 IF CHC>=63 THEN 6010
  526. 6050 SAV$=SAV$+CHR$(NCH): CHC=CHC+1: PRINT CHR$(NCH);
  527. 6060 IF CHC=55 THEN PRINT CHR$(7);
  528. 6070 GOTO 6010
  529. 6080 IF CHC=0 THEN 6010 ELSE PRINT RIGHT$(SAV$,1);: GOTO 6100
  530. 6090 IF CHC=0 THEN 6010 ELSE PRINT ERS$;
  531. 6100 CHC=CHC-1: SAV$=LEFT$(SAV$,CHC): GOTO 6010
  532. 6110 IF NCH=8 THEN 6090
  533. 6120 IF NCH=13 THEN PRINT: RETURN
  534. 6130 IF NCH=21 THEN PRINT " #": GOTO 6000
  535. 6140 IF NCH<>24 OR CHC=0 THEN 6010
  536. 6150 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: GOTO 6000
  537.