home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols100 / vol112 / rbbs-pc.bas < prev    next >
Encoding:
BASIC Source File  |  1994-07-13  |  27.4 KB  |  557 lines
  1.  
  2. 10      ' RBBS-I/O.BAS   Remote Bullettin Board Program
  3. 20      ' This Version Also Performs The Sign-On Functions & Modem I/O
  4. 35      ' See RBBS-I/O.DOC
  5. 30      ' Author - Russ Lane  - 6/21/82  -  (C)Copyright  1982
  6. 40      ' Gripes, Problems, Suggestions, Modifications, And Praise
  7. 50      ' Are More Than Welcome.  312-251-3067 (voice) -  312-251-0168 (data)
  8. 60      '
  9. 65 D$=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
  10. 70 ON ERROR GOTO 13000
  11. 80 DEFINT A-Z : CR$=CHR$(13) : LF$=CHR$(10) : TB$=CHR$(9)
  12. 90 BK$=CHR$(8)+CHR$(32)+CHR$(8) : BK1$=CHR$(29)+CHR$(32)+CHR$(29)
  13. 95 GOSUB 100 : GOTO 200
  14. 100             ' Write Record #, Msg #, to Array -----------------------------
  15. 105 CLOSE #1,2 : DIM M(500,2)   'M(Record #,Msg #)        500 is max # of msgs.
  16. 110 R=1 : OPEN "R",#1,"MESSAGES" : FIELD #1,128 AS R$
  17. 120 GET 1,R : IF INSTR(R$,CHR$(226))>1 THEN DEAD=-1 ' If it's killed...
  18. 130 RR=VAL(MID$(R$,118)) : IF DEAD THEN 150 ELSE IF RR<1 THEN 160
  19. 140 LASTR=LASTR+1 : M(LASTR,1)=R : M(LASTR,2)=VAL(LEFT$(R$,5))
  20. 150 R=R+RR : DEAD=0 : GOTO 120
  21. 160 FIRSTM=M(1,2) : LASTM=M(LASTR,2) : RETURN
  22. 200             ' Wait for Caller to Call -------------------------------------
  23. 210 OPEN "COM1:300,N,8,1" AS #3
  24. 220 PRINT "Sign-on module ready."
  25. 230 WHILE EOF(3)
  26. 234 IF INKEY$=CHR$(27) THEN PRINT "Sysop is in.":CLOSE 3:LOCAL=-1:GOTO 450
  27. 236 WEND
  28. 238 WHILE INPUT$(2,3)<>STRING$(2,13) : WEND
  29. 240 WIDTH 80:SCREEN 0,0,0:KEY OFF : TI$=TIME$
  30. 250 A$="Do you need line feeds ? ":CR=1:GOSUB 1400:Z$=INPUT$(1,#3):GOSUB 5000
  31. 255 IF Z$="Y" THEN LF=-1 ELSE IF Z$="N" THEN LF=0 ELSE GOSUB 1400:GOTO 250
  32. 257 A$=Z$ : CR=2 : GOSUB 1400
  33. 260 RET=1:STI=-1:FILE$="WELCOME" :GOSUB 6000 'STI Enables Interrupts (Ctrl-K)
  34. 270 RET=2:STI=-1:FILE$="BULLETIN":GOSUB 6000 'RET Will Return To Here From ^K
  35. 280 CR=2:GOSUB 1400:TRIES=0:STI=0   'Interrupts Off
  36. 300            ' Get Caller's Name --------------------------------------------
  37. 305 IF TRIES>5 THEN 12000 ' Log-Off Nicely
  38. 310 TRIES=TRIES+1:GOSUB 1400:A$="What is your FIRST Name":GOSUB 1500
  39. 320 IF Q=0 THEN 300 ELSE Z$=B$(1):GOSUB 5000:FIRST$=Z$:IF Q=1 THEN 340
  40. 330 Z$=B$(2):GOSUB 5000:LAST$=Z$:GOTO 370
  41. 340 A$="What is your LAST  Name":GOSUB 1500
  42. 350 Z$=B$(1):GOSUB 5000:LAST$=Z$
  43. 370 IF LEN(FIRST$)<2 OR LEN(LAST$)<2 THEN 300
  44. 380 IF FIRST$="PASS" AND LAST$="WORD" THEN 450    'Place Sysop's Password Here
  45. 390 NAM$=FIRST$+CHR$(32)+LAST$
  46. 400 IF INSTR(NAM$,"SYSOP")OR INSTR(NAM$,"RUSS LANE")THEN 12500 'Log-Off Wiseguy
  47. 410 FOR Q=1 TO LEN(NAM$)
  48. 430 X=ASC(MID$(NAM$,Q,1)) : IF (X<65 OR X>90) AND (X<>32 AND X<>39) THEN 300
  49. 440 NEXT : GOSUB 1400 : GOTO 500
  50. 450 FIRST$="RUSS":LAST$="LANE":NAM$="SYSOP":SYSOP=-1:BELL=0:XPR=-1:GOTO 1200
  51. 500            ' Check Last Caller --------------------------------------------
  52. 510 OPEN "I",#2,"LASTCALR" : INPUT #2,N$,CALLN : CLOSE #2
  53. 520 IF NAM$<>N$ THEN 600
  54. 530 LASTCALR=-1 : A$="Welcome back, "+FIRST$ : CR=2 : GOSUB 1400 : GOTO 820
  55. 600            ' Check User File ---------------------------------------------
  56. 610 A$="Checking User File..." : CR=2 : GOSUB 1400
  57. 620 OPEN "I",#2,"USERS"
  58. 630 IF EOF(2) THEN CLOSE #2:GOTO 700
  59. 640 INPUT #2,N$,CITY$,STATE$,STATU$
  60. 650 IF NAM$<>N$ THEN 630
  61. 660 CLOSE #2
  62. 670 IF STATU$="OK" THEN 810 ' Can Access System
  63. 680 GOTO 12530              ' Log-Off Weasel
  64. 700            ' Get New User's Background ------------------------------------
  65. 710 NEWCALR=-1
  66. 720 A$="What CITY  are you calling from":GOSUB 1500
  67. 730 IF Q=0 THEN 300 ELSE Z$=B$(1) : GOSUB 5000 : CITY$=Z$
  68. 740 A$="What STATE are you calling from":GOSUB 1500
  69. 750 IF Q=0 THEN 720 ELSE Z$=B$(1) : GOSUB 5000 : STATE$=Z$
  70. 760 A$=TB$+NAM$:GOSUB 1400
  71. 770 A$=TB$+CITY$+", "+STATE$:CR=2:GOSUB 1400
  72. 780 A$="Is this correct":GOSUB 1500:GOSUB 1400:IF NOT YES THEN 300
  73. 790 OPEN "A",#2,"USERS" : WRITE #2,NAM$,CITY$,STATE$,"OK" : CLOSE #2
  74. 795 A$="This is only done the first time you call, "+FIRST$ : CR=2 : GOSUB 1400
  75. 800            ' Log To Disk -------------------------------------------------
  76. 810 A$="Logging "+NAM$+" to disk..." : CR=2 : GOSUB 1400
  77. 820 OPEN "O",#2,"LASTCALR" : CALLN=CALLN+1
  78. 830 WRITE #2,NAM$,CALLN : CLOSE #2
  79. 840 OPEN "A",#2,"CALLERS"
  80. 850 PRINT #2,NAM$;"  ";D$;"  ";TI$ : CLOSE #2
  81. 860 IF LASTCALR OR NEWCALR OR SYSOP THEN 1040 ' Bypass Search For Msgs
  82. 900            ' Search for any messages to this caller ----------------------
  83. 920 A$="I'm seeing if there are messages waiting for you...":CR=2 : GOSUB 1400
  84. 930 X=37:Y=31:F$=NAM$:T=0:DONE=0:R=1
  85. 950 GET 1,R : RR=VAL(MID$(R$,118)) : R=R+RR : IF RR<1 THEN 970
  86. 960 IF INSTR(MID$(R$,37,31),NAM$)>0 THEN 980 ELSE 950
  87. 970 IF T THEN 1040 ELSE 1030
  88. 980 IF T THEN 1020
  89. 990  A$="The following message(s) was/were left for you.":GOSUB 1400
  90. 1000 A$="Please (K)ill those that would not interest other callers."
  91. 1010 GOSUB 1400:T=-1
  92. 1020 A$=LEFT$(R$,5):CR=1:GOSUB 1400:GOTO 950
  93. 1030 A$="Nope.  No messeges for you, "+FIRST$
  94. 1040 CR=2 : GOSUB 1400 : A$="Entering The Messege Sub-System..." : GOSUB 1400
  95. 1050 LOCATE 25,1:PRINT SPACE$(80-(LEN(NAM$)+10));NAM$;"  ";TI$
  96. 1060 XPR=0 : BELL=-1 : MARGIN=64
  97. 1070 RET=0 : GOSUB 4900 : STI=-1 : GOSUB 1700
  98. 1200            ' Command Dispatcher ------------------------------------------
  99. 1210 STI=-1:RET=0:Q=0           'Interrupts On,  Return To Here On A Ctrl-K
  100. 1220 ERASE B$
  101. 1230 GOSUB 1400
  102. 1240 IF SYSOP THEN GOSUB 10000
  103. 1250 A$="Function"
  104. 1260 IF NOT XPR THEN A$=A$+"  <B,C,E,G,H,K,L,P,Q,R,S,X,Y,#,? >"
  105. 1270 GOSUB 1500:IF Q=0 THEN 1250
  106. 1280 FOR J=1 TO Q
  107. 1290 Z$=B$(J):GOSUB 5000
  108. 1300 FF=INSTR("?BCEGHKLPQRSXY#$%^&*(",Z$)
  109. 1310 IF FF=0 THEN 1360 ELSE IF FF>15 AND NOT SYSOP THEN 1360
  110. 1320 '           ?    B    C    E    G     H     K     L     P     Q     R
  111. 1330 ON FF GOSUB 1700,1720,1800,2000,12000,1740, 3900, 4100, 4150, 4310, 4320, 
  112.                  4330,4200,4700,4900,10100,10120,10200,10400,10600,10800
  113. 1340 '           S    X    Y    #    $     %     ^     &     *     (
  114. 1350 NEXT J : GOTO 1200
  115. 1360 IF XPR THEN 1250 ELSE GOSUB 1400
  116. 1370 A$=FIRST$+", I don't understand "+B$(J):GOSUB 1400:GOTO 1200
  117. 1380 '
  118. 1390 '
  119. 1400            ' Print string ------------------------------------------------
  120. 1402 Y$=INKEY$ : IF LOCAL THEN 1430
  121. 1405 IF EOF(3) THEN 1430
  122. 1410 Y$=INPUT$(1,#3)
  123. 1420 IF Y$=CHR$(19) THEN WHILE EOF(3) : WEND    ' Ctrl-S
  124. 1430 IF Y$=CHR$(11) AND STI THEN 1480           ' Ctrl-K
  125. 1440 LOCATE ,,1 : PRINT A$; : IF LOCAL THEN 1450
  126. 1445 PRINT #3,A$;
  127. 1450 IF CR=1 THEN 1470
  128. 1460 PRINT : IF LOCAL THEN 1465
  129. 1462 PRINT #3,"" : IF LF THEN PRINT #3,CR$+LF$
  130. 1465 IF CR=2 THEN CR=0 : GOTO 1460
  131. 1470 Y$="" : A$="" : CR=0 : RETURN
  132. 1480 CLOSE #2 : A$="++ Aborted ++" : GOSUB 1400 : ON RET GOTO 270,280
  133. 1490 RETURN 1200
  134. 1500            ' Input string ------------------------------------------------
  135. 1510 A=0:B=0:C=0:Q=1:EOL=0:YES=0:B$=""
  136. 1520 A$=A$+" ? "
  137. 1530 IF BELL THEN A$=A$+CHR$(7)
  138. 1540 CR=1 : GOSUB 1400 : IF LOCAL THEN INPUT "",B$ : GOTO 1575
  139. 1550 WHILE EOF(3)
  140. 1552 Y$=INKEY$ : IF Y$<>"" THEN 1562
  141. 1554 WEND
  142. 1560   Y$=INPUT$(1,#3)
  143. 1562   IF Y$=CHR$(8) THEN 1670
  144. 1564   PRINT Y$; : PRINT #3,Y$;
  145. 1566   IF Y$=CR$ THEN 1570
  146. 1568   B$=B$+Y$ : GOTO 1550
  147. 1570 IF LF THEN PRINT #3,CR$+LF$
  148. 1575 A=INSTR(B$,";") : IF A=0 THEN 1640
  149. 1580 B$(1)=LEFT$(B$,A-1)
  150. 1582 B=INSTR(A+1,B$,";")
  151. 1584 C=B-(A+1) : IF C<1 THEN EOL=-1 : C=50 '50 insures all rightmost characters
  152. 1590 BB$=MID$(B$,A+1,C)
  153. 1600 IF BB$<>"" THEN Q=Q+1:B$(Q)=BB$
  154. 1610 IF NOT EOL THEN A=B:GOTO 1582
  155. 1620 IF LEN(B$)=>20 THEN A$="Try again, ";FIRST$ : GOSUB 1400 : GOTO 1500
  156. 1630 RETURN
  157. 1640 B$(1)=B$ : IF B$="" THEN Q=0
  158. 1650 IF LEFT$(B$,1)="Y" OR LEFT$(B$,1)="y" THEN YES=-1
  159. 1660 RETURN
  160. 1670 IF LEN(B$)=0 THEN 1550
  161. 1680 B$=LEFT$(B$,LEN(B$)-1)
  162. 1690 PRINT BK1$; : PRINT #3,BK$; : GOTO 1550
  163. 1700           ' ? Type Functions Supported -----------------------------------
  164. 1710 FILE$="HELP02":GOSUB 6000:RETURN
  165. 1720           ' Type Bulletins -----------------------------------------------
  166. 1730 FILE$="BULLETIN":GOSUB 6000:RETURN
  167. 1740           ' Type Help File -----------------------------------------------
  168. 1750 FILE$="HELP01":GOSUB 6000:RETURN
  169. 1800           ' Comments -----------------------------------------------------
  170. 1810 GOSUB 1400:A$="Comments are only readable by Sysop.":GOSUB 1400:MARGIN=64
  171. 1820 A$="Do you wish to leave any":GOSUB 1500
  172. 1830 IF NOT YES THEN A$="No comment.":GOSUB 1400:RETURN
  173. 1840 LI=0:DIM A$(30)
  174. 1850 GOSUB 1400:A$="Enter up to 20 lines. (lone C/R to end):GOSUB 1400
  175. 1860 GOSUB 1400:GOSUB 3200
  176. 1870 R$="":LI=LI+1:A$="   "+STR$(LI)+": "+A$(LI):IF LI<10 THEN A$=" "+A$
  177. 1880 CR=1 : GOSUB 1400 : GOSUB 3700
  178. 1890 IF A$(LI)="" THEN LI=LI-1:IF LI<1 THEN ERASE A$:RETURN ELSE 1940
  179. 1900 IF LI=18 THEN A$="Two lines left...":GOSUB 1400
  180. 1910 IF LI=19 THEN A$="Last line.":GOSUB 1400
  181. 1920 IF LI=20 AND NOT SYSOP THEN A$="Comment full.":GOSUB 1400:GOTO 1940
  182. 1930 GOTO 1870
  183. 1940 OPEN "A",#2,"COMMENTS"
  184. 1950 GOSUB 1400:A$="Many thanks for the comments, "+FIRST$:GOSUB 1400
  185. 1960 PRINT #2,NAM$,D$,TIME$
  186. 1970 FOR X=1 TO LI:PRINT #2,A$(X):NEXT
  187. 1980 FOR X=1 TO 2 :PRINT #2,CHR$(13):NEXT:CLOSE #2:ERASE A$:RETURN
  188. 2000           ' Enter A Messege --------------------------------------------
  189. 2010 GOSUB 1400:T$="":PAS$="":LI=0:L=0:X=0:BEGIN=0
  190. 2030 DIM A$(30)
  191. 2040 A$="Messege will be # "+STR$(LASTM+1) : GOSUB 1400
  192. 2050 A$="Who To <C/R  For All>":GOSUB 1500
  193. 2060 IF LEN(B$(1))>30 THEN A$="30 Chars max.":GOSUB 1400:GOTO 2050
  194. 2070 IF Q=0 THEN T$="ALL" ELSE Z$=B$(1):GOSUB 5000:T$=Z$
  195. 2080 A$="Subject":GOSUB 1500
  196. 2090 IF LEN(B$(1))>25 THEN A$="25 Chars max.":GOSUB 1400:GOTO 2080
  197. 2100 IF Q=0 THEN 2050 ELSE Z$=B$(1):GOSUB 5000:SUB$=Z$
  198. 2110 A$="Protect  <K,R,N,?>":IF XPR THEN 2130
  199. 2120 A$="Protect  < <K>ill, <R>ead, <N>one, <?>Help >"
  200. 2130 GOSUB 1500:Z$=LEFT$(B$(1),1):GOSUB 5000:IF Z$="N" THEN 2190
  201. 2140 IF Z$="?" THEN FILE$="HELP03":GOSUB 6000:GOTO 2120
  202. 2150 IF Z$="K" THEN 2170
  203. 2160 IF Z$="R" THEN PAS$="^READ^":GOTO 2190
  204. 2165 GOTO 2080
  205. 2170 A$="Password":GOSUB 1500
  206. 2180 IF LEN(B$(1))>15 THEN A$="15 Chars. max.":GOSUB 1400:GOTO 2170 
  207. 2185 PAS$=B$(1)
  208. 2190 GOSUB 1400:IF XPR THEN 2212
  209. 2200 A$="To enter message, type in lines.":GOSUB 1400
  210. 2210 A$="To edit, type lone C/R.   20 lines max.":GOSUB 1400
  211. 2212 A$="Right-Margin is set at"+STR$(MARGIN):GOSUB 1400
  212. 2214 A$="Do you wish to change it":GOSUB 1500
  213. 2216 IF YES THEN BEGIN=-1:GOTO 3100
  214. 2218 BEGIN=0:GOSUB 3200
  215. 2220 R$="" : LI=LI+1 : A$="   "+STR$(LI)+": "+A$(LI):IF LI<10 THEN A$=" "+A$
  216. 2230 CR=1 : GOSUB 1400:GOSUB 3700
  217. 2240 IF A$(LI)="" THEN LI=LI-1:GOTO 2310
  218. 2250 IF LI=18 THEN A$="Two lines left...":GOSUB 1400
  219. 2260 IF LI=19 THEN A$="Last line.":GOSUB 1400
  220. 2270 IF LI=20 AND NOT SYSOP THEN A$="Messege full.":GOSUB 1400:GOSUB 2300
  221. 2280 GOTO 2220
  222. 2300            'Editing dispatcher ------------------------------------------
  223. 2305 GOSUB 1400
  224. 2310 IF XPR THEN A$="Function  <A,C,D,E,I,L,M,S,? >":GOTO 2340
  225. 2320 A$="Functions : <A>bort, <C>ontinue, <D>elete, <E>dit,":GOSUB 1400
  226. 2330 A$="            <I>nsert, <L>ist, <M>argin, <S>ave, <?>Help "
  227. 2340 GOSUB 1500:IF Q=0 THEN 2310 ELSE Z$=B$(1):GOSUB 5000
  228. 2350 IF Q>1 AND Z$<>"M" THEN L=VAL(B$(Q)):GOSUB 3320 'Test validity of line #
  229. 2360 FF=INSTR("ACDEILMS?",Z$):IF FF<1 OR FF>9 THEN 2310
  230. 2370 ON FF GOTO 2400,2380,2500,2600,2800,3000,3100,3400,2390
  231. 2380 GOSUB 3200:GOTO 2250   'Continue
  232. 2390 FILE$="HELP04":GOSUB 6000:GOTO 2320
  233. 2400            'Abort -------------------------------------------------------
  234. 2410 GOSUB 1400:A$="Do you confirm Abortion":GOSUB 1500
  235. 2420 IF NOT YES THEN 2300
  236. 2430 GOSUB 1400:A$="Aborted.":GOSUB 1400:ERASE A$:RETURN 1200
  237. 2500            'Delete A Line -----------------------------------------------
  238. 2510 GOSUB 1400:IF Q=1 THEN A$="Delete ":CR=1:GOSUB 1400:GOSUB 3300
  239. 2520 A$="Line #"+STR$(L) : GOSUB 1400 : A$=A$(L) : CR=2 : GOSUB 1400
  240. 2530 A$="Do You Confirm Deletion":GOSUB 1500
  241. 2540 IF NOT YES THEN A$="Line #"+STR$(L)+" NOT Deleted.":GOSUB 1400:GOTO 2300
  242. 2550 FOR X=L TO LI:A$(X)=A$(X+1):NEXT:LI=LI-1
  243. 2560 A$="Line #"+STR$(L)+" Deleted.":GOSUB 1400:GOTO 2300
  244. 2600            'Edit A Line -------------------------------------------------
  245. 2610 GOSUB 1400:IF Q=1 THEN GOSUB 3300
  246. 2620 A$="Line # "+STR$(L)+" Was :":GOSUB 1400:A$=A$(L):CR=2:GOSUB 1400
  247. 2630 A$="Enter  Oldstring;Newstring  or  C/R for no change.":GOSUB 1400
  248. 2640 GOSUB 1400:GOSUB 1500
  249. 2650 IF Q=0 THEN 2300
  250. 2660 X=INSTR(1,A$(L),B$(1)):IF X=0 THEN 2720
  251. 2680 LB1=LEN(B$(1)):LB2=LEN(B$(2)):IF LB1<>LB2 THEN 2700
  252. 2690 MID$(A$(L),X)=B$(2):GOTO 2620
  253. 2700 C$=MID$(A$(L),X+LB1):CC$=LEFT$(A$(L),X-1)
  254. 2710 A$(L)=CC$+B$(2)+C$:GOTO 2620
  255. 2720 A$="String  '"+B$(1)+"' not found in line "+STR$(L):GOSUB 1400:GOTO 2300
  256. 2800            'Insert A Line -----------------------------------------------
  257. 2810 DIM C$(30)
  258. 2820 GOSUB 1400:IF Q=1 THEN A$="Before ":CR=1:GOSUB 1400:GOSUB 3300
  259. 2830 W=LI:K=LI-L:FOR X=L TO LI:C$(X+1-L)=A$(X):A$(X)="":NEXT : LI=L
  260. 2840 R$="":A$=STR$(LI)+": ":IF LI<10 THEN A$=" "+A$
  261. 2850 CR=1:GOSUB 1400:GOSUB 3700
  262. 2860 IF A$(LI)="" THEN 2920
  263. 2870 LI=LI+1
  264. 2880 IF LI+K=18 THEN A$="Two lines left...":GOSUB 1400
  265. 2890 IF LI+K=19 THEN A$="Last line.":GOSUB 1400
  266. 2900 IF LI+K=20 AND NOT SYSOP THEN A$="Messege full.":GOSUB 1400:GOTO 2920
  267. 2910 GOTO 2840
  268. 2920 FOR X=1 TO K+1:A$(LI+X-1)=C$(X):NEXT:LI=W+LI-L
  269. 2930 ERASE C$ : GOTO 2300
  270. 3000            'List Lines --------------------------------------------------
  271. 3010 GOSUB 1400:GOSUB 3200
  272. 3020 FOR X=1 TO LI:A$="   "+STR$(X)+": "+A$(X):IF X<10 THEN A$=" "+A$
  273. 3030 GOSUB 1400:NEXT:GOSUB 1400:GOTO 2300
  274. 3100            'Set Right Margin --------------------------------------------
  275. 3110 GOSUB 1400:IF Q<>1 THEN B$(1)=B$(Q):GOTO 3130
  276. 3120 A$="Set Right-Margin to (8,16,24,32,40,48,56,64) ":GOSUB 1500
  277. 3130 FOR X=8 TO 64 STEP 8:IF VAL(B$(1))=X THEN 3150 ELSE NEXT
  278. 3140 A$="Invalid - Margin remains at"+STR$(MARGIN):GOSUB 1400:GOTO 3160
  279. 3150 MARGIN=VAL(B$(1)):A$="Margin now set to"+STR$(MARGIN):GOSUB 1400
  280. 3160 IF BEGIN THEN 2218 ELSE 2300
  281. 3200            'Print Tab Settings ------------------------------------------
  282. 3210 GOSUB 1400:A$=TB$+"!" : CR=1 : GOSUB 1400
  283. 3220 FOR X=8 TO MARGIN STEP 8:A$="-------!":CR=1:GOSUB 1400:NEXT:GOSUB 1400:RETURN
  284. 3300            'Test Line Number --------------------------------------------
  285. 3310 A$="Line #":GOSUB 1500:L=VAL(B$(1)):'PRINT B$(1)
  286. 3320 IF L=>1 AND L=<LI THEN RETURN
  287. 3330 IF Q=0 THEN RETURN 2300
  288. 3340 IF ASC(B$(1))<49 AND ASC(B$(1))>57 THEN RETURN 1200
  289. 3350 A$="No such line, "+FIRST$:GOSUB 1400:GOTO 2300
  290. 3400            'Save Messege ------------------------------------------------
  291. 3410 GOSUB 1400:A$="Updating Msg file.":CR=1:GOSUB 1400
  292. 3420 CLOSE #2:OPEN "O",#2,"LASTCALR" : LASTM=LASTM+1 : LASTR=LASTR+1
  293. 3430 WRITE #2,NAM$,D$,TI$,STATUS,CALLN : CLOSE #2
  294. 3440            '
  295. 3450 REC=0:N$=""
  296. 3460 MNUM$=STR$(LASTM)+SPACE$(5-LEN(STR$(LASTM)))'1-5
  297. 3470 FROM$=NAM$+SPACE$(31-LEN(NAM$))             '6-36
  298. 3480 T$=T$+SPACE$(31-LEN(T$))                    '37-67
  299. 3490 SUB$=SUB$+SPACE$(25-LEN(SUB$))              '76-100
  300. 3500 PAS$=PAS$+SPACE$(15-LEN(PAS$))              '101-115
  301. 3510 FOR J=1 TO LI:A$(J)=A$(J)+CHR$(227):REC=REC+LEN(A$(J)):NEXT J
  302. 3520 IF REC MOD 128=0 THEN N$=STR$(REC\128+1) ELSE N$=STR$(REC\128+2)
  303. 3530 CLOSE #1:OPEN "R",#1,"MESSAGES" : FIELD #1,128 AS R$
  304. 3540 GET 1,LOF(1)/128 : M(LASTR,1)=LOC(1)+1 : M(LASTR,2)=LASTM
  305. 3550 M(LASTR,1)=LOC(1)+1 : M(LASTR,2)=LASTM
  306. 3560 LSET R$=MNUM$+FROM$+T$+D$+SUB$+PAS$+CHR$(225)+N$ : PUT 1
  307. 3600            'Pack Disk Record --------------------------------------------
  308. 3610 FOR J=1 TO LI:A$=".":CR=1:GOSUB 1400
  309. 3620 FOR K=1 TO LEN(A$(J))
  310. 3630 E$=E$+MID$(A$(J),K,1)
  311. 3640 IF LEN(E$)>127 THEN LSET R$=E$:PUT 1:E$=""
  312. 3650 NEXT K
  313. 3660 NEXT J
  314. 3670 LSET R$=E$:PUT 1:E$=""
  315. 3680 ERASE A$:RETURN
  316. 3700           'Word Processor -----------------------------------------------
  317. 3710 COL=COL+1:IF LOCAL THEN X$=INPUT$(1) ELSE X$=INPUT$(1,3)
  318. 3720 IF X$=CHR$(8) THEN 3850 ELSE IF X$=CHR$(9) THEN P=POS(0)
  319. 3730 A$=X$ : CR=1 : GOSUB 1400 : IF X$=CHR$(9) THEN COL=COL+(POS(0)-P)
  320. 3740 IF X$=CHR$(13) THEN 3840
  321. 3750 IF COL>MARGIN-3 AND X$=CHR$(32) THEN GOSUB 1400:GOTO 3840
  322. 3760 R$=R$+X$
  323. 3770 IF COL<MARGIN+1 THEN 3710
  324. 3780 IF X$=CHR$(32) THEN GOSUB 1400:GOTO 3840
  325. 3790 Z=MARGIN+1
  326. 3800 WHILE (MID$(R$,Z,1)<>" " AND MID$(R$,Z,1)<>"" AND MID$(R$,Z,1)<>CHR$(9))
  327. 3810 Z=Z-1:IF Z>0 THEN WEND ELSE GOSUB 1400:GOTO 3840
  328. 3820 COL=MARGIN+1-Z : PRINT STRING$(COL,29)+STRING$(COL,0);
  329. 3825 IF NOT LOCAL THEN PRINT #3,STRING$(COL,8)+STRING$(COL,32);
  330. 3830 A$(LI)=LEFT$(R$,Z):A$(LI+1)=RIGHT$(R$,COL):GOSUB 1400:RETURN
  331. 3840 A$(LI)=A$(LI)+R$:COL=0:RETURN
  332. 3850 COL=COL-2:R$=LEFT$(R$,LEN(R$)-1)
  333. 3860 PRINT BK1$; : IF NOT LOCAL THEN PRINT #3,BK$;
  334. 3870 GOTO 3710
  335. 3900            'Kill A Message ---------------------------------------------
  336. 3905 GOSUB 1400
  337. 3910 IF Q<>1 THEN MM=VAL(B$(Q)):GOTO 3930
  338. 3920 A$="Msg # to Kill":GOSUB 1500:MM=VAL(B$(Q)):GOSUB 1400
  339. 3926 IF MM=0 THEN RETURN
  340. 3930 FOR Q=1 TO LASTR : IF M(Q,2)=MM THEN 3950 ELSE NEXT
  341. 3940 A$="No Msg # "+STR$(MM):GOSUB 1400:RETURN 1200
  342. 3950 GET 1,M(Q,1) : R=VAL(MID$(R$,118)) : IF SYSOP THEN 4030
  343. 3960 Z=15:Z$=MID$(R$,101,15) : GOSUB 8100 : PAS$=Z$
  344. 3990 IF PAS$="^READ^" THEN IF INSTR(R$,NAM$) THEN 4030 ELSE 4020
  345. 4000 A$="Password":GOSUB 1500
  346. 4010 IF B$(1)=PAS$ THEN 4030
  347. 4020 A$="Sorry Buckwheat, you lose.":GOSUB 1400:RETURN 1200
  348. 4030 LSET R$=LEFT$(R$,115)+CHR$(226)+MID$(R$,117) : PUT 1,LOC(1)
  349. 4040 IF Q>1 THEN GET 1,M(Q-1,1)
  350. 4050 M(Q,1)=VAL(MID$(STR$(VAL(MID$(R$,118))+R),2)) : LASTR=LASTR-1
  351. 4060 FOR Q=Q TO LASTR:M(Q,1)=M(Q+1,1):M(Q,2)=M(Q+1,2):NEXT
  352. 4070 FIRSTM=M(1,2) : LASTM=M(LASTR,2)
  353. 4080 A$="Msg # "+STR$(MM)+" Killed.":GOSUB 1390:RETURN 1200
  354. 4100            'Toggle Line Feeds --------------------------------------------
  355. 4110 GOSUB 1400:LF=NOT LF
  356. 4120 A$="Line Feeds ":IF LF THEN A$=A$+"On" ELSE A$=A$+"Off"
  357. 4130 GOSUB 1400:RETURN
  358. 4150            'Toggle Bell --------------------------------------------------
  359. 4160 GOSUB 1400:BELL=NOT BELL
  360. 4170 A$="Prompting Bell ":IF BELL THEN A$=A$+"On" ELSE A$=A$+"Off"
  361. 4180 GOSUB 1400:RETURN
  362. 4200            'Toggle Expert ------------------------------------------------
  363. 4210 GOSUB 1400:XPR=NOT XPR
  364. 220 IF XPR THEN A$="Expert Mode" ELSE A$="Novice Mode"
  365. 4230 GOSUB 1400:RETURN
  366. 4300            'Quick Scan & Summary & Retrieval -----------------------------
  367. 4310 QU=-1:RT=0 :SU=0:GOTO 4340 'Quick Scan Entry Point
  368. 4320 QU=0 :RT=-1:SU=0:GOTO 4340 'Retreival  Entry Point
  369. 4330 QU=0 :RT=0 :SU=-1          'Summarize  Entry Point
  370. 4340 FOW=0:REV=0:RP=0 'Forward Flag, Reverse Flag, Read Protect Flag
  371. 4350 IF Q<>1 THEN MM=VAL(B$(Q)):GOTO 4390
  372. 4360 A$="Msg #  ("+STR$(FIRSTM)+" to"+STR$(LASTM)+" )":IF XPR THEN 4380
  373. 4370 IF RT THEN A$=A$+" to Retreive ( C/R to end)" ELSE A$="Starting at "+A$
  374. 4380 GOSUB 1500:MM=VAL(B$(1))
  375. 4390 IF VAL(B$(Q))=0 THEN RETURN 1200 ELSE GOSUB 1400
  376. 4400 IF RIGHT$(B$(Q),1)="+" THEN FOW=-1
  377. 4410 IF RIGHT$(B$(Q),1)="-" THEN REV=-1:GOTO 4460
  378. 4420 FOR Q=1 TO LASTR
  379. 4430 IF RT AND M(Q,2)=MM THEN 4490
  380. 4440 IF ( (RT AND FOW) OR QU OR SU) AND M(Q,2)=>MM THEN 4490
  381. 4450 NEXT : PRINT "No Msg # "+STR$(MM):RETURN 1200
  382. 4460 FOR Q=LASTR TO 1 STEP -1
  383. 4470 IF M(Q,2)<=MM THEN 4510
  384. 4480 NEXT : A$="No Msg # "+STR$(MM):GOSUB 1400:RETURN 1200
  385. 4490 IF FOW THEN 4500 ELSE IF RT THEN 4530
  386. 4500 QQ=Q : QQQ=LASTR : QQQQ=1 : GOTO 4520
  387. 4510 QQ=Q : QQQ=1     : QQQQ=-1
  388. 4520 FOR Q=QQ TO QQQ STEP QQQQ
  389. 4530 GET 1,M(Q,1)
  390. 4535 IF NOT SYSOP THEN IF INSTR(R$,"^READ^")>0 AND INSTR(R$,NAM$)=0 THEN 4590
  391. 4537 IF QU THEN Z$=MID$(R$,76,25):Z=25:GOSUB 8100
  392. 4540 IF QU THEN A$=STR$(M(Q,2))+"  "+Z$:GOSUB 1400:GOTO 4570
  393. 4550 GOSUB 8000:IF SU THEN 4570
  394. 4560 GOSUB 9000:IF RT AND (NOT FOW AND NOT REV) THEN Q=1:GOTO 4340
  395. 4570 NEXT Q
  396. 4580 GOSUB 1400:A$="End of Msgs.":GOSUB 1400:RETURN 1200
  397. 4590 IF FOW OR REV OR SU OR QU THEN 4570
  398. 4600 A$="Sorry, "+FIRST$+".  Msg #"+STR$(MM)+" is read protected."
  399. 4610 GOSUB 1400:Q=0:GOTO 4340
  400. 4700            'Y Chat -------------------------------------------------------
  401. 4710 GOSUB 1400 : A$="Chat... Remote Conversation Utility." : CR=2 : GOSUB 1400
  402. 4720 A$="Program returns to command level within" : GOSUB 1400
  403. 4730 A$="30 seconds if operator is unavailable" : CR=2 : GOSUB 1400
  404. 4740 K=0 : A$="Alerting operator now" : CR=1 : GOSUB 1400
  405. 4750 FOR I=1 TO 20
  406. 4760 FOR J=1 TO 500 : NEXT J
  407. 4770 K=K+1 : IF INKEY$=CHR$(27) THEN 4830
  408. 4780 IF K MOD 2 THEN A$=CHR$(7) : CR=1 : GOSUB 1400
  409. 4790 A$=". " : CR=1 : GOSUB 1400 : NEXT I : GOSUB 1400
  410. 4800 A$="Sorry "+FIRST$+", no operator available." : GOSUB 1400
  411. 4810 A$="Please leave a message on the board or in the comments."
  412. 4820 GOSUB 1400 : RETURN
  413. 4830 GOSUB 1400 : A$="Operator is available." : GOSUB 1400
  414. 4840 A$="Go ahead..." : CR=2 : GOSUB 1400
  415. 4850 WHILE EOF(3) : A$=INKEY$
  416. 4860 IF A$=CHR$(8) THEN 4895 ELSE IF A$=CHR$(27) THEN RETURN 1200
  417. 4870 IF A$<>"" THEN CR=1 : GOSUB 1400 : GOTO 4850
  418. 4880 WEND : A$=INPUT$(1,#3) : IF A$=CHR$(8) THEN 4895
  419. 4890 CR=1 : GOSUB 1400 : GOTO 4850
  420. 4895 IF POS(0)>1 THEN PRINT BK1$; : PRINT #3,BK$;
  421. 4897 GOTO 4850
  422. 4900            '# Counters ---------------------------------------------------
  423. 4910 GOSUB 1400
  424. 4920 A$="     You are caller #   -->"+STR$(CALLN):GOSUB 1400
  425. 4930 A$="     # of Active msgs   -->"+STR$(LASTR):GOSUB 1400
  426. 4940 A$="     Next msg # will be -->"+STR$(LASTM+1):GOSUB 1400:RETURN
  427. 5000            'Convert Lower Case to Upper Case -----------------------------
  428. 5010 FOR Z=1 TO LEN(Z$)
  429. 5020 MID$(Z$,Z,1)=CHR$(ASC(MID$(Z$,Z,1))+32*(ASC(MID$(Z$,Z,1))>96))
  430. 5030 NEXT Z : RETURN
  431. 6000            'Common Routine to Print  A File ------------------------------
  432. 6010 OPEN "I",#2,FILE$
  433. 6020 IF EOF(2) THEN CLOSE #2:RETURN
  434. 6030 LINE INPUT #2,A$:GOSUB 1400:GOTO 6020
  435. 7000            'Common Routine To Test Fields --------------------------------
  436. 7010 GET 1,R : RR=VAL(MID$(R$,118))
  437. 7020 IF RR<1 THEN DONE=-1:RETURN
  438. 7030 R=R+RR
  439. 7040 IF INSTR(MID$(R$,X,Y),F$) THEN RETURN
  440. 7050 GOTO 7010
  441. 8000           'Process Message Header ----------------------------------------
  442. 8005 GOSUB 1400
  443. 8010 IF MID$(R$,37,3)="ALL" THEN T$="ALL":GOTO 8030
  444. 8020 Z=31 : Z$=MID$(R$,37,31) : GOSUB 8100 : T$=Z$
  445. 8030 Z=25 : Z$=MID$(R$,76,25) : GOSUB 8100 : SUB$=Z$
  446. 8040 Z=31 : Z$=MID$(R$, 6,31) : GOSUB 8100 : FROM$=Z$
  447. 8050 A$="Msg # "+LEFT$(R$,5)+" Dated "+MID$(R$,68,8)+" From : "+FROM$
  448. 8060 GOSUB 1400 : A$="To: "+T$ : GOSUB 1400
  449. 8070 A$="Re: "+SUB$ : GOSUB 1400 : RETURN
  450. 8099            'Remove Spaces That Pad Msg Header
  451. 8100 WHILE MID$(Z$,Z,1)=" ":Z=Z-1:WEND : Z$=LEFT$(Z$,Z) : RETURN
  452. 9000           'Unpack Disk Record --------------------------------------------
  453. 9005 GOSUB 1400
  454. 9010 FOR X=1 TO VAL(MID$(R$,118))-1
  455. 9020 EOL=0 : A=0 : B=0 : C=0
  456. 9030 GET 1 : A=INSTR(R$,CHR$(227)) : A$=LEFT$(R$,A-1) : GOSUB 1400
  457. 9040 B=INSTR(A+1,R$,CHR$(227))
  458. 9050 C=B-(A+1) : IF C<1 THEN C=50:EOL=-1 '50 insures all rightmost characters
  459. 060 A$=MID$(R$,A+1,C) : IF EOL THEN 9080
  460. 9070 GOSUB 1400 : A=B : GOTO 9040
  461. 9080 CR=1 : GOSUB 1400 : NEXT : GOSUB 1400 : RETURN
  462. 10000            'Sysop's Utilities -------------------------------------------
  463. 10010 A$="Sysop's Utilities :":GOSUB 1400
  464. 10020 A$="  $  Type Comments":GOSUB 1400
  465. 10030 A$="  %  Type Callers":GOSUB 1400
  466. 10040 A$="  ^  Purge File":GOSUB 1400
  467. 10050 A$="  &  Renumber file":GOSUB 1400
  468. 10060 A$="  *  Resurrect a Msg":GOSUB 1400
  469. 10070 A$="  (  Print Msg Headers":CR=2:GOSUB 1400:RETURN
  470. 10100            '$ -----------------------------------------------------------
  471. 10110 FILE$="COMMENTS":GOSUB 6000:RETURN
  472. 10120            '% -----------------------------------------------------------
  473. 10130 FILE$="CALLERS":GOSUB 6000:RETURN
  474. 10200            'Purge -------------------------------------------------------
  475. 10210 CLOSE :NAME "MESSAGES" AS "MESSAGES.BAK" : Q=0 : B=0
  476. 10220 OPEN "R",#1,"MESSAGES.BAK":FIELD #1,128 AS R$
  477. 10230 OPEN "R",#2,"MESSAGES"    :FIELD #2,128 AS RR$
  478. 10240 GET 1
  479. 10250 IF INSTR(R$,CHR$(225))>0 THEN 10300
  480. 10260 IF INSTR(R$,CHR$(227))>0 THEN 10320
  481. 10270 IF INSTR(R$,CHR$(226))>0 THEN 10330
  482. 10280 GOSUB 1400:A$="# of Msgs Purged  :"+STR$(PG):GOSUB 1400
  483. 10285 A$="# of Bytes Purged :"+STR$((LOC(1)*128)-(LOC(2)*128)):GOSUB 1400
  484. 10290 A$="Re-Loading Msg File...":GOSUB 1400:ERASE M:GOSUB 100:RETURN 1200
  485. 10300 A=VAL(MID$(R$,118))
  486. 10310 A$="Msg #"+LEFT$(R$,5)+" copied...":GOSUB 1400
  487. 10320 LSET RR$=R$ : PUT 2 : GOTO 10240
  488. 10330 PG=PG+1 : A$="Msg #"+LEFT$(R$,5)+" purged..." : GOSUB 1400
  489. 10340 GET 1,LOC(1)+VAL(MID$(R$,118)) : GOTO 10250
  490. 10400            'Renumber ----------------------------------------------------
  491. 10450 A$="Renumber starting with OLD msg #":GOSUB 1500:MM=VAL(B$(1))
  492. 10460 IF MM<1 THEN 1450
  493. 10470 A$="Start with NEW #":GOSUB 1500:Y=VAL(B$(1)):YY=Y:IF Y<1 THEN 1460
  494. 10480 FOR Q=1 TO LASTR
  495. 10490 IF M(Q,2)=MM THEN R=M(Q,1) : GOTO 10510
  496. 10500 NEXT : A$="No Msg #"+STR$(MM) : GOSUB 1400 : RETURN
  497. 10510 GET 1,R
  498. 10520 RR=VAL(MID$(R$,118)) : IF RR<1 THEN 10290  'Done
  499. 10530 LSET R$=STR$(Y)+SPACE$(5-LEN(STR$(Y)))+MID$(R$,6)
  500. 10540 PUT 1,LOC(1)
  501. 10550 Y=Y+1 : R=R+RR : GOTO 10510
  502. 10600            'Resurrection ------------------------------------------------
  503. 10610 A$="Msg # to Resurrect":GOSUB 1500:MM=VAL(B$(1)):IF MM<1 THEN 1450
  504. 10620 R=1 : GOSUB 1400
  505. 10630 GET 1,R : RR=VAL(MID$(R$,118))
  506. 10635 IF RR<1 THEN A$="No Msg #"+STR$(MM) :GOSUB 1400 : RETURN
  507. 10640 IF VAL(LEFT$(R$,5))<>MM THEN R=R+RR : GOTO 10630
  508. 10650 IF INSTR(R$,CHR$(226))=0 THEN 10680
  509. 10660 LSET R$=LEFT$(R$,115)+CHR$(225)+MID$(R$,117) : PUT 1,LOC(1)
  510. 10670 A$="Msg #"+STR$(MM)+" is now alive and well." : GOSUB 1400 : GOTO 10290
  511. 10680 A$="Msg #"+STR$(MM)+" is not Dead." : GOSUB 1400 : RETURN
  512. 10800            'Print Msg Header --------------------------------------------
  513. 10810 R=1
  514. 10820 GET 1,R : RR=VAL(MID$(R$,118)) : IF RR<1 THEN RETURN
  515. 10830 A$=R$  : GOSUB 1400 : R=R+RR : GOTO 10820
  516. 12000            'Time -------------------------------------------------------
  517. 12010 GOSUB 1400
  518. 12040  H=VAL(LEFT$(TI$,2))  : M=VAL(MID$(TI$,4,2))  : S=VAL(MID$(TI$,7,2))
  519. 12050 HH=VAL(LEFT$(TIME$,2)):MM=VAL(MID$(TIME$,4,2)):SS=VAL(MID$(TIME$,7,2))
  520. 12060 IF S=<SS THEN SSS=SS-S ELSE SSS=60-(S-SS)
  521. 12070 IF M=<MM THEN MMM=MM-M ELSE MMM=60-(M-MM)
  522. 12080 IF H=<HH THEN HHH=HH-H ELSE HHH=24-(H-HH)
  523. 12090 IF HHH>12 THEN HHH=HHH-12:P$="PM" ELSE P$="AM"
  524. 12100 A$="It is now "+TIME$ : CR=2 : GOSUB 1400
  525. 12110 A$="You have been on for" : CR=1 : GOSUB 1400
  526. 12120 IF HHH>0 THEN A$=STR$(HHH)+" Hours" : CR=1 : GOSUB 1400
  527. 12130 A$=STR$(MMM)+" Minutes and "+STR$(SSS)+" Seconds.":CR=2:GOSUB 1400
  528. 12140 A$="Character count :  WHO CARES ?":CR=2:GOSUB 1400
  529. 12150 A$="Thanks for calling, "+FIRST$ : CR=2 : GOSUB 1400 : CLOSE #2,3
  530. 12160 IF HHH<1 OR SYSOP THEN 12180
  531. 12170 OPEN "A",#2,"LONGCALR":WRITE #2,NAM$,D$,HHH,MMM:CLOSE #2
  532. 12180 IF TRIES>5 THEN 200 ELSE RUN
  533. 12500           'Log-Off Weasels ---------------------------------------------
  534. 12510 GOSUB 1400 : A$="No one likes a wise-guy." : CR=2 : GOSUB 1400
  535. 12520 A$="You are no longer welcome here." : GOSUB 1400 : CLOSE #2,3 : GOTO 200
  536. 12530 GOSUB 1400 : A$="You are a Weasel." : CR=2 : GOSUB 1400 : GOTO 12520
  537. 13000            'Error Trapping ---------------------------------------------
  538. 13010 SOUND 2000,.5
  539. 13020 'PRINT "+++ Error";ERR;"  in line ";ERL
  540. 13025 IF ERL=238  THEN RESUME 238
  541. 13030 IF ERL=1220 THEN RESUME 1230
  542. 13035 IF ERL=1560 THEN CLOSE : RUN
  543. 13040 IF ERL=1840 THEN RESUME 1850
  544. 13060 IF ERL=2030 THEN ERASE A$:RESUME 2030
  545. 13070 IF ERL=2810 THEN ERASE C$:RESUME 2810
  546. 13080 IF ERL=3540 THEN RESUME 3550
  547. 13090 IF ERL=3730 THEN RESUME 3710
  548. 13100 IF ERL=3800 THEN RESUME 3810
  549. 13110 IF ERL=3850 THEN R$="":COL=0:RESUME 3700
  550. 13120 IF ERL=8100 THEN Z$="" : RESUME NEXT
  551. 13130 IF ERR=3    THEN RESUME 1200
  552. 13135 IF ERR=7    THEN RESUME NEXT
  553. 13140 A$="You have located a software bug." : GOSUB 1400
  554. 13150 A$="Please leave a comment or a msg for SYSOP that" : GOSUB 1400
  555. 13160 A$="Error "+STR$(ERR)+" occured in Line "+STR$(ERL) : GOSUB 1400
  556. 13170 A$="Thank You..." : GOSUB 1400 : PRINT : GOTO 1200
  557.