home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol250 / util38.asc < prev    next >
Encoding:
Text File  |  1994-07-13  |  10.6 KB  |  270 lines
  1. 10 DEFINT A-Z
  2. 20 DEF FNCT$(C$,SW)=STRING$(INT((SW-LEN(C$))/2)," ")+C$
  3. 30 SW=80
  4. 40 ON ERROR GOTO 2110
  5. 50 DIM M(200,2)
  6. 60 SEP$="=============================================="
  7. 70 CRLF$=CHR$(13)+CHR$(10)
  8. 80 PURGED=0:BACKUP=0
  9. 90 GOSUB 2210                                                           ' build message index
  10. 100 N$="SYSOP":O$=""
  11. 110 ' 
  12. 120 PRINT:PRINT
  13. 130 VERS$="RBBS v 3.8 UTILITY PROGRAM (07/17/85)"
  14. 135 ' Lillypond Softwares   Dennis Recla
  15. 140 PRINT FNCT$(VERS$,80)
  16. 150 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
  17. 160 ' 
  18. 170 PRINT:PRINT:INPUT "Command:  B,D,E,F,K,P,R,T,L ( or ?) ",PROMPT$
  19. 180 PRINT:PRINT:IF PROMPT$="" THEN GOSUB 230:GOTO 170
  20. 190 B$=MID$(PROMPT$,1,1):GOSUB 1110:SM$=B$:SM=INSTR("TFDPEBKRL",SM$):GOSUB 200:GOTO 170
  21. 200 IF SM=0 THEN 230
  22. 210 ON SM GOTO 590,540,420,1200,380,1950,2410,2490,2600
  23. 220 ' 
  24. 230 PRINT:PRINT "Commands: "
  25. 240 PRINT
  26. 250 PRINT "  <B>uild SUMMARY file from MESSAGE file"
  27. 260 PRINT "  <D>isplay an ASCII file on your screen"
  28. 270 PRINT "  <E>nd the utility program"
  29. 280 PRINT "  <F>iles (list the disk directory)"
  30. 290 PRINT "  <K>ill (erase) a file"
  31. 300 PRINT "  <P>urge the message files"
  32. 310 PRINT "  <R>ename a file"
  33. 320 PRINT "  <T>ransfer a disk file to the message file"
  34. 330 PRINT "  <L>ist an ASCII file on your printer"
  35. 340 RETURN
  36. 350 ' 
  37. 360 ' End of program
  38. 370 ' 
  39. 380 PRINT:PRINT:SYSTEM:END
  40. 390 ' 
  41. 400 ' Display an ASCII file
  42. 410 ' 
  43. 420 B$=MID$(PROMPT$,2):IF B$="" THEN INPUT "Filename? ",B$:PRINT
  44. 430 IF B$="" THEN RETURN ELSE GOSUB 1110:FILN$=B$
  45. 440 OPEN "I",1,FILN$
  46. 450 IF EOF(1) THEN 490
  47. 460 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
  48. 470 IF BI=11 THEN PRINT:PRINT "++ Aborted ++":PRINT:CLOSE:RETURN
  49. 480 LINE INPUT #1,LIN$:PRINT LIN$:GOTO 450
  50. 490 CLOSE:PRINT:PRINT:PRINT "++ End Of File ++":PRINT
  51. 500 RETURN
  52. 510 ' 
  53. 520 ' Display directory
  54. 530 ' 
  55. 540 B$=PROMPT$:GOSUB 1110:IF LEN(B$)>1 THEN SPEC$=MID$(B$,3) ELSE SPEC$="*.*"
  56. 550 FILES SPEC$:PRINT:RETURN
  57. 560 ' 
  58. 570 ' Transfer a disk file
  59. 580 ' 
  60. 590 PRINT "Active # of msgs   ";:OPEN "R",1,"COUNTERS",5:FIELD #1,5 AS RR$:GET #1,MSGS:M=VAL(RR$)
  61. 600 PRINT STR$(M)
  62. 610 PRINT "Last caller was #  ";:GET #1,CALLS:PRINT STR$(VAL(RR$))
  63. 620 PRINT "This msg # will be ";:GET #1,MNUM:U=VAL(RR$):PRINT STR$(U+1):CLOSE
  64. 630 ' 
  65. 640 ' Enter a new message
  66. 650 ' 
  67. 660 IF NOT PURGED THEN PRINT "Files must be purged before messages can be added":RETURN
  68. 670 OPEN "R",1,"COUNTERS",5:PRINT "Msg # will be ";:FIELD #1,5 AS RR$:GET #1,MNUM:V=VAL(RR$)
  69. 680 PRINT STR$(V+1):CLOSE
  70. 690 INPUT "Message file name? ",B$:GOSUB 1110:FIL$=B$
  71. 700 INPUT "Todays date? (MM/DD/YY) ",B$:GOSUB 1110:IF B$="" THEN D$=DT$ ELSE D$=B$
  72. 710 INPUT "Who to? (C/R for ALL) ";B$:GOSUB 1110:IF B$="" THEN T$="ALL" ELSE T$=B$
  73. 720 INPUT "Subject: ",B$:GOSUB 1110:K$=B$
  74. 730 PW$="":IF T$="ALL" THEN 750
  75. 740 INPUT "Private? (Y/N) ",B$:GOSUB 1110:IF B$="Y" THEN PW$="*" ELSE PW$=""
  76. 750 F=0                                                                 ' F is message length
  77. 760 PRINT:PRINT "Updating counters":OPEN "R",1,"COUNTERS",5:FIELD #1,5 AS RR$
  78. 770 GET #1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT #1,MNUM
  79. 780 GET #1,MSGS:LSET RR$=STR$(VAL(RR$) + 1):PUT #1,MSGS:CLOSE #1
  80. 790 PRINT:PRINT "Updating msg file":OPEN "R",1,"MESSAGES",65:RL=65
  81. 800 FIELD #1,65 AS RR$
  82. 810 RE=MX+7:F=0
  83. 820 OPEN "I",2,FIL$:IF EOF(2) THEN PRINT "File empty.":CLOSE #1:CLOSE #2:END
  84. 830 IF EOF(2) THEN S$="9999":GOSUB 1150:PUT #1,RE:CLOSE #2:GOTO 870
  85. 840 LINE INPUT #2,S$
  86. 850 IF LEN(S$)>63 THEN S$=LEFT$(S$,63)
  87. 860 PRINT S$:GOSUB 1150:PUT #1,RE:RE=RE+1:F=F+1:GOTO 830
  88. 870 RE=MX+1
  89. 880 S$=STR$(V+1):GOSUB 1150:PUT #1,RE
  90. 890 RE=RE+1:S$=D$:GOSUB 1150:PUT #1,RE
  91. 900 RE=RE+1:S$=N$+" "+O$:GOSUB 1150:PUT #1,RE
  92. 910 RE=RE+1:S$=T$:GOSUB 1150:PUT #1,RE
  93. 920 RE=RE+1:S$=K$:GOSUB 1150:PUT #1,RE:RE=RE+1:S$=STR$(F):GOSUB 1150:PUT #1,RE
  94. 930 CLOSE #1
  95. 940 IF PW$<>"" THEN PW$=";"+PW$
  96. 950 PRINT:PRINT "Updating summary file."
  97. 960 OPEN "R",1,"SUMMARY",30:RE=1:FIELD #1,30 AS RR$:RL=30
  98. 970 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 1150:PUT #1,RE
  99. 980 RE=RE+1:S$=D$:GOSUB 1150:PUT #1,RE
  100. 990 RE=RE+1:S$=N$+" "+O$:GOSUB 1150:PUT #1,RE
  101. 1000 RE=RE+1:S$=T$:GOSUB 1150:PUT #1,RE
  102. 1010 RE=RE+1:S$=K$:GOSUB 1150:PUT #1,RE
  103. 1020 RE=RE+1:S$=STR$(F):GOSUB 1150:PUT #1,RE
  104. 1030 RE=RE+1:S$=" 9999":GOSUB 1150:PUT #1,RE
  105. 1040 CLOSE #1
  106. 1050 MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F
  107. 1060 U=U+1
  108. 1070 RETURN
  109. 1080 ' 
  110. 1090 ' Convert the string B$ to upper case
  111. 1100 ' 
  112. 1110 FOR ZZ=1 TO LEN(B$):MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):NEXT ZZ:RETURN
  113. 1120 ' 
  114. 1130 ' Fill and store disk record
  115. 1140 ' 
  116. 1150 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  117. 1160 RETURN
  118. 1170 ' 
  119. 1180 ' Purge killed MESSAGES from files
  120. 1190 ' 
  121. 1200 IF PURGED THEN PRINT "Files already purged.":RETURN
  122. 1210 INPUT "Create Archive File? (Y/N) ";CRF$
  123. 1220 IF CRF$="y" THEN CRF$="Y"
  124. 1230 IF CRF$<>"Y" THEN 1320
  125. 1240 PRINT
  126. 1250 INPUT "Todays date? (MM/DD/YY) ",DATE$
  127. 1260 IF LEN(DATE$)<>8 THEN PRINT "Must be 8 characters.":GOTO 1250
  128. 1270 IF DATE$="" THEN DATE$=DT$
  129. 1280 PRINT
  130. 1290 OPEN "R",1,DATE$+".ARC"
  131. 1300 IF LOF(1)>0 THEN PRINT "Archive file: ";DATE$+".ARC";" exists.":CLOSE:RETURN
  132. 1310 CLOSE
  133. 1320 MSGN=1:INPUT "Renumber messages? (Y/N) ",PK$:PK$=MID$(PK$,1,1)
  134. 1330 IF PK$="y" THEN PK$="Y"
  135. 1340 IF PK$<>"Y" THEN 1380
  136. 1350 PRINT
  137. 1360 INPUT "Message number to start (RETURN for 1)?",MSG$:IF MSG$="" THEN MSG$="1"
  138. 1370 MSGN=VAL(MSG$):IF MSGN=0 THEN PRINT "Invalid msg #.":RETURN
  139. 1380 PRINT:PRINT "Purging summary file...":OPEN "R",1,"SUMMARY",30
  140. 1390 FIELD #1,30 AS R1$
  141. 1400 R1=1
  142. 1410 OPEN "R",2,"$SUMMARY.$$$",30
  143. 1420 FIELD #2,30 AS R2$
  144. 1430 R2=1
  145. 1440 PRINT SEP$:GET #1,R1:IF EOF(1) THEN 1570
  146. 1450 IF VAL(R1$)=0 THEN R1=R1+6:PRINT "Deletion":GOTO 1440
  147. 1460 IF PK$="Y" AND VAL(R1$)<9999 THEN IF INSTR(R1$,";") THEN PASS$=MID$(R1$,INSTR(R1$,";"),27) ELSE PASS$=SPACE$(28)
  148. 1470 IF PK$="Y" AND VAL(R1$)<9999 THEN LSET R2$=LEFT$(STR$(MSGN)+PASS$,28)+CHR$(13)+CHR$(10):MSGN=MSGN+1:GOTO 1490
  149. 1480 LSET R2$=R1$
  150. 1490 PUT #2,R2
  151. 1500 PRINT LEFT$(R2$,28)
  152. 1510 IF VAL(R1$)>9998 THEN 1570
  153. 1520 FOR I=1 TO 5
  154. 1530 R1=R1+1:R2=R2+1:GET #1,R1:LSET R2$=R1$:PUT #2,R2
  155. 1540 PRINT LEFT$(R2$,28)
  156. 1550 NEXT I
  157. 1560 R1=R1+1:R2=R2+1:GOTO 1440
  158. 1570 CLOSE:OPEN "O",1,"SUMMARY.BAK":CLOSE:KILL "SUMMARY.BAK":NAME "SUMMARY" AS "SUMMARY.BAK":NAME "$SUMMARY.$$$" AS "SUMMARY"
  159. 1580 PRINT:PRINT "Purging message file...":MSGN=VAL(MSG$)
  160. 1590 OPEN "R",1,"MESSAGES",65:FIELD #1,65 AS R1$
  161. 1600 OPEN "R",2,"$MESSAGS.$$$",65:FIELD #2,65 AS R2$
  162. 1610 R1=1:KIL=0:IF CRF$="Y" THEN OPEN "O",3,DATE$+".ARC"
  163. 1620 R1=1:R2=1
  164. 1630 PRINT SEP$:GET #1,R1:IF EOF(1) THEN 1830
  165. 1640 IF VAL(R1$)=0 THEN KIL=-1:PRINT "Archiving msg.":GOTO 1700
  166. 1650 KIL=0
  167. 1660 IF PK$="Y" AND VAL(R1$)<9999 THEN IF INSTR(R1$,";") THEN PASS$=MID$(R1$,INSTR(R1$,";"),62) ELSE PASS$=SPACE$(62)
  168. 1670 IF PK$="Y" AND VAL(R1$)<9999 THEN LSET R2$=LEFT$(STR$(MSGN)+PASS$,63)+CHR$(13)+CHR$(10):MSGN=MSGN+1:PRINT LEFT$(R2$,63):GOTO 1690
  169. 1680 LSET R2$=R1$:PRINT LEFT$(R2$,6)
  170. 1690 PUT #2,R2
  171. 1700 IF KIL THEN GOSUB 2310:IF CRF$="Y" THEN GOSUB 2560
  172. 1710 IF VAL(R1$)>9998 THEN 1830
  173. 1720 FOR I=1 TO 5
  174. 1730 R1=R1+1:IF NOT KIL THEN R2=R2+1
  175. 1740 GET #1,R1:IF KIL THEN GOSUB 2310:IF CRF$="Y" THEN GOSUB 2560 ELSE 1760:GOTO 1760
  176. 1750 LSET R2$=R1$:PUT #2,R2:PRINT LEFT$(R2$,63)
  177. 1760 NEXT I
  178. 1770 FOR I=1 TO VAL(R1$):R1=R1+1:IF NOT KIL THEN R2=R2+1
  179. 1780 GET #1,R1:IF KIL THEN GOSUB 2310:IF CRF$="Y" THEN GOSUB 2560 ELSE 1800:GOTO 1800
  180. 1790 LSET R2$=R1$:PUT #2,R2:PRINT LEFT$(R2$,63)
  181. 1800 NEXT I:R1=R1+1:IF NOT KIL THEN R2=R2+1
  182. 1810 GOTO 1630
  183. 1820 ' 
  184. 1830 CLOSE:OPEN "O",1,"MESSAGES.BAK":CLOSE:KILL "MESSAGES.BAK":NAME "MESSAGES" AS "MESSAGES.BAK":NAME "$MESSAGS.$$$" AS "MESSAGES"
  185. 1840 PRINT:PRINT "Updating counters..."
  186. 1850 OPEN "O",1,"COUNTERS.BAK":CLOSE:KILL "COUNTERS.BAK"
  187. 1860 OPEN "R",1,"COUNTERS",15:FIELD #1,10 AS C1$,5 AS C2$
  188. 1870 OPEN "R",2,"COUNTERS.BAK",15:FIELD #2,15 AS R2$
  189. 1880 GET #1,1:LSET R2$=C1$+C2$:PUT #2,1
  190. 1890 IF PK$="Y" THEN LSET C2$=STR$(MSGN-1):PUT #1,1
  191. 1900 CLOSE
  192. 1910 PURGED=-1:GOSUB 2210:RETURN
  193. 1920 ' 
  194. 1930 ' Build SUMMARY file from MESSAGE file
  195. 1940 ' 
  196. 1950 PRINT "Building summary file..."
  197. 1960 OPEN "O",1,"SUMMARY.BAK":CLOSE:KILL "SUMMARY.BAK"
  198. 1970 OPEN "R",1,"MESSAGES",65:FIELD #1,65 AS R1$:R1=1
  199. 1980 OPEN "R",2,"SUMMARY.$$$",30:FIELD #2,30 AS R2$:R2=1
  200. 1990 PRINT SEP$
  201. 2000 FOR I=1 TO 6
  202. 2010 GET #1,R1:IF EOF(1) THEN 2060
  203. 2020 LSET R2$=LEFT$(R1$,28)+CRLF$:PUT #2,R2
  204. 2030 R1=R1+1:R2=R2+1:PRINT LEFT$(R2$,28):IF EOF(1) THEN 2060
  205. 2040 IF I=1 THEN IF VAL(R1$)>9998 THEN 2060
  206. 2050 NEXT I:R1=R1+VAL(R1$):GOTO 1990
  207. 2060 CLOSE:NAME "SUMMARY" AS "SUMMARY.BAK":NAME "SUMMARY.$$$" AS "SUMMARY"
  208. 2070 PRINT:PRINT "Summary file built.":RETURN
  209. 2080 ' 
  210. 2090 ' Error handlers
  211. 2100 ' 
  212. 2110 IF (ERL=550) AND (ERR=53) THEN PRINT "File not found.":RESUME 170
  213. 2120 IF (ERL=440) AND (ERR=53) THEN PRINT "File not found.":CLOSE:RESUME 500
  214. 2130 IF (ERL=2620) AND (ERR=53) THEN PRINT "File not found.":CLOSE:RESUME 2680
  215. 2140 IF (ERL=2530) AND (ERR=53) THEN PRINT "File does not exist.":RESUME 170
  216. 2150 IF (ERL=2430) AND (ERR=53) THEN PRINT "File does not exist.":RESUME 170
  217. 2160 PRINT "Error number ";ERR;" in line number ";ERL
  218. 2170 RESUME 170
  219. 2180 ' 
  220. 2190 ' Build message index
  221. 2200 ' 
  222. 2210 MX=0:MZ=0
  223. 2220 OPEN "R",1,"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
  224. 2230 GET #1,RE:IF EOF(1) THEN 2270
  225. 2240 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 2260
  226. 2250 IF G>9998 THEN MZ=MZ-1:GOTO 2270
  227. 2260 GET #1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 2230
  228. 2270 CLOSE:RETURN
  229. 2280 ' 
  230. 2290 ' Unpack record
  231. 2300 ' 
  232. 2310 IF CRF$="Y" THEN 2320 ELSE RETURN
  233. 2320 ZZ=LEN(R1$)-2
  234. 2330 WHILE MID$(R1$,ZZ,1)=" "
  235. 2340 ZZ=ZZ-1:IF ZZ=1 THEN 2360
  236. 2350 WEND
  237. 2360 KL$=LEFT$(R1$,ZZ)
  238. 2370 RETURN
  239. 2380 ' 
  240. 2390 ' Kill (erase) a file
  241. 2400 ' 
  242. 2410 B$=MID$(PROMPT$,3):IF B$ = "" THEN INPUT "Filename? ",B$:PRINT
  243. 2420 IF B$="" THEN RETURN ELSE GOSUB 1110:FILN$ = B$
  244. 2430 KILL FILN$
  245. 2440 PRINT
  246. 2450 RETURN
  247. 2460 ' 
  248. 2470 ' Rename a file
  249. 2480 ' 
  250. 2490 INPUT "Existing Filename? ",B$:PRINT
  251. 2500 IF B$="" THEN RETURN ELSE GOSUB 1110:EFILN$ = B$
  252. 2510 PRINT:INPUT "New Filename? ",B$:PRINT
  253. 2520 IF B$="" THEN RETURN ELSE GOSUB 1110:NFILN$ = B$
  254. 2530 NAME EFILN$ AS NFILN$
  255. 2540 PRINT:RETURN
  256. 2550 ' 
  257. 2560 PRINT #3,KL$:RETURN                                                ' write message archive file
  258. 2570 ' 
  259. 2580 ' Print an ASCII file
  260. 2590 ' 
  261. 2600 B$=MID$(PROMPT$,2):IF B$="" THEN INPUT "Filename? ",B$:PRINT
  262. 2610 IF B$="" THEN RETURN ELSE GOSUB 1110:FILN$=B$
  263. 2620 OPEN "I",1,FILN$
  264. 2630 IF EOF(1) THEN 2670
  265. 2640 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
  266. 2650 IF BI=11 THEN PRINT:PRINT "++ Aborted ++":PRINT:CLOSE:RETURN
  267. 2660 LINE INPUT #1,LIN$:LPRINT LIN$:GOTO 2630
  268. 2670 CLOSE:PRINT:PRINT:PRINT "++ End Of File ++":PRINT
  269. 2680 RETURN
  270.