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