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 / RBBS / RBBS40.LBR / RBBSUT40.BQS / RBBSUT40.BAS
BASIC Source File  |  2000-06-30  |  14KB  |  635 lines
  1. 100   ' RBSUTL40.BAS     A Utility program for use with RBBS35 
  2. 110   ' Revised from Version 2.7/3.1/3.6 of RBBSUTIL 
  3. 120   '
  4. 130   '             Randy Cosby
  5. 140   '
  6. 150   ' Added purging ability for all of the different boards...
  7. 160   '
  8. 170   ' This version does contains the updates from Bill Bolton
  9. 180   ' vers 2.7 UTIL.BAS--and Ron Fowlers vers. 3.2 RBSUTL31.BAS
  10. 190   '
  11. 200   '
  12. 210   '  Program Starts here.....
  13. 220   '  
  14. 225 DIM ZZ$(999)
  15. 230    DEFINT A-Z
  16. 240     VERS$ = "Vers 4.0"
  17. 250    ON ERROR GOTO 2190
  18. 260    DIM M(200,2)
  19. 270    SEP$ = "=============================================="
  20. 280        CRLF$ = CHR$(13) + CHR$(10)
  21. 285     BS$="0" 
  22. 290    PURGED = 0:
  23.     BACKUP = 0
  24. 300    GOSUB 2260        ' BUILD MSG INDEX
  25. 310   N$ = "SYSOP":
  26.        O$ = ""
  27. 320    PRINT:
  28.         PRINT "             RBBS Utility ";VERS$
  29. 330    PRINT SEP$
  30. 340    MSGS = 1:
  31.     CALLS = MSGS + 1:
  32.     MNUM = CALLS + 1
  33. 350    PRINT:
  34.     INPUT "Command? ",PROMPT$
  35. 360    PRINT:
  36.     PRINT:
  37.     IF PROMPT$ = "" THEN
  38.         GOSUB 400:
  39.         GOTO 350
  40. 370    B$ = MID$(PROMPT$,1,1):
  41.     GOSUB 1250:
  42.     SM$ = B$:
  43.     SM = INSTR ("TFDPEBKRU#",SM$):
  44.     GOSUB 380:
  45.     GOTO 350
  46. 380    IF SM = 0 THEN
  47.         400
  48. 390    ON SM GOTO 740,690,570,1310,510,2010,2440,2520,2610,3000
  49. 400    PRINT "You're on message base ";BS$:  
  50.     PRINT "Commands allowed are:"
  51. 410    PRINT "B   ==> build summary file from message file"
  52. 420    PRINT "D   ==> display an ascii file"
  53. 430    PRINT "E   ==> end the utility program"
  54. 440    PRINT "F   ==> list the disk directory"
  55. 450    PRINT "K   ==> kill a file"
  56. 460    PRINT "P   ==> purge the message files"
  57. 470    PRINT "R   ==> rename a file"
  58. 480    PRINT "T   ==> transfers a disk file to the message file"
  59. 485    PRINT "U   ==> unerase killed messages"
  60. 490    PRINT "#   ==> change message base number"
  61. 491 GOTO 350
  62. 500 '
  63. 510 ' END OF PROGRAM
  64. 520 '
  65. 530 PRINT:PRINT:SYSTEM
  66. 540 '
  67. 550 ' DISPLAY A FILE
  68. 560 '
  69. 570    B$ = MID$(PROMPT$,2):
  70.     IF B$ = "" THEN
  71.         INPUT "Filename? ",B$:
  72.         PRINT
  73. 580    IF B$ = "" THEN
  74.         RETURN
  75.     ELSE
  76.         GOSUB 1250:
  77.         FILN$ = B$
  78. 590    OPEN "I",1,FILN$
  79. 600    IF EOF(1) THEN
  80.         640
  81. 610    BI = ASC(INKEY$+" "):
  82.     IF BI = 19 THEN
  83.         BI = ASC(INPUT$(1))
  84. 620    IF BI = 11 THEN
  85.         PRINT:
  86.         PRINT "++ Aborted ++":
  87.         PRINT:
  88.         CLOSE:
  89.         RETURN
  90. 630    LINE INPUT #1,LIN$:
  91.     PRINT LIN$:
  92.     GOTO 600
  93. 640    CLOSE:
  94.     PRINT:
  95.     PRINT:
  96.     PRINT "++ End Of File ++":
  97.     PRINT
  98. 650    RETURN
  99. 660 '
  100. 670 ' DISPLAY DIRECTORY
  101. 680 '
  102. 690    B$ = PROMPT$:
  103.     GOSUB 1250:
  104.     IF LEN(B$) > 1 THEN
  105.         SPEC$ = MID$(B$,3)
  106.     ELSE
  107.         SPEC$ = "*.*"
  108. 700    FILES SPEC$:
  109.     PRINT:
  110.     RETURN
  111. 710 '
  112. 720 ' TRANSFER A DISK FILE
  113. 730 '
  114. 740    PRINT "Active # of msg's ";:
  115.     OPEN "R",1,"COUNTERS."+BS$,5:
  116.     FIELD#1,5 AS RR$:
  117.     GET#1,MSGS:
  118.     M = VAL(RR$)
  119. 750    PRINT STR"$(M) + " "
  120. 760    PRINT "Last caller (this board) was # ";:
  121.     GET#1,CALLS:
  122.     PRINT STR$(VAL(RR$))
  123. 770    PRINT "This msg # will be ";:
  124.     GET#1,MNUM:
  125.     U = VAL(RR$):
  126.     PRINT STR$(U + 1):
  127.     CLOSE
  128. 780 '
  129. 790 ' ***ENTER A NEW MESSAGE***
  130. 800 '
  131. 810    IF NOT PURGED THEN
  132.         PRINT "Files must be purged before messages can be added":
  133.         RETURN
  134. 820    OPEN "R",1,"COUNTERS."+BS$,5:
  135.     PRINT "Msg # will be ";:
  136.     FIELD#1,5 AS RR$:
  137.     GET#1,MNUM:
  138.     V = VAL(RR$)
  139. 830    PRINT STR$(V + 1):
  140.     CLOSE
  141. 840    INPUT "Message file name? ",B$:
  142.     GOSUB 1250:
  143.     FIL$ = B$
  144. 850    INPUT "Todays date (DD/MM|HH/MM)?",B$:
  145.     GOSUB 1250:
  146.     IF B$ = "" THEN
  147.         D$ = DT$
  148.     ELSE
  149.         D$ = B$
  150. 860    INPUT "Who to (C/R for ALL)?";B$:
  151.     GOSUB 1250:
  152.     IF B$ = "" THEN
  153.         T$ = "ALL"
  154.     ELSE
  155.         T$ = B$
  156. 870    INPUT "Subject?",B$:
  157.     GOSUB 1250:
  158.     K$ = B$
  159. 880    INPUT "Password?",B$:
  160.     GOSUB 1250:
  161.     PW$ = B$:
  162.     IF T$ = "ALL" AND LEFT$(PW$,1) = "*" THEN
  163.         PRINT CHR$(7);"You CANNOT use '*' with ALL.":
  164.         GOTO 880
  165. 890    F = 0            ' F IS MESSAGE LENGTH
  166. 900    PRINT "Updating counters":
  167.     OPEN "R",1,"COUNTERS."+BS$,5:
  168.     FIELD#1,5 AS RR$
  169. 910    GET#1,MNUM:
  170.     LSET RR$ = STR$(VAL(RR$) + 1):
  171.     PUT#1,MNUM
  172. 920    GET#1,MSGS:
  173.     LSET RR$ = STR$(VAL(RR$) + 1):
  174.     PUT#1,MSGS:
  175.     CLOSE#1
  176. 930    PRINT "Updating msg file":
  177.     OPEN "R",1,"MESSAGES."+BS$,65:
  178.     RL = 65
  179. 940    FIELD#1,65 AS RR$
  180. 950    RE = MX + 7:
  181.     F = 0
  182. 960    OPEN "I",2,FIL$:
  183.     IF EOF(2) THEN
  184.         PRINT "File empty.":
  185.         CLOSE#1:
  186.         CLOSE#2:
  187.         END
  188. 970    IF EOF(2) THEN
  189.         S$ = "9999":
  190.         GOSUB 1260:
  191.         PUT #1,RE:
  192.         CLOSE #2:
  193.         GOTO 1010
  194. 980    LINE INPUT #2,S$
  195. 990    IF LEN(S$) > 63 THEN
  196.         S$ = LEFT$(S$,63)
  197. 1000    PRINT S$:
  198.     GOSUB 1260:
  199.     PUT #1,RE:
  200.     RE = RE + 1:
  201.     F = F + 1:
  202.     GOTO 970
  203. 1010    RE = MX + 1
  204. 1020    S$ = STR$(V + 1):
  205.     GOSUB 1260:
  206.     PUT#1,RE
  207. 1030    RE = RE + 1:
  208.     S$ = D$:
  209.     GOSUB 1260:
  210.     PUT#1,RE
  211. 1040    RE = RE + 1:
  212.     S$ = N$ + " " + O$:
  213.     GOSUB 1260:
  214.     PUT#1,RE
  215. 1050    RE = RE + 1:
  216.     S$ = T$:
  217.     GOSUB 1260:
  218.     PUT#1,RE
  219. 1060    RE = RE + 1:
  220.     S$ = K$:
  221.     GOSUB 1260:
  222.     PUT#1,RE:
  223.     RE = RE + 1:
  224.     S$ = STR$(F):
  225.     GOSUB 1260:
  226.     PUT#1,RE
  227. 1070    CLOSE #1
  228. 1080    IF PW$ <> "" THEN
  229.         PW$ = ";" + PW$
  230. 1090    PRINT "Updating summary file."
  231. 1100    OPEN "R",1,"SUMMARY."+BS$,30:
  232.     RE = 1:
  233.     FIELD#1,30 AS RR$:
  234.     RL = 30
  235. 1110    RE = MZ * 6 + 1:
  236.     S$ = STR$(V + 1) + PW$:
  237.     GOSUB 1260:
  238.     PUT#1,RE
  239. 1120    RE = RE + 1:
  240.     S$ = D$:
  241.     GOSUB 1260:
  242.     PUT#1,RE
  243. 1130    RE = RE + 1:
  244.     S$ = N$ + " " + O$:
  245.     GOSUB 1260:
  246.     PUT#1,RE
  247. 1140    RE = RE + 1:
  248.     S$ = T$:
  249.     GOSUB 1260:
  250.     PUT#1,RE
  251. 1150    RE = RE + 1:
  252.     S$ = K$:
  253.     GOSUB 1260:
  254.     PUT#1,RE
  255. 1160    RE = RE + 1:
  256.     S$ = STR$(F):
  257.     GOSUB 1260:
  258.     PUT#1,RE
  259. 1170    RE = RE + 1:
  260.     S$ = " 9999":
  261.     GOSUB 1260:
  262.     PUT#1,RE
  263. 1180    CLOSE#1
  264. 1190    MX = MX + F + 6:
  265.     MZ = MZ + 1:
  266.     M(MZ,1) = V + 1:
  267.     M(MZ,2) = F
  268. 1200    U = U + 1
  269. 1210    RETURN
  270. 1220 '
  271. 1230 ' Convert the string B$ to upper case
  272. 1240 '
  273. 1250    FOR ZZ=1 TO LEN(B$):
  274.         MID$(B$,ZZ,1) = CHR$(ASC(MID$(B$,ZZ,1)) + 32 * (ASC(MID$(B$,ZZ,1)) > 96)):
  275.     NEXT ZZ:
  276.     RETURN
  277. 1260 '
  278. 1270 ' FILL AND STORE DISK RECORD
  279. 1280 '
  280. 1290    LSET RR$ = LEFT$(S$ + SPACE$(RL - 2),RL - 2) + CHR$(13) + CHR$(10)
  281. 1300    RETURN
  282. 1310 '
  283. 1320 ' PURGE KILLED MESSAGES FROM FILES
  284. 1330 '
  285. 1340    IF PURGED THEN
  286.         PRINT "Files already purged.":
  287.         RETURN
  288. 1350    INPUT "Today's date (DD/MM/YY) ?",DATE$
  289. 1360    IF LEN(DATE$) > 8 THEN
  290.         PRINT "Must be less then 8 characters.":
  291.         GOTO 1350
  292. 1370    IF DATE$ = "" THEN
  293.         DATE$ = DT$
  294. 1380    OPEN "R",1,DATE$+".AR"+BS$
  295. 1390    IF LOF(1) > 0 THEN
  296.         PRINT "Archive file: ";DATE$ + ".ARC";" exists.":
  297.         CLOSE:
  298.         RETURN
  299. 1400    CLOSE
  300. 1410    MSGN = 1:
  301.     INPUT "Renumber messages?",PK$:
  302.     PK$ = MID$(PK$,1,1)
  303. 1420    IF PK$ = "y" THEN
  304.         PK$ = "Y"
  305. 1430    IF PK$ <> "Y" THEN
  306.         1460
  307. 1440    INPUT "Message number to start (CR=1)?",MSG$:
  308.     IF MSG$ = "" THEN
  309.         MSG$="1"
  310. 1450    MSGN = VAL(MSG$):
  311.     IF MSGN = 0 THEN
  312.         PRINT "Invalid msg #.":
  313.         RETURN
  314. 1460    PRINT "Purging summary file...":
  315.     OPEN "R",1,"SUMMARY."+BS$,30
  316. 1470    FIELD#1,30 AS R1$
  317. 1480    R1 = 1
  318. 1490    OPEN "R",2,"$SUMMARY.$$$",30
  319. 1500    FIELD#2,30 AS R2$
  320. 1510    R2 = 1
  321. 1520    PRINT SEP$:
  322.     GET#1,R1:
  323.     IF EOF(1) THEN
  324.         1650
  325. 1530    IF VAL(R1$) = 0 THEN
  326.         R1 = R1 + 6:
  327.         PRINT "Deletion":
  328.         GOTO 1520
  329. 1540    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  330.         IF INSTR(R1$,";") THEN
  331.             PASS$ = MID$(R1$,INSTR(R1$,";"),27)
  332.         ELSE
  333.             PASS$ = SPACE$(28)
  334. 1550    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  335.         LSET R2$ = LEFT$(STR$(MSGN) + PASS$,28) + CHR$(13) + CHR$(10):
  336.         MSGN = MSGN + 1:
  337.         GOTO 1570
  338. 1560    LSET R2$ = R1$
  339. 1570    PUT #2,R2
  340. 1580    PRINT LEFT$(R2$,28)
  341. 1590    IF VAL(R1$) > 9998 THEN
  342.         1650
  343. 1600    FOR I = 1 TO 5
  344. 1610        R1 = R1 + 1:
  345.         R2 = R2 + 1:
  346.         GET#1,R1:
  347.         LSET R2$ = R1$:
  348.         PUT#2,R2
  349. 1620        PRINT LEFT$(R2$,28)
  350. 1630    NEXT I
  351. 1640    R1 = R1 + 1:
  352.     R2 = R2 + 1:
  353.     GOTO 1520
  354. 1650    CLOSE:
  355.     OPEN "O",1,"SUMMARY.BAK":
  356.     CLOSE:
  357.     KILL "SUMMARY.BAK":
  358.     NAME "SUMMARY."+BS$ AS "SUMMARY.BAK":
  359.     NAME "$SUMMARY.$$$" AS "SUMMARY."+BS$
  360. 1660    PRINT "Purging message file...":
  361.     MSGN = VAL(MSG$)
  362. 1670    OPEN "R",1,"MESSAGES."+BS$,65:
  363.     FIELD #1,65 AS R1$
  364. 1680    OPEN "R",2,"$MESSAGS.$$$",65:
  365.     FIELD #2,65 AS R2$
  366. 1690    OPEN "O",3,DATE$+".AR"+BS$:
  367.     R1 = 1:
  368.     KIL = 0
  369. 1700    R1 = 1:
  370.     R2 = 1
  371. 1710    PRINT SEP$:
  372.     GET #1,R1:
  373.     IF EOF(1) THEN
  374.          1910
  375. 1720    IF VAL(R1$) = 0 THEN
  376.         KIL = -1:
  377.         PRINT "Archiving message":
  378.         GOTO 1780
  379. 1730    KIL = 0
  380. 1740    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  381.         IF INSTR(R1$,";") THEN
  382.             PASS$ = MID$(R1$,INSTR(R1$,";"),62)
  383.         ELSE
  384.             PASS$ = SPACE$(62)
  385. 1750    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  386.         LSET R2$ = LEFT$(STR$(MSGN) + PASS$,63) + CHR$(13) + CHR$(10):
  387.         MSGN = MSGN + 1:
  388.         PRINT LEFT$(R2$,63):
  389.         GOTO 1770
  390. 1760    LSET R2$ = R1$:
  391.     PRINT LEFT$(R2$,6)
  392. 1770    PUT #2,R2
  393. 1780    IF KIL THEN
  394.         GOSUB 2360:
  395.         PRINT #3,KL$
  396. 1790    IF VAL(R1$) > 9998 THEN
  397.         1910
  398. 1800    FOR I = 1 TO 5
  399. 1810        R1 = R1 + 1:
  400.         IF NOT KIL THEN
  401.             R2 = R2 + 1
  402. 1820        GET #1,R1:
  403.         IF KIL THEN
  404.             GOSUB 2360:
  405.             PRINT #3,KL$:
  406.             GOTO 1840
  407. 1830        LSET R2$ = R1$:
  408.         PUT #2,R2:
  409.         PRINT LEFT$(R2$,63)
  410. 1840    NEXT I
  411. 1850    FOR I = 1 TO VAL(R1$):
  412.         R1 = R1 + 1:
  413.         IF NOT KIL THEN
  414.             R2 = R2 + 1
  415. 1860        GET #1,R1:
  416.         IF KIL THEN
  417.             GOSUB 2360:
  418.             PRINT #3,KL$:
  419.             GOTO 1880
  420. 1870        LSET R2$ = R1$:
  421.         PUT #2,R2:
  422.         PRINT LEFT$(R2$,63)
  423. 1880    NEXT I:
  424.     R1 = R1 + 1:
  425.     IF NOT KIL THEN
  426.         R2 = R2 + 1
  427. 1890    GOTO 1710
  428. 1900 '
  429. 1910    CLOSE:
  430.     OPEN "O",1,"MESSAGES.BAK":
  431.     CLOSE:
  432.     KILL "MESSAGES.BAK":
  433.     NAME "MESSAGES."+BS$ AS "MESSAGES.BAK":
  434.     NAME "$MESSAGS.$$$" AS "MESSAGES."+BS$
  435. 1920    PRINT "Updating counters..."
  436. 1930    OPEN "O",1,"COUNTERS.BAK":
  437.     CLOSE:
  438.     KILL "COUNTERS.BAK"
  439. 1940    OPEN "R",1,"COUNTERS."+BS$,15:
  440.     FIELD #1,10 AS C1$,5 AS C2$
  441. 1950    OPEN "R",2,"COUNTERS.BAK",15:
  442.     FIELD #2,15 AS R2$
  443. 1960    GET #1,1:
  444.     LSET R2$ = C1$ + C2$:
  445.     PUT #2,1
  446. 1970    IF PK$ = "Y" THEN
  447.         LSET C2$ = STR$(MSGN - 1):
  448.         PUT #1,1
  449. 1980    CLOSE
  450. 1990    PURGED = -1:
  451.     GOSUB 2260:
  452.     RETURN
  453. 2000 '
  454. 2010 ' BUILD SUMMARY FILE FROM MESSAGE FILE
  455. 2020 '
  456. 2030    PRINT "Building summary file..."
  457. 2040    OPEN "O",1,"SUMMARY.BAK":
  458.     CLOSE:
  459.     KILL "SUMMARY.BAK"
  460. 2050    OPEN "R",1,"MESSAGES."+BS$,65:
  461.     FIELD #1,65 AS R1$:
  462.     R1 = 1
  463. 2060    OPEN "R",2,"SUMMARY.$$$",30:
  464.     FIELD #2,30 AS R2$:
  465.     R2 = 1
  466. 2070    PRINT SEP$
  467. 2080    FOR I = 1 TO 6
  468. 2090        GET #1,R1:
  469.         IF EOF(1) THEN
  470.             2140
  471. 2100        LSET R2$ = LEFT$(R1$,28) + CRLF$:
  472.         PUT #2,R2
  473. 2110        R1 = R1 + 1:
  474.         R2 = R2 + 1:
  475.         PRINT LEFT$(R2$,28):
  476.         IF EOF(1) THEN
  477.             2140
  478. 2120        IF I = 1 THEN
  479.             IF VAL(R1$) > 9998 THEN
  480.                 2140
  481. 2130    NEXT I:
  482.     R1 = R1 + VAL(R1$):
  483.     GOTO 2070
  484. 2140    CLOSE:
  485.     NAME "SUMMARY."+BS$ AS "SUMMARY.BAK":
  486.     NAME "SUMMARY.$$$" AS "SUMMARY."+BS$
  487. 2150    PRINT "Summary file built.":
  488.     RETURN
  489. 2160 '
  490. 2170 ' Error handlers
  491. 2180 '
  492. 2190    IF (ERL = 700) AND (ERR = 53) THEN
  493.         PRINT "File not found.":
  494.         RESUME 350
  495. 2200    IF (ERL = 590) AND (ERR = 53) THEN
  496.         PRINT "File not found.":
  497.         CLOSE:
  498.         RESUME 650
  499. 2210    IF (ERL = 2590) AND (ERR = 53) THEN
  500.         PRINT "You cannot rename a file that doesn't already exist":
  501.         RESUME 350
  502. 2220    IF (ERL = 2490) AND (ERR = 53) THEN
  503.         PRINT "That file doesn't exist so you can't erase it":
  504.         RESUME 350
  505. 2230    PRINT "Error number ";ERR;" in line number ";ERL
  506. 2240    RESUME 350
  507. 2250 '
  508. 2260 ' build message index
  509. 2270 '
  510. 2280    MX = 0:
  511.     MZ = 0
  512. 2290    OPEN "R",1,"SUMMARY."+BS$,30:
  513.     RE = 1:
  514.     FIELD#1,28 AS RR$
  515. 2300    GET#1,RE:
  516.     IF EOF(1) THEN
  517.         2340
  518. 2310    G = VAL(RR$):
  519.     MZ = MZ + 1:
  520.     M(MZ,1) = G:
  521.     IF G = 0 THEN
  522.         2330
  523. 2320    IF G > 9998 THEN
  524.         MZ = MZ - 1:
  525.         GOTO 2340
  526. 2330    GET#1,RE + 5:
  527.     M(MZ,2) = VAL(RR$):
  528.     MX = MX + M(MZ,2) + 6:
  529.     RE = RE + 6:
  530.     GOTO 2300
  531. 2340    CLOSE:
  532.     RETURN
  533. 2350 '
  534. 2360 ' unpack record
  535. 2370 '
  536. 2380    ZZ = LEN(R1$) - 2
  537. 2390    WHILE MID$(R1$,ZZ,1) = " "
  538. 2400    ZZ = ZZ - 1:
  539.     IF ZZ = 1 THEN
  540.         2420
  541. 2410    WEND
  542. 2420    KL$ = LEFT$(R1$,ZZ)
  543. 2430    RETURN
  544. 2440    '
  545. 2450    ' Kill (Erase) a file
  546. 2460    '
  547. 2470    B$ = MID$(PROMPT$,3):
  548.     IF B$ = "" THEN
  549.         INPUT "Filename? ",B$:
  550.         PRINT
  551. 2480    IF B$ = "" THEN
  552.         RETURN
  553.     ELSE
  554.         GOSUB 1250:
  555.         FILN$ = B$
  556. 2490    KILL FILN$
  557. 2500    PRINT
  558. 2510    RETURN
  559. 2520    '
  560. 2530    ' Rename a file
  561. 2540    '
  562. 2550    INPUT "Existing Filename? ",B$:
  563.     PRINT
  564. 2560    IF B$ = "" THEN
  565.         RETURN
  566.     ELSE
  567.         GOSUB 1250:
  568.         EFILN$ = B$
  569. 2570    PRINT:
  570.     INPUT "New Filename? ",B$:
  571.     PRINT
  572. 2580    IF B$ = "" THEN
  573.         RETURN
  574.     ELSE
  575.         GOSUB 1250:
  576.         NFILN$ = B$
  577. 2590    NAME EFILN$ AS NFILN$
  578. 2600    PRINT:
  579.     RETURN
  580. 2610 REM
  581. 2620 REM     ===>  UNKILL A MESSAGE
  582. 2630 REM
  583. 2640 PRINT"Unerased messages:":PRINT
  584. 2645 V=0
  585. 2650 OPEN"R",1,DSK2$+"SUMMARY."+BS$,30:RE=1:FIELD#1,30 AS RR$:RL=30
  586. 2660 GET#1,RE
  587. 2665 IF LEFT$(RR$,5)=" 9999"THEN 2800
  588. 2670 IF LEFT$(RR$,3)<>" 0:"THEN RE=RE+1:GOTO 2660
  589. 2680 A=INSTR(RR$,";"):IF A=0 THEN A=10
  590. 2685 ZZ$=MID$(RR$,5,A-6):PRINT ZZ$
  591. 2690 FOR A=1 TO 5:RE=RE+1:GET#1,RE
  592. 2700 IF A=1 THEN PRINT"sent:   "RR$;
  593. 2710 IF A=2 THEN PRINT"from:   "RR$;
  594. 2720 IF A=3 THEN PRINT"to:     "RR$;
  595. 2730 IF A=4 THEN PRINT"re:     "RR$;
  596. 2740 IF A=5 THEN PRINT
  597. 2750 NEXT A
  598. 2760 RE=RE+1
  599. 2770 GOTO 2660
  600. 2800 CLOSE:INPUT"Unerase message #:  ";M$
  601. 2805 IF M$=""THEN 350
  602. 2806 OPEN"R",1,"SUMMARY."+BS$,30:FIELD#1,30 AS RR$
  603. 2807 PRINT"updating summary...";
  604. 2810 RE=1
  605. 2820 GET#1,RE
  606. 2825 IF LEFT$(RR$,5)=" 9999"THEN PRINT"not found":GOTO 2800
  607. 2830 A=INSTR(RR$,":"):IF A=0 THEN A=INSTR(RR$,",")
  608. 2840 ZZ$=LEFT$(RR$,4+LEN(M$))
  609. 2850 IF ZZ$<>" 0: "+M$ THEN RE=RE+6:GOTO 2820
  610. 2860 LSET RR$=RIGHT$(RR$,26)
  611. 2870 PUT#1,RE
  612. 2880 CLOSE
  613. 2885 PRINT"updating messages...";
  614. 2890 OPEN"R",1,"MESSAGES."+BS$,65:FIELD#1,65 AS RR$
  615. 2900 RE=1
  616. 2910 GET#1,RE
  617. 2915 IF LEFT$(RR$,5)=" 9999"THEN CLOSE:GOTO 2950
  618. 2920 IF LEFT$(RR$,4+LEN(M$))=" 0: "+M$ THEN LSET RR$=RIGHT$(RR$,61):PUT#1,RE:
  619.      CLOSE:
  620.      GOTO 2950
  621. 2930 RE=RE+1
  622. 2940 GOTO 2910
  623. 2950 PRINT"updating counters...";
  624. 2960 OPEN"R",1,DSK2$+"COUNTERS",5:FIELD#1,5 AS RR$
  625. 2970 GET#1,1
  626. 2980 LSET RR$=STR$(VAL(RR$)+1):PUT#1,1
  627. 2985 CLOSE
  628. 2990 PRINT:PRINT"message unerased.":GOTO 2800
  629. 3000 PRINT "CHANGE BASES..."
  630. 3010 PRINT "Make SURE that you don't go above the number of bases..."
  631. 3020 PRINT:PRINT "BASE:";:INPUT B
  632. 3030 BS$=STR$(B)
  633. 3040 GOTO 350
  634. Make SURE that you don't go above the number of bases..."
  635. 3020 PRINT:PRINT