home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol128 / util.bqs / UTIL.BAS
Encoding:
BASIC Source File  |  1985-02-10  |  14.1 KB  |  673 lines
  1. 160 '
  2. 180 ' RBBSUTIL.BAS ==> UTILITY PROGRAM FOR THE RBBS REMOTE BULLETIN BOARD SYS
  3. 200 ' BY RON FOWLER, WESTLAND, MICH RBBS (313)-729-1905 (RINGBACK)
  4. 220 ' Please report any problems, bugs, fixes, etc. to the above RBBS if
  5. 221 ' if in USA or to: 
  6. 230 ' Bill Bolton, "Software Tools" RCPM (02)997-1836 (modem)
  7. 235 ' if in Australia
  8. 240 '
  9. 260 ' 06/Jun/82
  10. 280 ' Passwords in messages were being killed during purges only if
  11. 300 ' the messages were renumbered, fixed now. Added code to 
  12. 320 ' read date from LASTCALR (lifted from MINIRBBS) and default
  13. 340 ' to current date if new date not specifically entered. Added
  14. 360 ' password check so that this utility can be left out for remote
  15. 380 ' use (but make it an unusual name, SYS and TAG as well).
  16. 400 ' Bill Bolton (Australia)
  17. 420 '
  18. 430 ' 14/Jun/82
  19. 440 ' Upper case conversion added to file name entered with D option
  20. 445 ' and UTIL status permanetly written to CALLERS for those who
  21. 446 ' find this file. Also TW status written to LASTCALR and 
  22. 447 ' immediate log out for those that ignore warning. Bill Bolton
  23. 450 '
  24. 460 ' 21/Mar/82
  25. 470 ' Added password check for "*" in messages to ALL. Version 2.5
  26. 480 ' Bill Bolton
  27. 490 '
  28. 500 ' 07/Jul/83
  29. 510 ' Added more stringent password check from ENTRBBS version 3.1
  30. 520 ' and fixed some bugs in the command processor code. Added freeze
  31. 530 ' and abort code to D option. Added uppercase conversion to F
  32. 540 ' option. Version 2.6 Bill Bolton
  33. 550 '
  34. 560 ' 13/Jul/83
  35. 570 ' Added file renaming and deletion options. Version 2.7 Bill Bolton
  36. 580 '
  37. 980    DEFINT A-Z
  38. 990    VERS$ = "Vers 2.7"
  39. 1000    ON ERROR GOTO 4030
  40. 1010    DIM M(200,2)
  41. 1020    SEP$ = "=============================================="
  42. 1030    CRLF$ = CHR$(13) + CHR$(10)
  43. 1040    PURGED = 0:
  44.  
  45.     BACKUP = 0
  46. 1050    GOSUB 4210        ' BUILD MSG INDEX
  47. 1060    N$ = "SYSOP":
  48.  
  49.     O$ = "":
  50.  
  51.     MAGIC$ = "SUPER"
  52. 1070    GOSUB 4390        'Test for SYSOP
  53. 1080    PRINT:
  54.  
  55.     PRINT "             RCPM Utilty ";VERS$
  56. 1090    PRINT SEP$
  57. 1100    MSGS = 1:
  58.  
  59.     CALLS = MSGS + 1:
  60.  
  61.     MNUM = CALLS + 1
  62. 1110    PRINT:
  63.  
  64.     INPUT "Command? ",PROMPT$
  65. 1120    PRINT:
  66.  
  67.     PRINT:
  68.  
  69.     IF PROMPT$ = "" THEN
  70.  
  71.         GOSUB 1160:
  72.  
  73.         GOTO 1110
  74. 1130    B$ = MID$(PROMPT$,1,1):
  75.  
  76.     GOSUB 2330:
  77.  
  78.     SM$ = B$:
  79.  
  80.     SM = INSTR ("TFDPEBKRA",SM$):
  81.  
  82.     GOSUB 1140:
  83.  
  84.     GOTO 1110
  85. 1140    IF SM = 0 THEN
  86.  
  87.         1160
  88. 1150    ON SM GOTO 1730,1630,1430,2500,1300,3210,4800,4900
  89. 1160    PRINT:
  90.  
  91.     PRINT "Commands allowed are:"
  92. 1170    PRINT "B   ==> build summary file from message file"
  93. 1180    PRINT "D   ==> display an ascii file"
  94. 1190    PRINT "E   ==> end the utility program"
  95. 1200    PRINT "F   ==> prints the disk directory
  96. 1210    PRINT "K   ==> kill a file"
  97. 1220    PRINT "P   ==> purge the message files"
  98. 1230    PRINT "R   ==> rename a file"
  99. 1240    PRINT "T   ==> transfers a disk file to the message file"
  100. 1250    RETURN
  101. 1260 '
  102. 1300 ' END OF PROGRAM
  103. 1310 '
  104. 1320    PRINT:
  105.  
  106.     PRINT:
  107.  
  108.     END
  109. 1400 '
  110. 1410 ' DISPLAY A FILE
  111. 1420 '
  112. 1430    B$ = MID$(PROMPT$,2):
  113.  
  114.     IF B$ = "" THEN
  115.  
  116.         INPUT "Filename? ",B$:
  117.  
  118.         PRINT
  119. 1440    IF B$ = "" THEN
  120.  
  121.         RETURN
  122.  
  123.     ELSE
  124.  
  125.         GOSUB 2330:
  126.  
  127.         FILN$ = B$
  128. 1450    OPEN "I",1,FILN$
  129. 1460    IF EOF(1) THEN
  130.  
  131.         1500
  132. 1470    BI = ASC(INKEY$+" "):
  133.  
  134.     IF BI = 19 THEN
  135.  
  136.         BI = ASC(INPUT$(1))
  137. 1480    IF BI = 11 THEN
  138.  
  139.         PRINT:
  140.  
  141.         PRINT "++ Aborted ++":
  142.  
  143.         PRINT:
  144.  
  145.         CLOSE:
  146.  
  147.         RETURN
  148. 1490    LINE INPUT #1,LIN$:
  149.  
  150.     PRINT LIN$:
  151.  
  152.     GOTO 1460
  153. 1500    CLOSE:
  154.  
  155.     PRINT:
  156.  
  157.     PRINT:
  158.  
  159.     PRINT "++ End Of File ++":
  160.  
  161.     PRINT
  162. 1510    RETURN
  163. 1600 '
  164. 1610 ' DISPLAY DIRECTORY
  165. 1620 '
  166. 1630    B$ = PROMPT$:
  167.  
  168.     GOSUB 2330:
  169.  
  170.     IF LEN(B$) > 1 THEN
  171.  
  172.         SPEC$ = MID$(B$,3)
  173.  
  174.     ELSE
  175.  
  176.         SPEC$ = "*.*"
  177. 1640    FILES SPEC$:
  178.  
  179.     PRINT:
  180.  
  181.     RETURN
  182. 1700 '
  183. 1710 ' TRANSFER A DISK FILE
  184. 1720 '
  185. 1730    PRINT "Active # of msg's ";:
  186.  
  187.     OPEN "R",1,"COUNTERS",5:
  188.  
  189.     FIELD#1,5 AS RR$:
  190.  
  191.     GET#1,MSGS:
  192.  
  193.     M = VAL(RR$)
  194. 1740    PRINT STR"$(M) + " "
  195. 1750    PRINT "Last caller was # ";:
  196.  
  197.     GET#1,CALLS:
  198.  
  199.     PRINT STR$(VAL(RR$))
  200. 1760    PRINT "This msg # will be ";:
  201.  
  202.     GET#1,MNUM:
  203.  
  204.     U = VAL(RR$):
  205.  
  206.     PRINT STR$(U + 1):
  207.  
  208.     CLOSE
  209. 1800 '
  210. 1810 ' ***ENTER A NEW MESSAGE***
  211. 1820 '
  212. 1830    IF NOT PURGED THEN
  213.  
  214.         PRINT "Files must be purged before messages can be added":
  215.  
  216.         RETURN
  217. 1840    OPEN "R",1,"COUNTERS",5:
  218.  
  219.     PRINT "Msg # will be ";:
  220.  
  221.     FIELD#1,5 AS RR$:
  222.  
  223.     GET#1,MNUM:
  224.  
  225.     V = VAL(RR$)
  226. 1850    PRINT STR$(V + 1):
  227.  
  228.     CLOSE
  229. 1860    INPUT "Message file name? ",B$:
  230.  
  231.     GOSUB 2330:
  232.  
  233.     FIL$ = B$
  234. 1870    INPUT "Todays date (DD/MM/YY)?",B$:
  235.  
  236.     GOSUB 2330:
  237.  
  238.     IF B$ = "" THEN
  239.  
  240.         D$ = DT$
  241.  
  242.     ELSE
  243.  
  244.         D$ = B$
  245. 1880    INPUT "Who to (C/R for ALL)?";B$:
  246.  
  247.     GOSUB 2330:
  248.  
  249.     IF B$ = "" THEN
  250.  
  251.         T$ = "ALL"
  252.  
  253.     ELSE
  254.  
  255.         T$ = B$
  256. 1890    INPUT "Subject?",B$:
  257.  
  258.     GOSUB 2330:
  259.  
  260.     K$ = B$
  261. 1900    INPUT "Password?",B$:
  262.  
  263.     GOSUB 2330:
  264.  
  265.     PW$ = B$:
  266.  
  267.     IF T$ = "ALL" AND LEFT$(PW$,1) = "*" THEN
  268.  
  269.         PRINT CHR$(7);"You CANNOT use '*' with ALL.":
  270.  
  271.         GOTO 1900
  272. 1910    F = 0            ' F IS MESSAGE LENGTH
  273. 1920    PRINT "Updating counters":
  274.  
  275.     OPEN "R",1,"COUNTERS",5:
  276.  
  277.     FIELD#1,5 AS RR$
  278. 1930    GET#1,MNUM:
  279.  
  280.     LSET RR$ = STR$(VAL(RR$) + 1):
  281.  
  282.     PUT#1,MNUM
  283. 1940    GET#1,MSGS:
  284.  
  285.     LSET RR$ = STR$(VAL(RR$) + 1):
  286.  
  287.     PUT#1,MSGS:
  288.  
  289.     CLOSE#1
  290. 1950    PRINT "Updating msg file":
  291.  
  292.     OPEN "R",1,"MESSAGES",65:
  293.  
  294.     RL = 65
  295. 1960    FIELD#1,65 AS RR$
  296. 1970    RE = MX + 7:
  297.  
  298.     F = 0
  299. 1980    OPEN "I",2,FIL$:
  300.  
  301.     IF EOF(2) THEN
  302.  
  303.         PRINT "File empty.":
  304.  
  305.         CLOSE#1:
  306.  
  307.         CLOSE#2:
  308.  
  309.         END
  310. 1990    IF EOF(2) THEN
  311.  
  312.         S$ = "9999":
  313.  
  314.         GOSUB 2400:
  315.  
  316.         PUT #1,RE:
  317.  
  318.         CLOSE #2:
  319.  
  320.         GOTO 2030
  321. 2000    LINE INPUT #2,S$
  322. 2010    IF LEN(S$) > 63 THEN
  323.  
  324.         S$ = LEFT$(S$,63)
  325. 2020    PRINT S$:
  326.  
  327.     GOSUB 2400:
  328.  
  329.     PUT #1,RE:
  330.  
  331.     RE = RE + 1:
  332.  
  333.     F = F + 1:
  334.  
  335.     GOTO 1990
  336. 2030    RE = MX + 1
  337. 2040    S$ = STR$(V + 1):
  338.  
  339.     GOSUB 2400:
  340.  
  341.     PUT#1,RE
  342. 2050    RE = RE + 1:
  343.  
  344.     S$ = D$:
  345.  
  346.     GOSUB 2400:
  347.  
  348.     PUT#1,RE
  349. 2060    RE = RE + 1:
  350.  
  351.     S$ = N$ + " " + O$:
  352.  
  353.     GOSUB 2400:
  354.  
  355.     PUT#1,RE
  356. 2070    RE = RE + 1:
  357.  
  358.     S$ = T$:
  359.  
  360.     GOSUB 2400:
  361.  
  362.     PUT#1,RE
  363. 2080    RE = RE + 1:
  364.  
  365.     S$ = K$:
  366.  
  367.     GOSUB 2400:
  368.  
  369.     PUT#1,RE:
  370.  
  371.     RE = RE + 1:
  372.  
  373.     S$ = STR$(F):
  374.  
  375.     GOSUB 2400:
  376.  
  377.     PUT#1,RE
  378. 2090    CLOSE #1
  379. 2100    IF PW$ <> "" THEN
  380.  
  381.         PW$ = ";" + PW$
  382. 2110    PRINT "Updating summary file."
  383. 2120    OPEN "R",1,"SUMMARY",30:
  384.  
  385.     RE = 1:
  386.  
  387.     FIELD#1,30 AS RR$:
  388.  
  389.     RL = 30
  390. 2130    RE = MZ * 6 + 1:
  391.  
  392.     S$ = STR$(V + 1) + PW$:
  393.  
  394.     GOSUB 2400:
  395.  
  396.     PUT#1,RE
  397. 2140    RE = RE + 1:
  398.  
  399.     S$ = D$:
  400.  
  401.     GOSUB 2400:
  402.  
  403.     PUT#1,RE
  404. 2150    RE = RE + 1:
  405.  
  406.     S$ = N$ + " " + O$:
  407.  
  408.     GOSUB 2400:
  409.  
  410.     PUT#1,RE
  411. 2160    RE = RE + 1:
  412.  
  413.     S$ = T$:
  414.  
  415.     GOSUB 2400:
  416.  
  417.     PUT#1,RE
  418. 2170    RE = RE + 1:
  419.  
  420.     S$ = K$:
  421.  
  422.     GOSUB 2400:
  423.  
  424.     PUT#1,RE
  425. 2180    RE = RE + 1:
  426.  
  427.     S$ = STR$(F):
  428.  
  429.     GOSUB 2400:
  430.  
  431.     PUT#1,RE
  432. 2190    RE = RE + 1:
  433.  
  434.     S$ = " 9999":
  435.  
  436.     GOSUB 2400:
  437.  
  438.     PUT#1,RE
  439. 2200    CLOSE#1
  440. 2210    MX = MX + F + 6:
  441.  
  442.     MZ = MZ + 1:
  443.  
  444.     M(MZ,1) = V + 1:
  445.  
  446.     M(MZ,2) = F
  447. 2220    U = U + 1
  448. 2230    RETURN
  449. 2300 '
  450. 2310 ' Convert the string B$ to upper case
  451. 2320 '
  452. 2330    FOR ZZ=1 TO LEN(B$):
  453.  
  454.         MID$(B$,ZZ,1) = CHR$(ASC(MID$(B$,ZZ,1)) + 32 * (ASC(MID$(B$,ZZ,1)) > 96)):
  455.  
  456.     NEXT ZZ:
  457.  
  458.     RETURN
  459. 2400 '
  460. 2410 ' FILL AND STORE DISK RECORD
  461. 2420 '
  462. 2430    LSET RR$ = LEFT$(S$ + SPACE$(RL - 2),RL - 2) + CHR$(13) + CHR$(10)
  463. 2440    RETURN
  464. 2500 '
  465. 2510 ' PURGE KILLED MESSAGES FROM FILES
  466. 2520 '
  467. 2530    IF PURGED THEN
  468.  
  469.         PRINT "Files already purged.":
  470.  
  471.         RETURN
  472. 2540    INPUT "Today's date (DD/MM/YY) ?",DATE$
  473. 2550    IF LEN(DATE$) > 8 THEN
  474.  
  475.         PRINT "Must be less then 8 characters.":
  476.  
  477.         GOTO 2540
  478. 2560    IF DATE$ = "" THEN
  479.  
  480.         DATE$ = DT$
  481. 2570    OPEN "R",1,DATE$+".ARC"
  482. 2580    IF LOF(1) > 0 THEN
  483.  
  484.         PRINT "Archive file: ";DATE$ + ".ARC";" exists.":
  485.  
  486.         CLOSE:
  487.  
  488.         RETURN
  489. 2590    CLOSE
  490. 2600    MSGN = 1:
  491.  
  492.     INPUT "Renumber messages?",PK$:
  493.  
  494.     PK$ = MID$(PK$,1,1)
  495. 2610    IF PK$ = "y" THEN
  496.  
  497.         PK$ = "Y"
  498. 2620    IF PK$ <> "Y" THEN
  499.  
  500.         2650
  501. 2630    INPUT "Message number to start (CR=1)?",MSG$:
  502.  
  503.     IF MSG$ = "" THEN
  504.  
  505.         MSG$="1"
  506. 2640    MSGN = VAL(MSG$):
  507.  
  508.     IF MSGN = 0 THEN
  509.  
  510.         PRINT "Invalid msg #.":
  511.  
  512.         RETURN
  513. 2650    PRINT "Purging summary file...":
  514.  
  515.     OPEN "R",1,"SUMMARY",30
  516. 2660    FIELD#1,30 AS R1$
  517. 2670    R1 = 1
  518. 2680    OPEN "R",2,"$SUMMARY.$$$",30
  519. 2690    FIELD#2,30 AS R2$
  520. 2700    R2 = 1
  521. 2710    PRINT SEP$:
  522.  
  523.     GET#1,R1:
  524.  
  525.     IF EOF(1) THEN
  526.  
  527.         2840
  528. 2720    IF VAL(R1$) = 0 THEN
  529.  
  530.         R1 = R1 + 6:
  531.  
  532.         PRINT "Deletion":
  533.  
  534.         GOTO 2710
  535. 2730    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  536.  
  537.         IF INSTR(R1$,";") THEN
  538.  
  539.             PASS$ = MID$(R1$,INSTR(R1$,";"),27)
  540.  
  541.         ELSE
  542.  
  543.             PASS$ = SPACE$(28)
  544. 2740    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  545.  
  546.         LSET R2$ = LEFT$(STR$(MSGN) + PASS$,28) + CHR$(13) + CHR$(10):
  547.  
  548.         MSGN = MSGN + 1:
  549.  
  550.         GOTO 2760
  551. 2750    LSET R2$ = R1$
  552. 2760    PUT #2,R2
  553. 2770    PRINT LEFT$(R2$,28)
  554. 2780    IF VAL(R1$) > 9998 THEN
  555.  
  556.         2840
  557. 2790    FOR I = 1 TO 5
  558. 2800        R1 = R1 + 1:
  559.  
  560.         R2 = R2 + 1:
  561.  
  562.         GET#1,R1:
  563.  
  564.         LSET R2$ = R1$:
  565.  
  566.         PUT#2,R2
  567. 2810        PRINT LEFT$(R2$,28)
  568. 2820    NEXT I
  569. 2830    R1 = R1 + 1:
  570.  
  571.     R2 = R2 + 1:
  572.  
  573.     GOTO 2710
  574. 2840    CLOSE:
  575.  
  576.     OPEN "O",1,"SUMMARY.BAK":
  577.  
  578.     CLOSE:
  579.  
  580.     KILL "SUMMARY.BAK":
  581.  
  582.     NAME "SUMMARY" AS "SUMMARY.BAK":
  583.  
  584.     NAME "$SUMMARY.$$$" AS "SUMMARY"
  585. 2850    PRINT "Purging message file...":
  586.  
  587.     MSGN = VAL(MSG$)
  588. 2860    OPEN "R",1,"MESSAGES",65:
  589.  
  590.     FIELD #1,65 AS R1$
  591. 2870    OPEN "R",2,"$MESSAGS.$$$",65:
  592.  
  593.     FIELD #2,65 AS R2$
  594. 2880    OPEN "O",3,DATE$+".ARC":
  595.  
  596.     R1 = 1:
  597.  
  598.     KIL = 0
  599. 2890    R1 = 1:
  600.  
  601.     R2 = 1
  602. 2900    PRINT SEP$:
  603.  
  604.     GET #1,R1:
  605.  
  606.     IF EOF(1) THEN
  607.  
  608.          3100
  609. 2910    IF VAL(R1$) = 0 THEN
  610.  
  611.         KIL = -1:
  612.  
  613.         PRINT "Archiving message":
  614.  
  615.         GOTO 2970
  616. 2920    KIL = 0
  617. 2930    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  618.  
  619.         IF INSTR(R1$,";") THEN
  620.  
  621.             PASS$ = MID$(R1$,INSTR(R1$,";"),62)
  622.  
  623.         ELSE
  624.  
  625.             PASS$ = SPACE$(62)
  626. 2940    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  627.  
  628.         LSET R2$ = LEFT$(STR$(MSGN) + PASS$,63) + CHR$(13) + CHR$(10):
  629.  
  630.         MSGN = MSGN + 1:
  631.  
  632.         PRINT LEFT$(R2$,63):
  633.  
  634.         GOTO 2960
  635. 2950    LSET R2$ = R1$:
  636.  
  637.     PRINT LEFT$(R2$,6)
  638. 2960    PUT #2,R2
  639. 2970    IF KIL THEN
  640.  
  641.         GOSUB 4310:
  642.  
  643.         PRINT #3,KL$
  644. 2980    IF VAL(R1$) > 9998 THEN
  645.  
  646.         3100
  647. 2990    FOR I = 1 TO 5
  648. 3000        R1 = R1 + 1:
  649.  
  650.         IF NOT KIL THEN
  651.  
  652.             R2 = R2 + 1
  653. 3010        GET #1,R1:
  654.  
  655.         IF KIL THEN
  656.  
  657.             GOSUB 4310:
  658.  
  659.             PRINT #3,KL$:
  660.  
  661.             GOTO 3030
  662. 3020        LSET R2$ = R1$:
  663.  
  664.         PUT #2,R2:
  665.  
  666.         PRINT LEFT$(R2$,63)
  667. 3030    NEXT I
  668. 3040    FOR I = 1 TO VAL(R1$):
  669.  
  670.         R1 = R1 + 1:
  671.  
  672.         IF NOT KIL THEN
  673.  
  674.             R2 = R2 + 1
  675. 3050        GET #1,R1:
  676.  
  677.         IF KIL THEN
  678.  
  679.             GOSUB 4310:
  680.  
  681.             PRINT #3,KL$:
  682.  
  683.             GOTO 3070
  684. 3060        LSET R2$ = R1$:
  685.  
  686.         PUT #2,R2:
  687.  
  688.         PRINT LEFT$(R2$,63)
  689. 3070    NEXT I:
  690.  
  691.     R1 = R1 + 1:
  692.  
  693.     IF NOT KIL THEN
  694.  
  695.         R2 = R2 + 1
  696. 3080    GOTO 2900
  697. 3090 '
  698. 3100    CLOSE:
  699.  
  700.     OPEN "O",1,"MESSAGES.BAK":
  701.  
  702.     CLOSE:
  703.  
  704.     KILL "MESSAGES.BAK":
  705.  
  706.     NAME "MESSAGES" AS "MESSAGES.BAK":
  707.  
  708.     NAME "$MESSAGS.$$$" AS "MESSAGES"
  709. 3110    PRINT "Updating counters..."
  710. 3120    OPEN "O",1,"COUNTERS.BAK":
  711.  
  712.     CLOSE:
  713.  
  714.     KILL "COUNTERS.BAK"
  715. 3130    OPEN "R",1,"COUNTERS",15:
  716.  
  717.     FIELD #1,10 AS C1$,5 AS C2$
  718. 3140    OPEN "R",2,"COUNTERS.BAK",15:
  719.  
  720.     FIELD #2,15 AS R2$
  721. 3150    GET #1,1:
  722.  
  723.     LSET R2$ = C1$ + C2$:
  724.  
  725.     PUT #2,1
  726. 3160    IF PK$ = "Y" THEN
  727.  
  728.         LSET C2$ = STR$(MSGN - 1):
  729.  
  730.         PUT #1,1
  731. 3170    CLOSE
  732. 3180    PURGED = -1:
  733.  
  734.     GOSUB 4210:
  735.  
  736.     RETURN
  737. 3200 '
  738. 3210 ' BUILD SUMMARY FILE FROM MESSAGE FILE
  739. 3220 '
  740. 3230    PRINT "Building summary file..."
  741. 3240    OPEN "O",1,"SUMMARY.BAK":
  742.  
  743.     CLOSE:
  744.  
  745.     KILL "SUMMARY.BAK"
  746. 3250    OPEN "R",1,"MESSAGES",65:
  747.  
  748.     FIELD #1,65 AS R1$:
  749.  
  750.     R1 = 1
  751. 3260    OPEN "R",2,"SUMMARY.$$$",30:
  752.  
  753.     FIELD #2,30 AS R2$:
  754.  
  755.     R2 = 1
  756. 3270    PRINT SEP$
  757. 3280    FOR I = 1 TO 6
  758. 3290        GET #1,R1:
  759.  
  760.         IF EOF(1) THEN
  761.  
  762.             3340
  763. 3300        LSET R2$ = LEFT$(R1$,28) + CRLF$:
  764.  
  765.         PUT #2,R2
  766. 3310        R1 = R1 + 1:
  767.  
  768.         R2 = R2 + 1:
  769.  
  770.         PRINT LEFT$(R2$,28):
  771.  
  772.         IF EOF(1) THEN
  773.  
  774.             3340
  775. 3320        IF I = 1 THEN
  776.  
  777.             IF VAL(R1$) > 9998 THEN
  778.  
  779.                 3340
  780. 3330    NEXT I:
  781.  
  782.     R1 = R1 + VAL(R1$):
  783.  
  784.     GOTO 3270
  785. 3340    CLOSE:
  786.  
  787.     NAME "SUMMARY" AS "SUMMARY.BAK":
  788.  
  789.     NAME "SUMMARY.$$$" AS "SUMMARY"
  790. 3350    PRINT "Summary file built.":
  791.  
  792.     RETURN
  793. 4000 '
  794. 4010 ' Error handlers
  795. 4020 '
  796. 4030    IF (ERL = 1640) AND (ERR = 53) THEN
  797.  
  798.         PRINT "File not found.":
  799.  
  800.         RESUME 1110
  801. 4040    IF (ERL = 1450) AND (ERR = 53) THEN
  802.  
  803.         PRINT "File not found.":
  804.  
  805.         CLOSE:
  806.  
  807.         RESUME 1510
  808. 4050    IF (ERL = 4970) AND (ERR = 53) THEN
  809.  
  810.         PRINT "You cannot rename a file that doesn't already exist":
  811.  
  812.         RESUME 1110
  813. 4060    IF (ERL = 4850) AND (ERR = 53) THEN
  814.  
  815.         PRINT "That file doesn't exist so you can't erase it":
  816.  
  817.         RESUME 1110
  818. 4070    PRINT "Error number ";ERR;" in line number ";ERL
  819. 4080    RESUME 1110
  820. 4200 '
  821. 4210 ' build message index
  822. 4220 '
  823. 4230    MX = 0:
  824.  
  825.     MZ = 0
  826. 4240    OPEN "R",1,"SUMMARY",30:
  827.  
  828.     RE = 1:
  829.  
  830.     FIELD#1,28 AS RR$
  831. 4250    GET#1,RE:
  832.  
  833.     IF EOF(1) THEN
  834.  
  835.         4290
  836. 4260    G = VAL(RR$):
  837.  
  838.     MZ = MZ + 1:
  839.  
  840.     M(MZ,1) = G:
  841.  
  842.     IF G = 0 THEN
  843.  
  844.         4280
  845. 4270    IF G > 9998 THEN
  846.  
  847.         MZ = MZ - 1:
  848.  
  849.         GOTO 4290
  850. 4280    GET#1,RE + 5:
  851.  
  852.     M(MZ,2) = VAL(RR$):
  853.  
  854.     MX = MX + M(MZ,2) + 6:
  855.  
  856.     RE = RE + 6:
  857.  
  858.     GOTO 4250
  859. 4290    CLOSE:
  860.  
  861.     RETURN
  862. 4300 '
  863. 4310 ' unpack record
  864. 4320 '
  865. 4330    ZZ = LEN(R1$) - 2
  866. 4340    WHILE MID$(R1$,ZZ,1) = " "
  867. 4350    ZZ = ZZ - 1:
  868.  
  869.     IF ZZ = 1 THEN
  870.  
  871.         4370
  872. 4360    WEND
  873. 4370    KL$ = LEFT$(R1$,ZZ)
  874. 4380    RETURN
  875. 4390 '
  876. 4400 ' Test to only allow the SYSOP to use UTIL remotely
  877. 4410 '
  878. 4420    OPEN "I",1,"A:LASTCALR":
  879.  
  880.     INPUT #1,N$,O$,F$,DT$:
  881.  
  882.     CLOSE
  883. 4430    OPEN "I",1,"A:PWDS":
  884.  
  885.     INPUT #1,P1$,P2$:
  886.  
  887.     CLOSE #1
  888. 4440    PRINT
  889. 4450    IF N$ = MAGIC$ AND O$ = "" THEN
  890.  
  891.             GOSUB 4610:
  892.  
  893.             IF SYSOP = 1 THEN
  894.  
  895.                 RETURN
  896. 4460    PRINT
  897. 4470    OPEN "R",1,"A:CALLERS",60:
  898.  
  899.     FIELD #1, 60 AS RR$:
  900.  
  901.     GET #1,1
  902. 4480    RE = VAL(RR$) + 1:
  903.  
  904.     RL = 60
  905. 4490    GET #1,RE:
  906.  
  907.     INPUT# 1,S$
  908. 4500    IF INSTR(S$,"UTIL") THEN
  909.  
  910.         GOTO 4690
  911. 4510    S$ = S$ + " UTIL":
  912.  
  913.     GOSUB 2400:
  914.  
  915.     PUT #1,RE:
  916.  
  917.     CLOSE #1
  918. 4520    PRINT "You know you're not the SYSOP, what are you doing here??"
  919. 4530    PRINT
  920. 4540    PRINT "Go away, your name has been logged for further action!"
  921. 4550    PRINT
  922. 4560    END
  923. 4600 '
  924. 4610 '  SYSOP password check
  925. 4620 '
  926. 4630    PRINT "2nd Codeword? ";:
  927.  
  928.     B$ = INPUT$(10):
  929.  
  930.     GOSUB 2330:
  931.  
  932.     X$ = B$:
  933. 4640    PRINT
  934. 4650    IF INSTR(X$,P2$) THEN
  935.  
  936.         IF (MID$(DT$,1,1) = MID$(X$,10,1)) AND (MID$(DT$,2,1) = MID$(X$,9,1)) THEN
  937.  
  938.             F$ = "":
  939.  
  940.             SYSOP = 1:
  941.  
  942.             RETURN
  943. 4660    'Use this in place of 5680 if you dont have a real time clock
  944.  
  945.     IF INSTR(X$,P$) THEN
  946.  
  947.         F$ = "":
  948.  
  949.         SYSOP = 1:
  950.  
  951.         RETURN
  952. 4670    SYSOP = 0:
  953.  
  954.     RETURN
  955. 4680    '
  956. 4690    F$ = "TW"        'User has achieved temporary twit status
  957. 4700    OPEN "O",2,"A:LASTCALR. " + CHR$(&HA0):
  958.  
  959.     PRINT#2,N$;",";O$;",";F$;",";DZ$:
  960.  
  961.     CLOSE
  962. 4710    PRINT "You were warned to stay out of the SYSOP's domain"
  963. 4720    PRINT
  964. 4730    PRINT "You are being logged off this system IMMEDIATELY"
  965. 4740    PRINT
  966. 4750    CHAIN "BYE"
  967. 4760    END
  968. 4800    '
  969. 4810    ' Kill (Erase) a file
  970. 4820    '
  971. 4830    B$ = MID$(PROMPT$,3):
  972.  
  973.     IF B$ = "" THEN
  974.  
  975.         INPUT "Filename? ",B$:
  976.  
  977.         PRINT
  978. 4840    IF B$ = "" THEN
  979.  
  980.         RETURN
  981.  
  982.     ELSE
  983.  
  984.         GOSUB 2330:
  985.  
  986.         FILN$ = B$
  987. 4850    KILL FILN$
  988. 4860    PRINT
  989. 4870    RETURN
  990. 4900    '
  991. 4910    ' Rename a file
  992. 4920    '
  993. 4930    INPUT "Existing Filename? ",B$:
  994.  
  995.     PRINT
  996. 4940    IF B$ = "" THEN
  997.  
  998.         RETURN
  999.  
  1000.     ELSE
  1001.  
  1002.         GOSUB 2330:
  1003.  
  1004.         EFILN$ = B$
  1005. 4950    PRINT:
  1006.  
  1007.     INPUT "New Filename? ",B$:
  1008.  
  1009.     PRINT
  1010. 4960    IF B$ = "" THEN
  1011.  
  1012.         RETURN
  1013.  
  1014.     ELSE
  1015.  
  1016.         GOSUB 2330:
  1017.  
  1018.         NFILN$ = B$
  1019. 4970    NAME EFILN$ AS NFILN$
  1020. 4980    PRINT:
  1021.  
  1022.     RETURN
  1023.     PRINT
  1024. 4960    IF B$ = "" THEN
  1025.  
  1026.         RETURN
  1027.  
  1028.     ELSE
  1029.  
  1030.         GOSUB 2330:
  1031.  
  1032.         NFILN$ = B$
  1033. 4970    NAME