home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols100 / vol112 / rbsutl31.bas < prev    next >
Encoding:
BASIC Source File  |  1994-07-13  |  9.3 KB  |  231 lines
  1. 100 DEFINT A-Z
  2. 120 REM
  3. 140 VERS$="vers 3.1"
  4. 160 REM RBBSUTIL.BAS ==> UTILITY PROGRAM FOR THE RBBS REMOTE BULLETIN BOARD SYS
  5. 180 REM BY RON FOWLER
  6. 200 REM Please report any problems, bugs, fixes, etc. to:
  7. 210 REM Ron Fowler, via "Fort Fone File Folder" (414) 563-7442
  8. 215 REM changed to ver 3.2 to correspond with RBBS and changed:
  9. 216 REM 1. Length check on date for <T>ransferred message
  10. 217 REM 2. Password syntax check (no "*" in msg to "ALL")
  11. 218 REM 3. Program will no longer abort if empty <T>ransfer file
  12. 219 REM 4. Program will inform user if line in <T>ransfer was truncated
  13. 220 REM 5. When run under MBASIC, no more error will be reported
  14. 221 REM    when <CR> is typed at the Command prompt.
  15. 222 REM 6. Message TO: will no longer offer "RETURN for "ALL"', since
  16. 223 REM    this is legal only in MBASIC and will produce an error
  17. 224 REM    message when run in compiled form.
  18. 226 REM
  19. 240 PRINT:PRINT "            RBBS  Utility ";VERS$
  20. 260 ON ERROR GOTO 3620
  21. 280 DIM M(200,2)
  22. 300 SEP$="==============================================="
  23. 320 CRLF$=CHR$(13)+CHR$(10)
  24. 340 PRINT SEP$
  25. 360 PURGED=0:BACKUP=0
  26. 380 GOSUB 3700'REM BUILD MSG INDEX
  27. 400 N$="SYSOP":O$=""
  28. 420 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
  29. 440 PRINT:INPUT "Command? ",PROMPT$
  30. 460 PRINT:PRINT:IF PROMPT$="" THEN 490
  31. 480 B$=MID$(PROMPT$,1,1):GOSUB 1920:SM$=B$:
  32.  
  33.     SM=INSTR ("TFDPEB",SM$)
  34. 490 GOSUB 500:GOTO 440
  35. 500 IF SM=0 THEN 540
  36. 520 ON SM GOTO 980,920,760,2040,700,3320
  37. 540 PRINT:PRINT "Commands allowed are:"
  38. 560 PRINT "B   ==> build summary file from message file."
  39. 580 PRINT "D   ==> display an ascii file"
  40. 600 PRINT "E   ==> end the utility program."
  41. 620 PRINT "F   ==> prints the disk directory."
  42. 640 PRINT "P   ==> purge the message files"
  43. 660 PRINT "T   ==> transfers a disk file to the message file."
  44. 680 RETURN
  45. 700 REM END OF PROGRAM
  46. 720 PRINT:PRINT:END
  47. 740 REM DISPLAY A FILE
  48. 760 FILN$=MID$(PROMPT$,2):
  49.  
  50.     PRINT:IF FILN$="" THEN INPUT "Filename? ",FILN$:PRINT
  51. 780 OPEN "I",1,FILN$
  52. 800 IF EOF(1) THEN 860
  53. 820 IF INKEY$<>"" THEN CLOSE:PRINT:PRINT "++ Aborted ++":PRINT:RETURN
  54. 840 LINE INPUT #1,LIN$:PRINT LIN$:GOTO 800
  55. 860 CLOSE:PRINT:PRINT:PRINT "++ END OF FILE ++":PRINT
  56. 880 RETURN
  57. 900 REM DISPLAY DIRECTORY
  58. 920 IF LEN(PROMPT$)>1 THEN SPEC$=MID$(PROMPT$,2) ELSE SPEC$="*.*"
  59. 940 FILES SPEC$:PRINT:RETURN
  60. 960 REM TRANSFER A DISK FILE
  61. 980 PRINT "Active # of msg's ";:
  62.  
  63.     OPEN "R",1,"COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MSGS:M=VAL(RR$)
  64. 1000 PRINT STR$(M)+"."
  65. 1020 PRINT "Last caller was # ";:GET#1,CALLS:PRINT STR$(VAL(RR$))
  66. 1040 PRINT "This msg # will be ";:GET#1,MNUM:U=VAL(RR$):PRINT STR$(U+1):CLOSE
  67. 1060 REM
  68. 1080 REM ***ENTER A NEW MESSAGE***
  69. 1100 REM
  70. 1120 IF NOT PURGED THEN PRINT 
  71.  
  72.      "Files must be purged before messages can be added":RETURN
  73. 1140 OPEN "R",1,"COUNTERS",5:PRINT "Msg # will be ";:
  74.  
  75.      FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
  76. 1160 PRINT STR$(V+1):CLOSE
  77. 1180 INPUT "Message file name? ",B$:GOSUB 1920:FIL$=B$
  78. 1200 INPUT "Todays date (MM/DD/YY)?",B$:GOSUB 1920:IF LEN(B$)<>8 THEN 1200
  79.  
  80.      ELSE D$=B$
  81. 1220 INPUT "Who to ?";B$:GOSUB 1920:
  82.  
  83.      IF B$="" THEN T$="ALL" ELSE T$=B$
  84. 1240 INPUT "Subject?",B$:GOSUB 1920:K$=B$:
  85.  
  86.      INPUT "Password?",B$:GOSUB 1920:PW$=B$:IF PW$="" THEN 1260
  87. 1250 IF T$="ALL" AND LEFT$(PW$,1)="*" THEN
  88.  
  89.      PRINT CHR$(7);"Personal password for ALL is NOT allowed!":GOTO 1240
  90. 1260 F=0'F IS MESSAGE LENGTH
  91. 1280 PRINT "Updating counters":
  92.  
  93.      OPEN "R",1,"COUNTERS",5:FIELD#1,5 AS RR$
  94. 1300 GET#1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MNUM
  95. 1320 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MSGS:CLOSE#1
  96. 1340 PRINT "Updating msg file":OPEN "R",1,"MESSAGES",65:RL=65
  97. 1360 FIELD#1,65 AS RR$
  98. 1380 RE=MX+7:F=0
  99. 1400 OPEN "I",2,FIL$:IF EOF(2) THEN PRINT "File empty.":CLOSE#1:CLOSE#2:RETURN
  100. 1420 IF EOF(2) THEN S$="9999":GOSUB 1940:PUT #1,RE:CLOSE #2:GOTO 1500
  101. 1440 LINE INPUT #2,S$
  102. 1460 IF LEN(S$)>63 THEN S$=LEFT$(S$,63):TRUNC=-1 ELSE TRUNC=0
  103. 1470 PRINT S$;:IF TRUNC THEN PRINT CHR$(7);"<== TRUNCATED!" ELSE PRINT
  104. 1480 GOSUB 1940:PUT #1,RE:RE=RE+1:F=F+1:GOTO 1420
  105. 1500 RE=MX+1
  106. 1520 S$=STR$(V+1):GOSUB 1940:PUT#1,RE
  107. 1540 RE=RE+1:S$=D$:GOSUB 1940:PUT#1,RE
  108. 1560 RE=RE+1:S$=N$+" "+O$:GOSUB 1940:PUT#1,RE
  109. 1580 RE=RE+1:S$=T$:GOSUB 1940:PUT#1,RE
  110. 1600 RE=RE+1:S$=K$:GOSUB 1940:PUT#1,RE:RE=RE+1:S$=STR$(F):GOSUB 1940:PUT#1,RE
  111. 1620 CLOSE #1
  112. 1640 IF PW$<>"" THEN PW$=";"+PW$
  113. 1660 PRINT "Updating summary file."
  114. 1680 OPEN "R",1,"SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
  115. 1700 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 1940:PUT#1,RE
  116. 1720 RE=RE+1:S$=D$:GOSUB 1940:PUT#1,RE
  117. 1740 RE=RE+1:S$=N$+" "+O$:GOSUB 1940:PUT#1,RE
  118. 1760 RE=RE+1:S$=T$:GOSUB 1940:PUT#1,RE
  119. 1780 RE=RE+1:S$=K$:GOSUB 1940:PUT#1,RE
  120. 1800 RE=RE+1:S$=STR$(F):GOSUB 1940:PUT#1,RE
  121. 1820 RE=RE+1:S$=" 9999":GOSUB 1940:PUT#1,RE
  122. 1840 CLOSE#1
  123. 1860 MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F
  124. 1880 U=U+1
  125. 1900 RETURN
  126. 1920 FOR ZZ=1 TO LEN(B$):
  127.  
  128.       MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):
  129.  
  130.       NEXT ZZ:RETURN
  131. 1940 REM
  132. 1960 REM FILL AND STORE DISK RECORD
  133. 1980 REM
  134. 2000 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  135. 2020 RETURN
  136. 2040 REM
  137. 2060 REM PURGE KILLED MESSAGES FROM FILES
  138. 2080 REM
  139. 2100 IF PURGED THEN PRINT "Files already purged.":RETURN
  140. 2120 INPUT "Today's date (MM/DD/YY) ?",DATE$
  141. 2140 IF LEN(DATE$)>8 THEN PRINT "Must be less then 8 characters.":GOTO 2120
  142. 2160 OPEN "R",1,DATE$+".ARC"
  143. 2180 IF LOF(1)>0 THEN PRINT "Archive file: ";
  144.  
  145.       DATE$+".ARC";" exists.":CLOSE:RETURN
  146. 2200 CLOSE
  147. 2220 MSGN=1:INPUT "Renumber messages?",PK$:PK$=MID$(PK$,1,1)
  148. 2240 IF PK$="y" THEN PK$="Y"
  149. 2260 IF PK$<>"Y" THEN 2320
  150. 2280 INPUT "Message number to start ?",MSG$:IF MSG$="" THEN MSG$="1"
  151. 2300 MSGN=VAL(MSG$):IF MSGN=0 THEN PRINT "Invalid msg #.":RETURN
  152. 2320 PRINT "Purging summary file...":OPEN "R",1,"SUMMARY",30
  153. 2340 FIELD#1,30 AS R1$
  154. 2360 R1=1
  155. 2380 OPEN "R",2,"$SUMMARY.$$$",30
  156. 2400 FIELD#2,30 AS R2$
  157. 2420 R2=1
  158. 2440 PRINT SEP$:GET#1,R1:IF EOF(1) THEN 2680
  159. 2460 IF VAL(R1$)=0 THEN R1=R1+6:PRINT "Deletion":GOTO 2440
  160. 2480 IF PK$="Y" AND VAL(R1$)<9999 THEN 
  161.  
  162.       LSET R2$=LEFT$(STR$(MSGN)+SPACE$(28),28)+CHR$(13)+CHR$(10):
  163.  
  164.       MSGN=MSGN+1:GOTO 2520
  165. 2500 LSET R2$=R1$
  166. 2520 PUT #2,R2
  167. 2540 PRINT LEFT$(R2$,28)
  168. 2560 IF VAL(R1$)>9998 THEN 2680
  169. 2580 FOR I=1 TO 5
  170. 2600 R1=R1+1:R2=R2+1:GET#1,R1:LSET R2$=R1$:PUT#2,R2
  171. 2620 PRINT LEFT$(R2$,28)
  172. 2640 NEXT I
  173. 2660 R1=R1+1:R2=R2+1:GOTO 2440
  174. 2680 CLOSE:OPEN "O",1,"SUMMARY.BAK":CLOSE:KILL "SUMMARY.BAK":
  175.  
  176.       NAME "SUMMARY" AS "SUMMARY.BAK":NAME "$SUMMARY.$$$" AS "SUMMARY"
  177. 2700 PRINT "Purging message file...":MSGN=VAL(MSG$)
  178. 2720 OPEN "R",1,"MESSAGES",65:FIELD #1,65 AS R1$
  179. 2740 OPEN "R",2,"$MESSAGS.$$$",65:FIELD #2,65 AS R2$
  180. 2760 OPEN "O",3,DATE$+".ARC":R1=1:KIL=0
  181. 2780 R1=1:R2=1
  182. 2800 PRINT SEP$:GET #1,R1:IF EOF(1) THEN 3140
  183. 2820 IF VAL(R1$)=0 THEN KIL=-1:PRINT "Archiving message":GOTO 2900
  184. 2840 KIL=0:IF PK$="Y" AND VAL(R1$)<9999 THEN
  185.  
  186.       LSET R2$=LEFT$(STR$(MSGN)+SPACE$(63),63)+CHR$(13)+CHR$(10):
  187.  
  188.       MSGN=MSGN+1:PRINT LEFT$(R2$,63):GOTO 2880
  189. 2860 LSET R2$=R1$:PRINT LEFT$(R2$,6)
  190. 2880 PUT #2,R2
  191. 2900 IF KIL THEN GOSUB 3860:PRINT #3,KL$
  192. 2920 IF VAL(R1$)>9998 THEN 3140
  193. 2940 FOR I=1 TO 5
  194. 2960 R1=R1+1:IF NOT KIL THEN R2=R2+1
  195. 2980 GET #1,R1:IF KIL THEN GOSUB 3860:PRINT #3,KL$:GOTO 3020
  196. 3000 LSET R2$=R1$:PUT #2,R2:PRINT LEFT$(R2$,63)
  197. 3020 NEXT I
  198. 3040 FOR I=1 TO VAL(R1$):R1=R1+1:IF NOT KIL THEN R2=R2+1
  199. 3060 GET #1,R1:IF KIL THEN GOSUB 3860:PRINT #3,KL$:GOTO 3100
  200. 3080 LSET R2$=R1$:PUT #2,R2:PRINT LEFT$(R2$,63)
  201. 3100 NEXT I:R1=R1+1:IF NOT KIL THEN R2=R2+1
  202. 3120 GOTO 2800
  203. 3140 CLOSE:OPEN "O",1,"MESSAGES.BAK":CLOSE:KILL "MESSAGES.BAK":
  204.  
  205.       NAME "MESSAGES" AS "MESSAGES.BAK":NAME "$MESSAGS.$$$" AS "MESSAGES"
  206. 3160 PRINT "Updating counters..."
  207. 3180 OPEN "O",1,"COUNTERS.BAK":CLOSE:KILL "COUNTERS.BAK"
  208. 3200 OPEN "R",1,"COUNTERS",15:FIELD #1,10 AS C1$,5 AS C2$
  209. 3220 OPEN "R",2,"COUNTERS.BAK",15:FIELD #2,15 AS R2$
  210. 3240 GET #1,1:LSET R2$=C1$+C2$:PUT #2,1
  211. 3260 IF PK$="Y" THEN LSET C2$=STR$(MSGN-1):PUT #1,1
  212. 3280 CLOSE
  213. 3300 PURGED=-1:GOSUB 3700:RETURN
  214. 3320 REM BUILD SUMMARY FILE FROM MESSAGE FILE
  215. 3340 PRINT "Building summary file..."
  216. 3360 OPEN "O",1,"SUMMARY.BAK":CLOSE:KILL "SUMMARY.BAK"
  217. 3380 OPEN "R",1,"MESSAGES",65:FIELD #1,65 AS R1$:R1=1
  218. 3400 OPEN "R",2,"SUMMARY.$$$",30:FIELD #2,30 AS R2$:R2=1
  219. 3420 PRINT SEP$
  220. 3440 FOR I=1 TO 6
  221. 3460 GET #1,R1:IF EOF(1) THEN 3560
  222. 3480 LSET R2$=LEFT$(R1$,28)+CRLF$:PUT #2,R2
  223. 3500 R1=R1+1:R2=R2+1:PRINT LEFT$(R2$,28):IF EOF(1) THEN 3560
  224. 3520 IF I=1 THEN IF VAL(R1$)>9998 THEN 3560
  225. 3540 NEXT I:R1=R1+VAL(R1$):GOTO 3420
  226. 3560 CLOSE:NAME "SUMMARY" AS "SUMMARY.BAK":NAME "SUMMARY.$$$" AS "SUMMARY"
  227. 3580 PRINT "Summary file built.":RETURN
  228. 3600 PRINT "Error number: ";ERR;" occurred at line number:";ERL
  229. 3620 IF ERL=940 AND ERR=53 THEN PRINT "File not found.":RETURN
  230. 3640 IF ERL=780 AND ERR=53 THEN PRINT "File not found.":CLOSE:RESUME 880
  231. 3660 PRINT "Error number ";ERR;" in line number ";ERL
  232. 3680 RESUME 440
  233. 3700 REM build message index
  234. 3720 MX=0:MZ=0
  235. 3740 OPEN "R",1,"SUMMARY",30:RE=1:FIELD#1,28 AS RR$
  236. 3760 GET#1,RE:IF EOF(1) THEN 3840
  237. 3780 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 3820
  238. 3800 IF G>9998 THEN MZ=MZ-1:GOTO 3840
  239. 3820 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 3760
  240. 3840 CLOSE:RETURN
  241. 3860 REM unpack record
  242. 3880 ZZ=LEN(R1$)-2
  243. 3900 WHILE MID$(R1$,ZZ,1)=" "
  244. 3920 ZZ=ZZ-1:IF ZZ=1 THEN 3960
  245. 3940 WEND
  246. 3960 KL$=LEFT$(R1$,ZZ)
  247. 3980 RETURN
  248.  ZZ=LEN(R1$)-2
  249. 3900 WHILE MID$(R1$,ZZ,1)=" "
  250. 39