home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / BBSING / BBS / XBBSV23.ARK / XBBSV23.BAS < prev    next >
BASIC Source File  |  1986-09-14  |  25KB  |  493 lines
  1. 10 '          Source code for [XBBS] v2.3  Written By Robert Crump
  2. 20 '   -------------------------------------------------------------------
  3. 30 '    Please send any changes, suggestions, comments (in file form) to:
  4. 40 '           Norhtridge Systems RCP/M - [XBBS] v2.3
  5. 50 '           300/1200 Baud    818-708-3284
  6. 60 '           Sysop: Robert Crump
  7. 70 '   ------------------------------------------------------------------
  8. 80 ' Update history:
  9. 90 '
  10. 100 ' Included scan code by Norman Strassner
  11. 110 ' Removed copywrite. I would still like any changes sent to me, but
  12. 120 ' feel free to add to the source code for your own system.
  13. 130 '                               Robert Crump 01-JAN-85
  14. 140 '
  15. 150 ' Added the Q option for Xmodem.log display.
  16. 160 ' Added the A option for re-scanning of messages.
  17. 170 ' Changed SYSOP log on routine. Plus general code clean-up.
  18. 180 '                               Robert Crump 20-JAN-85
  19. 190 '   -------------------------------------------------------------------
  20. 200 '   You must do 2 things prior to using this program
  21. 210 '      1. Read the documentation completely
  22. 220 '      2. Remove the REMARK from line 320 (USER%)
  23. 230 '
  24. 240 '   This program is to be compiled with Microsofts (tm) Basic Compiler
  25. 250 '   using the O/X/Z switches. L80 link with XBBSUSER.REL
  26. 260 '   ------------------------------------------------------------------
  27. 270 '                  Begin Program
  28. 280 '   ------------------------------------------------------------------
  29. 290 DEFINT A-Z:H$="######":H1$="###":ABT$="++ABORTED++":INV$="Invalid message number..."
  30. 300 ABRT$="Use Ctl-S or S to Pause, Ctl-K or K to Abort"
  31. 310 DIM M$(16),M1$(16)
  32. 320 'USER%=0:CALL USER(USER%):POKE 0,&HCD
  33. 330 SYS1$="YOUR NAME HERE":P1$="ABCDEFG":P2$="ABCDEFGH":P3$="NOPASS":P4$="ABCDEF"
  34. 340 RT=&HFA10:RT1=(RT+1):RT2=(RT+5)
  35. 350 DSK$="A:":ERS$=CHR$(8)+" "+CHR$(8):GOTO 390
  36. 360 Z$=INKEY$:CY$=Z$:GOSUB 1790:Z$=CY$:IF Z$="Y" OR Z$="N" THEN RETURN ELSE 360
  37. 370 Z1$=INKEY$:CY$=Z1$:GOSUB 1790:Z1$=CY$:IF Z1$="C" OR Z1$="R" OR Z1$="N" OR Z1$="H" OR Z1$="?" THEN RETURN ELSE 370
  38. 380 Z2$=INKEY$:CY$=Z2$:GOSUB 1790:Z2$=CY$:IF Z2$="C" OR Z2$="M" OR Z2$="?" OR Z2$="K" OR Z2$="N" OR Z2$="H" THEN RETURN ELSE 380
  39. 390 FOR T9=1 TO 24:PRINT:NEXT T9
  40. 400 ON ERROR GOTO 2140
  41. 410 RFLG=PEEK(RT)
  42. 420 PRINT"YOUR SYSTEM NAME HERE RCP/M - [XBBS] Version 2.3";
  43. 430 OPEN"I",2,DSK$+"DATE. "+CHR$(160):INPUT #2,DT1$:CLOSE #2
  44. 440 IF RFLG<>&H24 THEN 490
  45. 450 FOR I=1 TO 6:C1=PEEK(RT1):PWD$=PWD$+CHR$(C1):RT1=RT1+1:NEXT I
  46. 460 OPEN "I",1,DSK$+"LASTCALR. "+CHR$(160):INPUT #1,NM$:CLOSE #1
  47. 470 IF NM$="SYSOP" THEN O$=NM$:GOTO 480:ELSE I=INSTR(NM$," "):O$=LEFT$(NM$,I-1)
  48. 480 PRINT:PRINT:PRINT"Welcome back to [XBBS], ";O$;".":T2=1:G3=1:GOTO 950
  49. 490 GOSUB 1240
  50. 500 GOSUB 1250
  51. 510 PRINT"Enter your First & Last Name or USER #: ";:C=1:T6=1:GOSUB 1450:N$=B$
  52. 520 IF N$="" THEN 510
  53. 530 CC=LEN(N$)
  54. 540 IF N$=P1$ THEN POKE 4,0:POKE 0,&HC3:SYSTEM
  55. 550 IF N$="SYSOP" THEN C=2:PRINT:PRINT"Password=> ";:GOSUB 1450:N$=B$:ELSE 580
  56. 560 IF N$=P2$ THEN NM$="SYSOP":PWD$=P4$:XPR=NOT XPR:T2=1:DTE$=DT1$:RFLG=&H24:GOTO 940
  57. 570 PRINT:PRINT"YOU ARE NOT THE SYSOP!":SYSTEM
  58. 580 IF ASC(LEFT$(N$,3))<&H40 THEN T=1
  59. 590 I=INSTR(B$,";"):IF I=0 THEN 600 ELSE 510
  60. 600 IF T=1 THEN 610 ELSE I=INSTR(N$," "):IF I=0 THEN 510 ELSE 610
  61. 610 PRINT:PRINT"Checking [XBBS] User File..."
  62. 620 GOSUB 1760:RN=2
  63. 630 GET #1,1:RN2=VAL(UR$):IF RN2<2 THEN RN2=2
  64. 640 IF T=0 GOTO 670
  65. 650 IF T=1 AND RN>1 THEN RN=VAL(B$):RN1=RN:ELSE RN=VAL(B$)
  66. 660 IF VAL(B$)=>RN2 OR VAL(B$)<=1 THEN PRINT"[INVALID USER #]":CLOSE #1:T=0:GOTO 510
  67. 670 GET #1,RN:GOSUB 4530
  68. 680 IF N$=NM$ OR RN1=UN THEN 690 ELSE RN=RN+1:GOTO 670
  69. 690 IF T=1 THEN PRINT:PRINT"Welcome back, ";NM$;".":GOTO 710
  70. 700 PRINT:PRINT"Welcome back, ";NM$;".":PRINT"For fast log on just enter your user number which is #";:PRINT USING H1$;UN;:PRINT "."
  71. 710 T1=0
  72. 720 IF T1=2 THEN PRINT"Too many errors, disconnecting...":SYSTEM:ELSE PRINT"Password=> ";:PRINT CHR$(7);
  73. 730 C=2:GOSUB 1450:N$=B$:IF N$="" THEN CLOSE #1:RN1=0:T=0:GOTO 510
  74. 740 IF PWD$<>N$ THEN T1=T1+1:GOTO 720:ELSE 890
  75. 750 IF RFLG=&H24 THEN 4020 ELSE PRINT:PRINT"Are you a new [XBBS] user? <Y/N> ";:GOSUB 360
  76. 760 IF Z$<>"N" THEN PRINT"Yes":GOTO 770:ELSE PRINT"No":PRINT"Ok, let's try again.":CLOSE #1:GOTO 510
  77. 770 T3=1:PRINT:PRINT"Your user number will be #";RN2
  78. 780 UN=RN2:NM$=N$:MH=0
  79. 790 PRINT:PRINT"Enter your City and State: ";:C=1:GOSUB 1450:CT$=B$
  80. 800 IF CT$="" THEN 790
  81. 810 CC=CC+LEN(CT$):IF CC=>30 THEN PRINT:PRINT"Please abbreviate your city and state.":CC=CC-LEN(CT$):CT$="":GOTO 790
  82. 820 PRINT:PRINT"Hello ";NM$;" From ";CT$
  83. 830 PRINT:PRINT"Do you wish to correct this entry? <Y/N>: ";:GOSUB 360
  84. 840 IF Z$<>"N" THEN :PRINT"Yes":CLOSE #1:PRINT:GOTO 510
  85. 850 PRINT"No":GOSUB 1850
  86. 860 RL=63:UR1$=STR$(RN2+1):GOSUB 4640:PUT #1,1
  87. 870 GOSUB 4610:PUT #1,RN:CLOSE #1
  88. 880 FIL$="NEWCOM. ":X=1:GOSUB 2060:GOTO 900
  89. 890 GOSUB 4610:PUT #1,UN:CLOSE #1
  90. 900 PRINT"Logging ";NM$;" to disk..."
  91. 910 OPEN"R",2,DSK$+"CALLERS. "+CHR$(160)+" ",45:FIELD #2,45 AS RR$:GET #2,1:RN=VAL(RR$):IF RN<2 THEN RN=2
  92. 920 RL=45:RR1$=STR$(RN+1):GOSUB 4680:PUT #2,1:RN=RN+1
  93. 930 RR1$=NM$+"~"+CT$+"~":GOSUB 4680:PUT #2,RN:CLOSE #2
  94. 940 OPEN"O",1,DSK$+"LASTCALR. "+CHR$(160):PRINT #1,NM$:CLOSE #1:I=INSTR(NM$," "):O$=LEFT$(NM$,I-1)
  95. 950 GOSUB 3930:GET #1,1:CN=CVI(CAL$)+1:GOSUB 960:M=CVI(MSG$):U=CVI(MNU$):LSET CAL$=MKI$(CN):PUT #1,1:CLOSE #1:GOTO 970
  96. 960 IF N$=P2$ OR G3=1 THEN CN=CN-1:RETURN ELSE RETURN
  97. 970 FOR I=1 TO 4:PRINT:NEXT I
  98. 980 PRINT"         [XBBS]"
  99. 990 PRINT"You are caller number: ";:PRINT USING H$;CN
  100. 1000 PRINT"Number of active msgs: ";:PRINT USING H$;M
  101. 1010 PRINT"Highest system msg. #: ";:PRINT USING H$;U
  102. 1020 IF MH<U AND MH<>0 THEN PRINT"High msg. # retrieved: ";:PRINT USING H$;MH
  103. 1030 PRINT:PRINT"Today's date is:  ";DT1$
  104. 1040 IF T2=1 OR T3=1 THEN 1060
  105. 1050 PRINT"You were last on: ";DTE$
  106. 1060 PRINT"Message numbers for you...":GOSUB 1920
  107. 1070 IF T2=1 OR T3=1 THEN 1090
  108. 1080 '**********MAIN COMMAND DISPATCHER*************
  109. 1090 B$="":SAV$="":G=0:T6=0:IF XPR THEN PRINT:PRINT"[COMMAND]: ";:C=1:GOSUB 1450:GOTO 1120:ELSE 1100
  110. 1100 PRINT"[XBBS]"
  111. 1110 PRINT"A,B,E,R,S,K,G,I,C,X (OR <H>ELP): ";:C=1:GOSUB 1450
  112. 1120 IF B$="" THEN 1090
  113. 1130 FF=INSTR("ABERH?SKGICX",B$):GOSUB 1140:GOTO 1090
  114. 1140 IF FF=0 THEN 1160
  115. 1150 ON FF GOTO 950,1250,2220,3290,1260,1260,2990,3720,1270,1240,1310,1230
  116. 1160 IF NM$<>"SYSOP" THEN 1220
  117. 1170 IF B$="L" THEN 4030
  118. 1180 IF B$="Z" THEN 4340
  119. 1190 IF B$="D" THEN 1890
  120. 1200 IF B$="P" THEN 3940
  121. 1210 IF B$="Q" THEN 4870
  122. 1220 PRINT"There is no '";B$+"', ";O$+".":SAV$="":RETURN
  123. 1230 XPR=NOT XPR:GOTO 1090
  124. 1240 FIL$="INFO. ":X=1:GOSUB 2060:RETURN
  125. 1250 FIL$="BULLETIN. ":X=0:GOSUB 2060:RETURN
  126. 1260 FIL$="MENU. ":X=0:GOSUB 2060:GOTO 1090
  127. 1270 IF NM$="SYSOP" THEN NM$=NM$+" ":GOTO 1290:ELSE PRINT:PRINT"Enter comments for the Sysop <Y/N>? ";:GOSUB 360
  128. 1280 IF Z$<>"Y" THEN PRINT"No":GOTO 1290:ELSE PRINT"Yes":GOSUB 4140
  129. 1290 I=INSTR(NM$," "):O$=LEFT$(NM$,I-1)
  130. 1300 PRINT:PRINT O$+", thanks for calling [XBBS]...";:SYSTEM
  131. 1310 '*********EXIT TO CPM**********
  132. 1320 G=RT2:PRINT:T=0:IF NM$="SYSOP" THEN 1410
  133. 1330 IF P3$="NOPASS" THEN 1380
  134. 1340 PRINT"Enter the name of DRI's file copy program.":PRINT
  135. 1350 IF T=2 THEN 1370 ELSE PRINT"Password=> ";:PRINT CHR$(7);:C=2:GOSUB 1440
  136. 1360 IF B$<>P3$ THEN T=T+1:GOTO 1350:ELSE PRINT:GOTO 1380
  137. 1370 PRINT:PRINT"++ACCESS DENIED++":PRINT:GOTO 1080
  138. 1380 PRINT"Enter comments for the Sysop <Y/N>? ";:GOSUB 360
  139. 1390 IF Z$<>"Y" THEN PRINT"No":GOTO 1400:ELSE PRINT"Yes":PRINT:GOSUB 4140
  140. 1400 IF XPR THEN 1410 ELSE PRINT:FIL$="ENTERCPM. ":X=0:GOSUB 2060
  141. 1410 FOR I=1 TO LEN(PWD$):POKE G,ASC(RIGHT$(PWD$,I)):G=G-1:NEXT I
  142. 1420 PRINT"Exiting [XBBS] and Entering CP/M":PRINT
  143. 1430 POKE RT,&H24:POKE 4,0:POKE 0,&HC3:SYSTEM
  144. 1440 '******ACCECPT A STRING INTO B$******
  145. 1450 B$=""
  146. 1460 IF SAV$="" THEN GOSUB 1550:IF C<>3 THEN PRINT
  147. 1470 IF T6=1 THEN 1490 ELSE SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 1500
  148. 1480 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1):GOTO 1500
  149. 1490 B$=SAV$:SAV$="":GOTO 1510
  150. 1500 IF LEN(B$)=0 THEN C=0:RETURN
  151. 1510 IF C=0 THEN 1530
  152. 1520 CY$=B$:GOSUB 1800:B$=CY$
  153. 1530 C=0:RETURN
  154. 1540 '******************************
  155. 1550 CHC=0:SAV$="":DC=0
  156. 1560 NCH=ASC(INPUT$(1))
  157. 1570 IF NCH=13 THEN RETURN
  158. 1580 IF NCH=127 THEN NCH=8:GOTO 1670
  159. 1590 IF NCH<32 THEN 1670
  160. 1600 IF CHC>=62 THEN PRINT CHR$(7);:GOTO 1560
  161. 1610 SAV$=SAV$+CHR$(NCH):CHC=CHC+1
  162. 1620 IF DC THEN PRINT CHR$(10);
  163. 1630 IF C<>2 THEN PRINT CHR$(NCH); ELSE PRINT CHR$(35);
  164. 1640 IF CHC=58 THEN PRINT CHR$(7);
  165. 1650 DC=0:GOTO 1560
  166. 1660 CHC=CHC-1:SAV$=LEFT$(SAV$,CHC):GOTO 1560
  167. 1670 IF CHC=0 THEN 1560
  168. 1680 IF NCH=8 THEN PRINT ERS$;:DC=0:GOTO 1660
  169. 1690 IF NCH<>24 THEN 1560
  170. 1700 GOSUB 1720
  171. 1710 GOTO 1550
  172. 1720 FOR BCC=1 TO CHC:PRINT ERS$;:NEXT BCC:RETURN
  173. 1730 IF C<>2 THEN PRINT SAV$;
  174. 1740 DC=0:GOTO 1560
  175. 1750 '**********************************
  176. 1760 OPEN"R",#1,DSK$+"USERS. "+CHR$(160)+" ",64
  177. 1770 FIELD#1,64 AS UR$
  178. 1780 RETURN
  179. 1790 '**********************************
  180. 1800 FOR ZZ=1 TO LEN(CY$)
  181. 1810 ZA=ASC(MID$(CY$,ZZ,1)):IF ZA<&H61 OR ZA>&H7A THEN 1830
  182. 1820 MID$(CY$,ZZ,1)=CHR$(ZA-&H20)
  183. 1830 NEXT ZZ
  184. 1840 RETURN
  185. 1850 '******NEW USER PASSWORD*******
  186. 1860 PRINT:PRINT"Enter 6 (ONLY) alphanumeric characters for your password.":PRINT:PRINT"Your password=> ";:C=2:GOSUB 1450
  187. 1870 IF B$="" OR LEN(B$)<6 OR LEN(B$)>6 THEN 1860 ELSE PWD$=B$:PRINT"Enter it again: ";:C=2:GOSUB 1450:PAS$=B$
  188. 1880 IF PWD$<>PAS$ THEN PRINT"No match, try again.":GOTO 1860:ELSE RETURN
  189. 1890 '************SYSOP DATE LOADER******************
  190. 1900 PRINT:PRINT"Enter today's date [DD-MMM-YY]: ";:GOSUB 1450
  191. 1910 IF B$="" THEN RETURN ELSE OPEN"O",#2,DSK$+"DATE. "+CHR$(160):PRINT #2,B$:CLOSE #2:RETURN
  192. 1920 '*******INITIAL SUMMARY SEARCH*******
  193. 1930 GOSUB 3900
  194. 1940 SR=2:SR1=0
  195. 1950 GET #1,SR:SU$=SUN$:SM=VAL(SUM$)
  196. 1960 I=INSTR(SU$,"~"):SU$=LEFT$(SU$,I-1)
  197. 1970 IF SM=0 THEN SR=SR+1:GOTO 1950
  198. 1980 IF T4=1 THEN 1990 ELSE SC=SM:T4=1
  199. 1990 IF SU$="SYSOP" AND NM$=SYS1$ OR SU$=SYS1$ AND NM$="SYSOP" THEN 2010 ELSE 2000
  200. 2000 IF SU$<>NM$ THEN SR=SR+1:GOTO 1950:ELSE 2010
  201. 2010 PRINT SM;:SR=SR+1:SR1=SR1+1:GOTO 1950
  202. 2020 IF SR1=0 THEN 2050 ELSE 2030
  203. 2030 IF SR1=1 THEN PRINT:PRINT"Please retrieve and kill this message...":CLOSE #1:PRINT:GOTO 1090
  204. 2040 IF SR1=>2 THEN PRINT:PRINT"Please retrieve and kill these messages...":CLOSE #1:PRINT:GOTO 1090
  205. 2050 CLOSE #1:PRINT"Sorry, there are none today.":PRINT:GOTO 1090
  206. 2060 '*******FILE PRINT SECTION********
  207. 2070 OPEN"I",2,DSK$+FIL$:COUNT=0
  208. 2080 IF X THEN 2090 ELSE PRINT:PRINT ABRT$
  209. 2090 COUNT=COUNT+1:IF EOF(2) THEN 2130 ELSE LINE INPUT#2,A$:IF COUNT=21 THEN GOSUB 4780:IF Z$="N" THEN 2130 ELSE 2100
  210. 2100 IF X THEN PRINT A$:GOTO 2090
  211. 2110 FOR J3=1 TO LEN(A$):PRINT MID$(A$,J3,1);:GOSUB 4840
  212. 2120 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN GOSUB 4820:GOTO 2130:ELSE NEXT J3:PRINT:GOTO 2090
  213. 2130 CLOSE #2:PRINT:RETURN
  214. 2140 '*****ON ERROR TRAPPING*****
  215. 2150 IF ERL=1960 THEN RESUME 2020
  216. 2160 IF ERL=2070 THEN RESUME 4510
  217. 2170 IF ERL=3360 THEN RESUME 3710
  218. 2180 IF ERL=3070 THEN RESUME 3280
  219. 2190 IF ERL=4080 THEN RESUME 4120
  220. 2200 IF ERL=4540 THEN RESUME 750
  221. 2210 RESUME NEXT
  222. 2220 '******MESSAGE STORAGE*******
  223. 2230 T6=1:GOSUB 3930:GET #1,1:EM=CVI(MNU$)+1:PRINT "Message #";EM
  224. 2240 PRINT"To: (Or <CR> For All): ";:C=1:GOSUB 1450:A$=B$
  225. 2250 IF A$="" THEN A$="ALL"
  226. 2260 PRINT"<CR> TO ABORT"
  227. 2270 PRINT"Subject: ";:C=0:GOSUB 1450:C$=B$
  228. 2280 IF LEN(C$)>20 THEN PRINT:PRINT"Subject length too long, 20 characters max.":C$="":PRINT:GOTO 2260
  229. 2290 IF C$="" THEN CLOSE 1:GOSUB 4820:GOTO 1090
  230. 2300 IF A$="ALL" THEN PV$="PUBLIC":GOTO 2320:ELSE PRINT"Private <Y/N>: ";:GOSUB 360
  231. 2310 IF Z$<>"Y" THEN PV$="PUBLIC":PRINT"No":ELSE PV$="PRIVATE":PRINT"Yes"
  232. 2320 FOR T9=1 TO 24:PRINT:NEXT T9:PRINT"Msg.#";EM;"   Date: ";DT1$
  233. 2330 PRINT"To: ";A$
  234. 2340 PRINT"Subject: ";C$
  235. 2350 PRINT"Message is ";PV$;"."
  236. 2360 PRINT:PRINT"Enter up to 16 lines of text. Simicolons are accepted."
  237. 2370 PRINT"When finished, hit 2 returns in a row.
  238. 2380 PRINT"The  . =5 characters left."
  239. 2390 F=0:GOSUB 4810
  240. 2400 IF F=16 THEN PRINT"Message full.":GOTO 2480
  241. 2410 F=F+1
  242. 2420 IF F=15 THEN PRINT"(2 Lines left)"
  243. 2430 IF F=16 THEN PRINT"(Last line)"
  244. 2440 PRINT USING H1$;F;:PRINT "> ";
  245. 2450 GOSUB 1450:M$(F)=B$
  246. 2460 IF B$="" THEN F=F-1:IF F=0 THEN 2530 ELSE 2480
  247. 2470 GOTO 2400
  248. 2480 IF XPR THEN PRINT:PRINT"H,L,E,A,C,S: ";:C=1:GOSUB 1450:GOTO 2500
  249. 2490 PRINT:PRINT"SELECT: <H>eader, <L>ist, <E>dit, <A>bort, <C>ontinue, <S>ave: ";:C=1:GOSUB 1450
  250. 2500 IF B$="" THEN 2480
  251. 2510 FF=INSTR("HLEACS",B$):IF FF=0 THEN 2480
  252. 2520 ON FF GOTO 2630,2540,2700,2530,2400,2780
  253. 2530 CLOSE #1:GOSUB 4820:GOTO 1090
  254. 2540 '******MESSAGE LIST SECTION*******
  255. 2550 PRINT:PRINT"Msg #";EM;"   Date: ";DT1$
  256. 2560 PRINT"To: ";A$
  257. 2570 PRINT"Subject: ";C$
  258. 2580 PRINT"Message is ";PV$;".":PRINT
  259. 2590 FOR I=1 TO F
  260. 2600 PRINT USING H1$;I;:PRINT ": ";M$(I)
  261. 2610 NEXT I
  262. 2620 GOTO 2480
  263. 2630 '******HEADER CHANGE*******
  264. 2640 PRINT"Enter Replacement (Or <CR> for NO Change.)":PRINT"To: ";A$
  265. 2650 PRINT"TO: ";:C=1:GOSUB 1450:IF B$<>"" THEN A$=B$:GOTO 2660:ELSE A$=A$:GOTO 2680
  266. 2660 IF A$="ALL" THEN PV$="PUBLIC":GOTO 2680:ELSE PRINT"Private <Y/N>?: ";:GOSUB 1450
  267. 2670 IF B$<>"Y" THEN PV$="PUBLIC" ELSE PV$="PRIVATE"
  268. 2680 PRINT"Subject: ";C$
  269. 2690 PRINT"Subject: ";:C=0:GOSUB 1450:IF B$<>"" THEN C$=B$:GOTO 2480:ELSE C$=C$:GOTO 2480
  270. 2700 '******MESSAGE EDIT*******
  271. 2710 PRINT"Line number to change (Or <CR> To End): ";:GOSUB 1450
  272. 2720 F1=VAL(B$):IF F1=0 THEN 2480
  273. 2730 PRINT"Enter Replacement (Or <CR> for NO change)"
  274. 2740 PRINT"Line";F1;"was:"
  275. 2750 PRINT">";:PRINT M$(F1)
  276. 2760 PRINT">";:C=0:GOSUB 1450
  277. 2770 IF B$<>"" THEN M$(F1)=B$:GOTO 2480:ELSE M$(F)=M$(F):GOTO 2480
  278. 2780 '******MESSAGE SAVE******
  279. 2790 PRINT"Updating counters...";
  280. 2800 M=M+1:LSET MSG$=MKI$(M):LSET MNU$=MKI$(EM)
  281. 2810 PUT #1,1:CLOSE #1
  282. 2820 PRINT"Summary...";
  283. 2830 GOSUB 3900
  284. 2840 GET #1,1:SR=VAL(SUN$):IF SR<2 THEN SR=2
  285. 2850 LSET SUN$=STR$(SR+1):PUT #1,1
  286. 2860 LSET SUN$=A$+"~":LSET SUM$=STR$(EM):LSET SPR$=PV$:LSET SUP$=PWD$:LSET SUB$=C$+"~":LSET SFR$=NM$+"~":LSET SDT$=DT1$
  287. 2870 PUT #1,SR:CLOSE #1
  288. 2880 PRINT"Saving msg...";
  289. 2890 GOSUB 3920
  290. 2900 GET #1,1:MR=VAL(RR$):IF MR<2 THEN MR=2
  291. 2910 RR1$=STR$(MR+2+F):GOSUB 4660:PUT #1,1
  292. 2920 CM$=STR$(F)+"~"+PV$+"~"+PWD$+"~"+C$+"~"+DT1$
  293. 2930 CM1$=STR$(EM)+"~"+A$+"~"+NM$+"~"
  294. 2940 RR1$=CM$:GOSUB 4660:PUT #1,MR:MR=MR+1:RR1$=CM1$:GOSUB 4660:PUT #1,MR:MR=MR+1
  295. 2950 FOR I=1 TO F
  296. 2960 RR1$=M$(I):GOSUB 4660:PUT #1,MR:MR=MR+1
  297. 2970 NEXT I
  298. 2980 CLOSE #1:PRINT"Message #";EM;"saved.":PRINT:U=EM:GOTO 1090
  299. 2990 '********MESSAGE SCAN***********
  300. 3000 IF SAV$<>"" THEN 3010 ELSE PRINT:PRINT"Start scan at msg.#";" (";SC;"-";U;")";" or <CR> to quit: ";
  301. 3010 C=1:GOSUB 1450:SR=VAL(B$):IF B$="" THEN PRINT:GOTO 1080
  302. 3020 IF ASC(B$)>&H40 THEN 3000
  303. 3030 IF SR>U THEN PRINT:PRINT INV$:GOTO 3000
  304. 3040 PRINT:PRINT ABRT$:PRINT
  305. 3050 GOSUB 4800:GOSUB 3900:T=0:MR=2
  306. 3060 GET #1,MR:SU$=SUN$:SM=VAL(SUM$):PM$=SPR$:SPD$=SUP$:SUJ$=SUB$:FR$=SFR$:DT2$=SDT$:T=T+1
  307. 3070 I=INSTR(SU$,"~"):SU$=LEFT$(SU$,I-1)
  308. 3080 I=INSTR(FR$,"~"):FR$=LEFT$(FR$,I-1)
  309. 3090 I=INSTR(SUJ$,"~"):SUJ$=LEFT$(SUB$,I-1)
  310. 3100 IF SM=0 THEN MR=MR+1:T=T-1:GOTO 3060
  311. 3110 IF SM<SR THEN MR=MR+1:T=T-1:GOTO 3060
  312. 3120 IF PWD$=P4$ OR NM$=SYS1$ THEN 3140
  313. 3130 IF PWD$<>SPD$ AND NM$<>SU$ AND PM$="PR" THEN MR=MR+1:T=T-1:GOTO 3060
  314. 3140 IF PM$="PR" THEN SUJ$="[PRIVATE]"
  315. 3150 IF LEN(SUJ$)>19 THEN SUJ$=LEFT$(SUJ$,19)
  316. 3160 A$=DT2$+"  "+SU$+STRING$(22-LEN(SU$),32)+FR$+STRING$(22-LEN(FR$),32)+SUJ$
  317. 3170 Z$=MID$(STR$(SM),2):PRINT Z$;STRING$(5-LEN(Z$),32);
  318. 3180 FOR J3=1 TO LEN(A$):PRINT MID$(A$,J3,1);:GOSUB 4840
  319. 3190 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN CLOSE #1:GOSUB 4820:GOTO 1080:ELSE NEXT J3:PRINT
  320. 3200 IF T=19 THEN 3210 ELSE MR=MR+1:GOTO 3060
  321. 3210 PRINT:PRINT"Select: (C,R,N,H) ";:GOSUB 370
  322. 3220 FF=INSTR("CRNH?",Z1$):IF FF=0 THEN 3220
  323. 3230 ON FF GOTO 3240,3250,3260,3270,3270
  324. 3240 PRINT Z1$:PRINT:MR=MR+1:T=0:GOSUB 4800:GOTO 3060
  325. 3250 PRINT Z1$:PRINT:PRINT"Message #? ";:C=1:GOSUB 1450:RE=VAL(B$):MR=2:CLOSE #1:PRINT:GOTO 3330
  326. 3260 PRINT Z1$:GOTO 3280
  327. 3270 PRINT Z1$:FIL$="MSH. ":X=1:GOSUB 2070:GOTO 3210
  328. 3280 CLOSE #1:PRINT:PRINT"End of [XBBS] survey...":PRINT:GOTO 1090
  329. 3290 '*********MESSAGE RETRIEVE**********
  330. 3300 IF SAV$<>"" THEN G=1:GOTO 3310:ELSE PRINT:PRINT"Retrieve from msg.#";" (";SC;"-";U;")";" or <CR> to quit: ";
  331. 3310 G2=0:T6=0:T8=0:C=1:GOSUB 1440:RE=VAL(B$):IF B$="" THEN PRINT:GOTO 1080
  332. 3320 PRINT:PRINT ABRT$;",";" ";"Ctl-X or X to Skip."
  333. 3330 M1=0:IF ASC(B$)>&H40 THEN 3300
  334. 3340 IF RE>U THEN PRINT:PRINT INV$:GOTO 3300
  335. 3350 GOSUB 3920:MR=2:PRINT
  336. 3360 GET #1,MR:I=INSTR(RR$,"~"):LE=VAL(LEFT$(RR$,I-1))
  337. 3370 J=INSTR(I+1,RR$,"~"):PA$=MID$(RR$,I+1,J-I-1)
  338. 3380 J1=INSTR(J+1,RR$,"~"):PA1$=MID$(RR$,J+1,J1-J-1)
  339. 3390 J2=INSTR(J1+1,RR$,"~"):PA2$=MID$(RR$,J1+1,J2-J1-1)
  340. 3400 J3=INSTR(J2+1,RR$," "):PA3$=MID$(RR$,J2+1,J3-J2-1)
  341. 3410 MR=MR+1:GET #1,MR:I=INSTR(RR$,"~"):EM=VAL(LEFT$(RR$,I-1))
  342. 3420 J=INSTR(I+1,RR$,"~"):PA4$=MID$(RR$,I+1,J-I-1)
  343. 3430 J1=INSTR(J+1,RR$,"~"):PA5$=MID$(RR$,J+1,J1-J-1):IF T5=1 THEN 3870 ELSE 3440
  344. 3440 IF EM=>RE THEN 3450 ELSE MR=MR+LE+1:GOTO 3360
  345. 3450 IF PWD$=P4$ OR NM$=SYS1$ THEN 3500 ELSE 3460
  346. 3460 IF PA4$<>NM$ THEN 3470 ELSE 3490
  347. 3470 IF PA$="PUBLIC" THEN 3490 ELSE 3480
  348. 3480 IF PA1$<>PWD$ THEN PRINT EM;+"[Private Message]";:PRINT:PRINT:MR=MR+LE+1:GOTO 3360
  349. 3490 IF T8=1 THEN 3500 ELSE IF MH<EM THEN MH=EM:T8=1:GOTO 3500
  350. 3500 PRINT"Msg.#";EM;"  Date: ";PA3$
  351. 3510 PRINT"To: ";PA4$
  352. 3520 PRINT"From: ";PA5$
  353. 3530 IF PA$="PRIVATE" THEN PA2$=PA2$+" *"
  354. 3540 PRINT"Subject: ";PA2$:PRINT
  355. 3550 MR=MR+1
  356. 3560 GET #1,MR:M1=M1+1
  357. 3570 GOSUB 4700:FOR J3=1 TO LEN(A$):PRINT MID$(A$,J3,1);:GOSUB 4410:NEXT J3:PRINT
  358. 3580 IF M1=LE THEN 3590 ELSE MR=MR+1:GOTO 3560
  359. 3590 PRINT:PRINT"Select: (C,M,K,N,H) ";:GOSUB 380
  360. 3600 FF=INSTR("CMKNH?",Z2$):IF FF=0 THEN 3600
  361. 3610 ON FF GOTO 3620,3630,3660,3680,3700,3700
  362. 3620 PRINT Z2$:MR=MR+1:RE=RE+1:M1=0:T8=0:PRINT:GOTO 3360
  363. 3630 GOSUB 1470:IF LEN(B$)=0 THEN 3650 ELSE 3640
  364. 3640 PRINT Z2$:RE=VAL(B$):MR=MR+1:M1=0:T8=0:PRINT:PRINT:GOTO 3360
  365. 3650 CLOSE #1:PRINT Z2$:PRINT:PRINT"Message number? ";:C=1:GOSUB 1440:IF B$="" THEN 1080 ELSE RE=VAL(B$):M1=0:GOTO 3330
  366. 3660 PRINT Z2$:CLOSE 1:MS=EM:IF T8=1 THEN 3670 ELSE 3760
  367. 3670 GOSUB 4490:GOTO 3760
  368. 3680 PRINT Z2$:M1=0:CLOSE 1:IF T8=1 THEN 3690 ELSE PRINT:PRINT:GOTO 1080
  369. 3690 GOSUB 4490:PRINT:GOTO 1080
  370. 3700 PRINT Z2$:FIL$="MRH. ":X=1:GOSUB 2070:GOTO 3590
  371. 3710 PRINT"End of [XBBS] messages...":PRINT:CLOSE #1:MH=EM:GOSUB 4490:PRINT:GOTO 1080
  372. 3720 '***********MESSAGE KILL*************
  373. 3730 IF SAV$<>"" THEN 3740 ELSE PRINT:PRINT"Message number to kill? ";"(";SC;"-";U;") : ";
  374. 3740 GOSUB 1450:MS=VAL(B$):IF B$="" THEN 1080
  375. 3750 IF MS=0 OR ASC(B$)>&H40 THEN 3730
  376. 3760 GOSUB 3900:SR=2
  377. 3770 GET #1,SR:SM=VAL(SUM$):SU$=SUN$:I=INSTR(SU$,"~"):SU$=LEFT$(SU$,I-1):PA$=SUP$
  378. 3780 IF EOF(1) THEN 3810 ELSE 3790
  379. 3790 IF SM<>MS THEN SR=SR+1:GOTO 3770:ELSE 3820
  380. 3800 PRINT:GOTO 1080
  381. 3810 PRINT:PRINT INV$:CLOSE #1:GOTO 1090
  382. 3820 IF PWD$=P4$ THEN 3850 ELSE 3830
  383. 3830 IF PA$<>PWD$ THEN 3840 ELSE 3850
  384. 3840 IF SU$=NM$ THEN 3850 ELSE PRINT:PRINT"You cannot kill this message...";:CLOSE #1:PRINT:PRINT:GOTO 1090
  385. 3850 LSET SUM$=STR$(0):PUT #1,SR:CLOSE #1
  386. 3860 GOSUB 3920:MR=2:T5=1:GOTO 3360
  387. 3870 IF EM<>MS THEN MR=MR+LE+1:GOTO 3360:ELSE T5=0
  388. 3880 CM1$=" 0"+":"+STR$(EM)+"~"+PA4$+"~"+PA5$+"~":RR1$=CM1$:GOSUB 4660:PUT #1,MR:CLOSE 1
  389. 3890 GOSUB 3930:LSET CAL$=MKI$(CN):M=M-1:LSET MSG$=MKI$(M):LSET MNU$=MKI$(U):PUT #1,1:PRINT:PRINT"Message #";MS;"killed...":CLOSE #1:SAV$="":PRINT:GOTO 1080
  390. 3900 OPEN"R",1,DSK$+"SUMMARY. "+CHR$(160)+" ",92
  391. 3910 FIELD #1,24 AS SUN$,6 AS SUM$,2 AS SPR$,6 AS SUP$,21 AS SUB$,24 AS SFR$,9 AS SDT$:RETURN
  392. 3920 OPEN"R",1,DSK$+"MESSAGES. "+CHR$(160)+" ",64:FIELD #1,64 AS RR$:RETURN
  393. 3930 OPEN"R",1,DSK$+"COUNTERS. "+CHR$(160)+" ",12:FIELD #1,4 AS CAL$,4 AS MSG$,4 AS MNU$:RETURN
  394. 3940 '*************PASSWORD CHANGE***************
  395. 3950 NP$=NM$:GOSUB 1760
  396. 3960 PRINT"Enter Users name: ";:C=1:T6=1:GOSUB 1460:N$=B$:RN=2
  397. 3970 IF B$="" THEN 1080
  398. 3980 I=INSTR(B$,";"):IF I=0 THEN 3990 ELSE 3960
  399. 3990 GET #1,RN:GOSUB 4530
  400. 4000 IF NM$<>N$ THEN RN=RN+1:GOTO 3990
  401. 4010 GOSUB 1860:GOSUB 4610:PUT #1,UN:CLOSE #1:NM$=NP$:GOTO 1080
  402. 4020 PRINT:PRINT"Not a current user...":CLOSE #1:NM$=NP$:GOTO 1080
  403. 4030 '*********CALLER LISTING F/SYSOP*********
  404. 4040 OPEN"R",2,DSK$+"CALLERS. "+CHR$(160)+" ",45:FIELD #2,45 AS RR$:CA=2:LU=CN:PRINT
  405. 4050 GET #2,1:SIZ=VAL(RR$):CA=CN
  406. 4060 FOR I=SIZ TO 2 STEP -1
  407. 4070 GET #2,I
  408. 4080 J=INSTR(RR$,"~"):CL$=LEFT$(RR$,J-1)
  409. 4090 J1=INSTR(J+1,RR$,"~"):LC$=MID$(RR$,J+1,J1-J-1)
  410. 4100 A$=STR$(CA)+" "+CL$+" "+LC$
  411. 4110 GOSUB 4890:CA=CA-1:NEXT I
  412. 4120 CLOSE #2:PRINT"Kill callers file <Y/N>? ";:GOSUB 360
  413. 4130 IF Z$<>"Y" THEN PRINT"No":GOTO 1080:ELSE PRINT"Yes":KILL"CALLERS. ":PRINT:GOTO 1080
  414. 4140 '*******COMMENTS ENTRY SECTION**********
  415. 4150 F=0:PRINT"Enter up to 16 lines of text. When finished enter 2 blank lines."
  416. 4160 PRINT:GOSUB 4810
  417. 4170 IF F=16 THEN PRINT"Message Full..": GOTO 4220
  418. 4180 F=F+1
  419. 4190 PRINT USING H1$;F;:PRINT"> ";:C=0:GOSUB 1440:M1$(F)=B$
  420. 4200 IF B$="" THEN F=F-1:IF F=0 THEN 4270 ELSE 4220
  421. 4210 GOTO 4170
  422. 4220 IF XPR THEN PRINT"S,A: ";:C=1:GOSUB 1440:GOTO 4240
  423. 4230 PRINT"<S>ave, <A>bort: ";:C=1:GOSUB 1440
  424. 4240 IF B$="" THEN 4220
  425. 4250 FF=INSTR("SA",B$):IF FF=0 THEN 4220
  426. 4260 ON FF GOTO 4280,4270
  427. 4270 GOSUB 4820:RETURN
  428. 4280 OPEN"R",1,DSK$+"COMMENTS. "+CHR$(160)+" ",64:FIELD #1,64 AS CO$
  429. 4290 GET #1,1:CR=VAL(CO$):IF CR<2 THEN CR=2
  430. 4300 LSET CO$=STR$(CR+1+F):PUT #1,1
  431. 4310 LSET CO$=NM$+"  "+DT1$+"~":PUT #1,CR:CR=CR+1
  432. 4320 FOR I=1 TO F:LSET CO$=M1$(I):PUT #1,CR:CR=CR+1:NEXT I
  433. 4330 CLOSE #1:PRINT"Comment saved....":PRINT:RETURN
  434. 4340 '************COMMENT LIST SECTION***************
  435. 4350 OPEN"R",1,DSK$+"COMMENTS. "+CHR$(160)+" ",64:FIELD #1,64 AS CO$:LI=2
  436. 4360 GET #1,LI:I=INSTR(CO$,"~"):RR$=CO$:GOSUB 4700:IF I=0 THEN 4370 ELSE PRINT
  437. 4370 IF EOF(1) THEN 4390
  438. 4380 GOSUB 4890:LI=LI+1:GOTO 4360
  439. 4390 CLOSE #1:PRINT:PRINT"Kill comments file <Y/N>? ";:GOSUB 360
  440. 4400 IF Z$<>"Y" THEN PRINT"No":PRINT:GOTO 1080:ELSE PRINT"Yes":KILL"COMMENTS. ":PRINT:GOTO 1080
  441. 4410 '**************MESSAGE CONTROL SECTION*************
  442. 4420 GOSUB 4840:IF BI=&H18 OR BI=&H58 OR BI=&H78 THEN 4440
  443. 4430 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN 4480 ELSE RETURN
  444. 4440 IF G2=1 THEN 4460 ELSE 4450
  445. 4450 IF LEN(SAV$)=>1 THEN G2=1:GOTO 4460:ELSE PRINT:PRINT:PRINT"++SKIP++":MR=MR+(LE-M1)+1:RE=RE+1:M1=0:PRINT:GOTO 3360
  446. 4460 GOSUB 1470:IF LEN(B$)=0 THEN 3650 ELSE 4470
  447. 4470 RE=VAL(B$):MR=MR+(LE-M1)+1:M1=0:PRINT:PRINT:PRINT"++SKIP++":PRINT:GOTO 3360
  448. 4480 GOSUB 4820:CLOSE #1:M1=0:PRINT:GOTO 1090
  449. 4490 '***********HIGH MSG ENTER*************
  450. 4500 IF RFLG=&H24 THEN RETURN ELSE GOSUB 1750:GOSUB 4610:PUT #1,UN:CLOSE #1:RETURN
  451. 4510 '***** ON ERROR CLOSE *****
  452. 4520 CLOSE:PRINT:RETURN
  453. 4530 '***** USER SEPERATOR *****
  454. 4540 I=INSTR(UR$,"~"):UN=VAL(LEFT$(UR$,I-1))
  455. 4550 I1=INSTR(I+1,UR$,"~"):NM$=MID$(UR$,I+1,I1-I-1)
  456. 4560 I2=INSTR(I1+1,UR$,"~"):PWD$=MID$(UR$,I1+1,I2-I1-1)
  457. 4570 I3=INSTR(I2+1,UR$,"~"):DTE$=MID$(UR$,I2+1,I3-I2-1)
  458. 4580 I4=INSTR(I3+1,UR$,"~"):MH=VAL(MID$(UR$,I3+1,I4-I3-1))
  459. 4590 I5=INSTR(I4+1,UR$,"~"):CT$=MID$(UR$,I4+1,I5-I4-1)
  460. 4600 RETURN
  461. 4610 '***** USER FILE LSET *****
  462. 4620 RL=63
  463. 4630 UR1$=STR$(UN)+"~"+NM$+"~"+PWD$+"~"+DT1$+"~"+STR$(MH)+"~"+CT$+"~"
  464. 4640 LSET UR$=LEFT$(UR1$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  465. 4650 RETURN
  466. 4660 '***** MESSAGES FILE LSET *****
  467. 4670 RL=64
  468. 4680 LSET RR$=LEFT$(RR1$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  469. 4690 RETURN
  470. 4700 '**** MESSAGE UNPACKING *****
  471. 4710 ZZ=LEN(RR$)-2
  472. 4720 WHILE MID$(RR$,ZZ,1)=" "
  473. 4730 ZZ=ZZ-1:IF ZZ=1 THEN 4750
  474. 4740 WEND
  475. 4750 A$=LEFT$(RR$,ZZ)
  476. 4760 IF MID$(A$,ZZ,1)="?" THEN A$=A$+" "
  477. 4770 RETURN
  478. 4780 '**** FILE AND SCAN SUBROUTINES *****
  479. 4790 PRINT"More (Y/N)";:GOSUB 360:FOR I=1 TO 11:PRINT ERS$;:NEXT I:RETURN
  480. 4800 PRINT"Msg#| Date:    | To:                 | From:               | Subject:":PRINT:RETURN
  481. 4810 PRINT"     <--------------------MAX LINE LENGTH---------------------.--->":RETURN
  482. 4820 '***** ABORT PRINT SUB *****
  483. 4830 PRINT:PRINT:PRINT ABT$:PRINT:RETURN
  484. 4840 '**** CONTROL ^S CHARACTER TRAP ****
  485. 4850 BI=ASC(INKEY$+" ")
  486. 4860 IF BI=&H13 OR BI=&H53 OR BI=&H73 THEN BI=ASC(INPUT$(1)):GOTO 4850:ELSE RETURN
  487. 4870 '****XMODEM.LOG READ SECTION*****
  488. 4880 FIL$="XMODEM.LOG":X=0:GOSUB 2060:RETURN
  489. 4890 '****MID$ PRINT SECTION****
  490. 4900 FOR J3=1 TO LEN(A$):PRINT MID$(A$,J3,1);:GOSUB 4840:NEXT J3:PRINT:RETURN
  491. 10000 +++"You didn't read the documentation did you?! Read it now"+++
  492. ):PRINT MID$(A$,J3,1);:GOSUB 4840:NEXT J3:PRINT:RETURN
  493. 10000 +++"You didn't read the documentation did you?! Rea