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