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.     BACKUP = 0
  45. 1050    GOSUB 4210        ' BUILD MSG INDEX
  46. 1060    N$ = "SYSOP":
  47.     O$ = "":
  48.     MAGIC$ = "SUPER"
  49. 1070    GOSUB 4390        'Test for SYSOP
  50. 1080    PRINT:
  51.     PRINT "             RCPM Utilty ";VERS$
  52. 1090    PRINT SEP$
  53. 1100    MSGS = 1:
  54.     CALLS = MSGS + 1:
  55.     MNUM = CALLS + 1
  56. 1110    PRINT:
  57.     INPUT "Command? ",PROMPT$
  58. 1120    PRINT:
  59.     PRINT:
  60.     IF PROMPT$ = "" THEN
  61.         GOSUB 1160:
  62.         GOTO 1110
  63. 1130    B$ = MID$(PROMPT$,1,1):
  64.     GOSUB 2330:
  65.     SM$ = B$:
  66.     SM = INSTR ("TFDPEBKRA",SM$):
  67.     GOSUB 1140:
  68.     GOTO 1110
  69. 1140    IF SM = 0 THEN
  70.         1160
  71. 1150    ON SM GOTO 1730,1630,1430,2500,1300,3210,4800,4900
  72. 1160    PRINT:
  73.     PRINT "Commands allowed are:"
  74. 1170    PRINT "B   ==> build summary file from message file"
  75. 1180    PRINT "D   ==> display an ascii file"
  76. 1190    PRINT "E   ==> end the utility program"
  77. 1200    PRINT "F   ==> prints the disk directory
  78. 1210    PRINT "K   ==> kill a file"
  79. 1220    PRINT "P   ==> purge the message files"
  80. 1230    PRINT "R   ==> rename a file"
  81. 1240    PRINT "T   ==> transfers a disk file to the message file"
  82. 1250    RETURN
  83. 1260 '
  84. 1300 ' END OF PROGRAM
  85. 1310 '
  86. 1320    PRINT:
  87.     PRINT:
  88.     END
  89. 1400 '
  90. 1410 ' DISPLAY A FILE
  91. 1420 '
  92. 1430    B$ = MID$(PROMPT$,2):
  93.     IF B$ = "" THEN
  94.         INPUT "Filename? ",B$:
  95.         PRINT
  96. 1440    IF B$ = "" THEN
  97.         RETURN
  98.     ELSE
  99.         GOSUB 2330:
  100.         FILN$ = B$
  101. 1450    OPEN "I",1,FILN$
  102. 1460    IF EOF(1) THEN
  103.         1500
  104. 1470    BI = ASC(INKEY$+" "):
  105.     IF BI = 19 THEN
  106.         BI = ASC(INPUT$(1))
  107. 1480    IF BI = 11 THEN
  108.         PRINT:
  109.         PRINT "++ Aborted ++":
  110.         PRINT:
  111.         CLOSE:
  112.         RETURN
  113. 1490    LINE INPUT #1,LIN$:
  114.     PRINT LIN$:
  115.     GOTO 1460
  116. 1500    CLOSE:
  117.     PRINT:
  118.     PRINT:
  119.     PRINT "++ End Of File ++":
  120.     PRINT
  121. 1510    RETURN
  122. 1600 '
  123. 1610 ' DISPLAY DIRECTORY
  124. 1620 '
  125. 1630    B$ = PROMPT$:
  126.     GOSUB 2330:
  127.     IF LEN(B$) > 1 THEN
  128.         SPEC$ = MID$(B$,3)
  129.     ELSE
  130.         SPEC$ = "*.*"
  131. 1640    FILES SPEC$:
  132.     PRINT:
  133.     RETURN
  134. 1700 '
  135. 1710 ' TRANSFER A DISK FILE
  136. 1720 '
  137. 1730    PRINT "Active # of msg's ";:
  138.     OPEN "R",1,"COUNTERS",5:
  139.     FIELD#1,5 AS RR$:
  140.     GET#1,MSGS:
  141.     M = VAL(RR$)
  142. 1740    PRINT STR"$(M) + " "
  143. 1750    PRINT "Last caller was # ";:
  144.     GET#1,CALLS:
  145.     PRINT STR$(VAL(RR$))
  146. 1760    PRINT "This msg # will be ";:
  147.     GET#1,MNUM:
  148.     U = VAL(RR$):
  149.     PRINT STR$(U + 1):
  150.     CLOSE
  151. 1800 '
  152. 1810 ' ***ENTER A NEW MESSAGE***
  153. 1820 '
  154. 1830    IF NOT PURGED THEN
  155.         PRINT "Files must be purged before messages can be added":
  156.         RETURN
  157. 1840    OPEN "R",1,"COUNTERS",5:
  158.     PRINT "Msg # will be ";:
  159.     FIELD#1,5 AS RR$:
  160.     GET#1,MNUM:
  161.     V = VAL(RR$)
  162. 1850    PRINT STR$(V + 1):
  163.     CLOSE
  164. 1860    INPUT "Message file name? ",B$:
  165.     GOSUB 2330:
  166.     FIL$ = B$
  167. 1870    INPUT "Todays date (DD/MM/YY)?",B$:
  168.     GOSUB 2330:
  169.     IF B$ = "" THEN
  170.         D$ = DT$
  171.     ELSE
  172.         D$ = B$
  173. 1880    INPUT "Who to (C/R for ALL)?";B$:
  174.     GOSUB 2330:
  175.     IF B$ = "" THEN
  176.         T$ = "ALL"
  177.     ELSE
  178.         T$ = B$
  179. 1890    INPUT "Subject?",B$:
  180.     GOSUB 2330:
  181.     K$ = B$
  182. 1900    INPUT "Password?",B$:
  183.     GOSUB 2330:
  184.     PW$ = B$:
  185.     IF T$ = "ALL" AND LEFT$(PW$,1) = "*" THEN
  186.         PRINT CHR$(7);"You CANNOT use '*' with ALL.":
  187.         GOTO 1900
  188. 1910    F = 0            ' F IS MESSAGE LENGTH
  189. 1920    PRINT "Updating counters":
  190.     OPEN "R",1,"COUNTERS",5:
  191.     FIELD#1,5 AS RR$
  192. 1930    GET#1,MNUM:
  193.     LSET RR$ = STR$(VAL(RR$) + 1):
  194.     PUT#1,MNUM
  195. 1940    GET#1,MSGS:
  196.     LSET RR$ = STR$(VAL(RR$) + 1):
  197.     PUT#1,MSGS:
  198.     CLOSE#1
  199. 1950    PRINT "Updating msg file":
  200.     OPEN "R",1,"MESSAGES",65:
  201.     RL = 65
  202. 1960    FIELD#1,65 AS RR$
  203. 1970    RE = MX + 7:
  204.     F = 0
  205. 1980    OPEN "I",2,FIL$:
  206.     IF EOF(2) THEN
  207.         PRINT "File empty.":
  208.         CLOSE#1:
  209.         CLOSE#2:
  210.         END
  211. 1990    IF EOF(2) THEN
  212.         S$ = "9999":
  213.         GOSUB 2400:
  214.         PUT #1,RE:
  215.         CLOSE #2:
  216.         GOTO 2030
  217. 2000    LINE INPUT #2,S$
  218. 2010    IF LEN(S$) > 63 THEN
  219.         S$ = LEFT$(S$,63)
  220. 2020    PRINT S$:
  221.     GOSUB 2400:
  222.     PUT #1,RE:
  223.     RE = RE + 1:
  224.     F = F + 1:
  225.     GOTO 1990
  226. 2030    RE = MX + 1
  227. 2040    S$ = STR$(V + 1):
  228.     GOSUB 2400:
  229.     PUT#1,RE
  230. 2050    RE = RE + 1:
  231.     S$ = D$:
  232.     GOSUB 2400:
  233.     PUT#1,RE
  234. 2060    RE = RE + 1:
  235.     S$ = N$ + " " + O$:
  236.     GOSUB 2400:
  237.     PUT#1,RE
  238. 2070    RE = RE + 1:
  239.     S$ = T$:
  240.     GOSUB 2400:
  241.     PUT#1,RE
  242. 2080    RE = RE + 1:
  243.     S$ = K$:
  244.     GOSUB 2400:
  245.     PUT#1,RE:
  246.     RE = RE + 1:
  247.     S$ = STR$(F):
  248.     GOSUB 2400:
  249.     PUT#1,RE
  250. 2090    CLOSE #1
  251. 2100    IF PW$ <> "" THEN
  252.         PW$ = ";" + PW$
  253. 2110    PRINT "Updating summary file."
  254. 2120    OPEN "R",1,"SUMMARY",30:
  255.     RE = 1:
  256.     FIELD#1,30 AS RR$:
  257.     RL = 30
  258. 2130    RE = MZ * 6 + 1:
  259.     S$ = STR$(V + 1) + PW$:
  260.     GOSUB 2400:
  261.     PUT#1,RE
  262. 2140    RE = RE + 1:
  263.     S$ = D$:
  264.     GOSUB 2400:
  265.     PUT#1,RE
  266. 2150    RE = RE + 1:
  267.     S$ = N$ + " " + O$:
  268.     GOSUB 2400:
  269.     PUT#1,RE
  270. 2160    RE = RE + 1:
  271.     S$ = T$:
  272.     GOSUB 2400:
  273.     PUT#1,RE
  274. 2170    RE = RE + 1:
  275.     S$ = K$:
  276.     GOSUB 2400:
  277.     PUT#1,RE
  278. 2180    RE = RE + 1:
  279.     S$ = STR$(F):
  280.     GOSUB 2400:
  281.     PUT#1,RE
  282. 2190    RE = RE + 1:
  283.     S$ = " 9999":
  284.     GOSUB 2400:
  285.     PUT#1,RE
  286. 2200    CLOSE#1
  287. 2210    MX = MX + F + 6:
  288.     MZ = MZ + 1:
  289.     M(MZ,1) = V + 1:
  290.     M(MZ,2) = F
  291. 2220    U = U + 1
  292. 2230    RETURN
  293. 2300 '
  294. 2310 ' Convert the string B$ to upper case
  295. 2320 '
  296. 2330    FOR ZZ=1 TO LEN(B$):
  297.         MID$(B$,ZZ,1) = CHR$(ASC(MID$(B$,ZZ,1)) + 32 * (ASC(MID$(B$,ZZ,1)) > 96)):
  298.     NEXT ZZ:
  299.     RETURN
  300. 2400 '
  301. 2410 ' FILL AND STORE DISK RECORD
  302. 2420 '
  303. 2430    LSET RR$ = LEFT$(S$ + SPACE$(RL - 2),RL - 2) + CHR$(13) + CHR$(10)
  304. 2440    RETURN
  305. 2500 '
  306. 2510 ' PURGE KILLED MESSAGES FROM FILES
  307. 2520 '
  308. 2530    IF PURGED THEN
  309.         PRINT "Files already purged.":
  310.         RETURN
  311. 2540    INPUT "Today's date (DD/MM/YY) ?",DATE$
  312. 2550    IF LEN(DATE$) > 8 THEN
  313.         PRINT "Must be less then 8 characters.":
  314.         GOTO 2540
  315. 2560    IF DATE$ = "" THEN
  316.         DATE$ = DT$
  317. 2570    OPEN "R",1,DATE$+".ARC"
  318. 2580    IF LOF(1) > 0 THEN
  319.         PRINT "Archive file: ";DATE$ + ".ARC";" exists.":
  320.         CLOSE:
  321.         RETURN
  322. 2590    CLOSE
  323. 2600    MSGN = 1:
  324.     INPUT "Renumber messages?",PK$:
  325.     PK$ = MID$(PK$,1,1)
  326. 2610    IF PK$ = "y" THEN
  327.         PK$ = "Y"
  328. 2620    IF PK$ <> "Y" THEN
  329.         2650
  330. 2630    INPUT "Message number to start (CR=1)?",MSG$:
  331.     IF MSG$ = "" THEN
  332.         MSG$="1"
  333. 2640    MSGN = VAL(MSG$):
  334.     IF MSGN = 0 THEN
  335.         PRINT "Invalid msg #.":
  336.         RETURN
  337. 2650    PRINT "Purging summary file...":
  338.     OPEN "R",1,"SUMMARY",30
  339. 2660    FIELD#1,30 AS R1$
  340. 2670    R1 = 1
  341. 2680    OPEN "R",2,"$SUMMARY.$$$",30
  342. 2690    FIELD#2,30 AS R2$
  343. 2700    R2 = 1
  344. 2710    PRINT SEP$:
  345.     GET#1,R1:
  346.     IF EOF(1) THEN
  347.         2840
  348. 2720    IF VAL(R1$) = 0 THEN
  349.         R1 = R1 + 6:
  350.         PRINT "Deletion":
  351.         GOTO 2710
  352. 2730    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  353.         IF INSTR(R1$,";") THEN
  354.             PASS$ = MID$(R1$,INSTR(R1$,";"),27)
  355.         ELSE
  356.             PASS$ = SPACE$(28)
  357. 2740    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  358.         LSET R2$ = LEFT$(STR$(MSGN) + PASS$,28) + CHR$(13) + CHR$(10):
  359.         MSGN = MSGN + 1:
  360.         GOTO 2760
  361. 2750    LSET R2$ = R1$
  362. 2760    PUT #2,R2
  363. 2770    PRINT LEFT$(R2$,28)
  364. 2780    IF VAL(R1$) > 9998 THEN
  365.         2840
  366. 2790    FOR I = 1 TO 5
  367. 2800        R1 = R1 + 1:
  368.         R2 = R2 + 1:
  369.         GET#1,R1:
  370.         LSET R2$ = R1$:
  371.         PUT#2,R2
  372. 2810        PRINT LEFT$(R2$,28)
  373. 2820    NEXT I
  374. 2830    R1 = R1 + 1:
  375.     R2 = R2 + 1:
  376.     GOTO 2710
  377. 2840    CLOSE:
  378.     OPEN "O",1,"SUMMARY.BAK":
  379.     CLOSE:
  380.     KILL "SUMMARY.BAK":
  381.     NAME "SUMMARY" AS "SUMMARY.BAK":
  382.     NAME "$SUMMARY.$$$" AS "SUMMARY"
  383. 2850    PRINT "Purging message file...":
  384.     MSGN = VAL(MSG$)
  385. 2860    OPEN "R",1,"MESSAGES",65:
  386.     FIELD #1,65 AS R1$
  387. 2870    OPEN "R",2,"$MESSAGS.$$$",65:
  388.     FIELD #2,65 AS R2$
  389. 2880    OPEN "O",3,DATE$+".ARC":
  390.     R1 = 1:
  391.     KIL = 0
  392. 2890    R1 = 1:
  393.     R2 = 1
  394. 2900    PRINT SEP$:
  395.     GET #1,R1:
  396.     IF EOF(1) THEN
  397.          3100
  398. 2910    IF VAL(R1$) = 0 THEN
  399.         KIL = -1:
  400.         PRINT "Archiving message":
  401.         GOTO 2970
  402. 2920    KIL = 0
  403. 2930    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  404.         IF INSTR(R1$,";") THEN
  405.             PASS$ = MID$(R1$,INSTR(R1$,";"),62)
  406.         ELSE
  407.             PASS$ = SPACE$(62)
  408. 2940    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  409.         LSET R2$ = LEFT$(STR$(MSGN) + PASS$,63) + CHR$(13) + CHR$(10):
  410.         MSGN = MSGN + 1:
  411.         PRINT LEFT$(R2$,63):
  412.         GOTO 2960
  413. 2950    LSET R2$ = R1$:
  414.     PRINT LEFT$(R2$,6)
  415. 2960    PUT #2,R2
  416. 2970    IF KIL THEN
  417.         GOSUB 4310:
  418.         PRINT #3,KL$
  419. 2980    IF VAL(R1$) > 9998 THEN
  420.         3100
  421. 2990    FOR I = 1 TO 5
  422. 3000        R1 = R1 + 1:
  423.         IF NOT KIL THEN
  424.             R2 = R2 + 1
  425. 3010        GET #1,R1:
  426.         IF KIL THEN
  427.             GOSUB 4310:
  428.             PRINT #3,KL$:
  429.             GOTO 3030
  430. 3020        LSET R2$ = R1$:
  431.         PUT #2,R2:
  432.         PRINT LEFT$(R2$,63)
  433. 3030    NEXT I
  434. 3040    FOR I = 1 TO VAL(R1$):
  435.         R1 = R1 + 1:
  436.         IF NOT KIL THEN
  437.             R2 = R2 + 1
  438. 3050        GET #1,R1:
  439.         IF KIL THEN
  440.             GOSUB 4310:
  441.             PRINT #3,KL$:
  442.             GOTO 3070
  443. 3060        LSET R2$ = R1$:
  444.         PUT #2,R2:
  445.         PRINT LEFT$(R2$,63)
  446. 3070    NEXT I:
  447.     R1 = R1 + 1:
  448.     IF NOT KIL THEN
  449.         R2 = R2 + 1
  450. 3080    GOTO 2900
  451. 3090 '
  452. 3100    CLOSE:
  453.     OPEN "O",1,"MESSAGES.BAK":
  454.     CLOSE:
  455.     KILL "MESSAGES.BAK":
  456.     NAME "MESSAGES" AS "MESSAGES.BAK":
  457.     NAME "$MESSAGS.$$$" AS "MESSAGES"
  458. 3110    PRINT "Updating counters..."
  459. 3120    OPEN "O",1,"COUNTERS.BAK":
  460.     CLOSE:
  461.     KILL "COUNTERS.BAK"
  462. 3130    OPEN "R",1,"COUNTERS",15:
  463.     FIELD #1,10 AS C1$,5 AS C2$
  464. 3140    OPEN "R",2,"COUNTERS.BAK",15:
  465.     FIELD #2,15 AS R2$
  466. 3150    GET #1,1:
  467.     LSET R2$ = C1$ + C2$:
  468.     PUT #2,1
  469. 3160    IF PK$ = "Y" THEN
  470.         LSET C2$ = STR$(MSGN - 1):
  471.         PUT #1,1
  472. 3170    CLOSE
  473. 3180    PURGED = -1:
  474.     GOSUB 4210:
  475.     RETURN
  476. 3200 '
  477. 3210 ' BUILD SUMMARY FILE FROM MESSAGE FILE
  478. 3220 '
  479. 3230    PRINT "Building summary file..."
  480. 3240    OPEN "O",1,"SUMMARY.BAK":
  481.     CLOSE:
  482.     KILL "SUMMARY.BAK"
  483. 3250    OPEN "R",1,"MESSAGES",65:
  484.     FIELD #1,65 AS R1$:
  485.     R1 = 1
  486. 3260    OPEN "R",2,"SUMMARY.$$$",30:
  487.     FIELD #2,30 AS R2$:
  488.     R2 = 1
  489. 3270    PRINT SEP$
  490. 3280    FOR I = 1 TO 6
  491. 3290        GET #1,R1:
  492.         IF EOF(1) THEN
  493.             3340
  494. 3300        LSET R2$ = LEFT$(R1$,28) + CRLF$:
  495.         PUT #2,R2
  496. 3310        R1 = R1 + 1:
  497.         R2 = R2 + 1:
  498.         PRINT LEFT$(R2$,28):
  499.         IF EOF(1) THEN
  500.             3340
  501. 3320        IF I = 1 THEN
  502.             IF VAL(R1$) > 9998 THEN
  503.                 3340
  504. 3330    NEXT I:
  505.     R1 = R1 + VAL(R1$):
  506.     GOTO 3270
  507. 3340    CLOSE:
  508.     NAME "SUMMARY" AS "SUMMARY.BAK":
  509.     NAME "SUMMARY.$$$" AS "SUMMARY"
  510. 3350    PRINT "Summary file built.":
  511.     RETURN
  512. 4000 '
  513. 4010 ' Error handlers
  514. 4020 '
  515. 4030    IF (ERL = 1640) AND (ERR = 53) THEN
  516.         PRINT "File not found.":
  517.         RESUME 1110
  518. 4040    IF (ERL = 1450) AND (ERR = 53) THEN
  519.         PRINT "File not found.":
  520.         CLOSE:
  521.         RESUME 1510
  522. 4050    IF (ERL = 4970) AND (ERR = 53) THEN
  523.         PRINT "You cannot rename a file that doesn't already exist":
  524.         RESUME 1110
  525. 4060    IF (ERL = 4850) AND (ERR = 53) THEN
  526.         PRINT "That file doesn't exist so you can't erase it":
  527.         RESUME 1110
  528. 4070    PRINT "Error number ";ERR;" in line number ";ERL
  529. 4080    RESUME 1110
  530. 4200 '
  531. 4210 ' build message index
  532. 4220 '
  533. 4230    MX = 0:
  534.     MZ = 0
  535. 4240    OPEN "R",1,"SUMMARY",30:
  536.     RE = 1:
  537.     FIELD#1,28 AS RR$
  538. 4250    GET#1,RE:
  539.     IF EOF(1) THEN
  540.         4290
  541. 4260    G = VAL(RR$):
  542.     MZ = MZ + 1:
  543.     M(MZ,1) = G:
  544.     IF G = 0 THEN
  545.         4280
  546. 4270    IF G > 9998 THEN
  547.         MZ = MZ - 1:
  548.         GOTO 4290
  549. 4280    GET#1,RE + 5:
  550.     M(MZ,2) = VAL(RR$):
  551.     MX = MX + M(MZ,2) + 6:
  552.     RE = RE + 6:
  553.     GOTO 4250
  554. 4290    CLOSE:
  555.     RETURN
  556. 4300 '
  557. 4310 ' unpack record
  558. 4320 '
  559. 4330    ZZ = LEN(R1$) - 2
  560. 4340    WHILE MID$(R1$,ZZ,1) = " "
  561. 4350    ZZ = ZZ - 1:
  562.     IF ZZ = 1 THEN
  563.         4370
  564. 4360    WEND
  565. 4370    KL$ = LEFT$(R1$,ZZ)
  566. 4380    RETURN
  567. 4390 '
  568. 4400 ' Test to only allow the SYSOP to use UTIL remotely
  569. 4410 '
  570. 4420    OPEN "I",1,"A:LASTCALR":
  571.     INPUT #1,N$,O$,F$,DT$:
  572.     CLOSE
  573. 4430    OPEN "I",1,"A:PWDS":
  574.     INPUT #1,P1$,P2$:
  575.     CLOSE #1
  576. 4440    PRINT
  577. 4450    IF N$ = MAGIC$ AND O$ = "" THEN
  578.             GOSUB 4610:
  579.             IF SYSOP = 1 THEN
  580.                 RETURN
  581. 4460    PRINT
  582. 4470    OPEN "R",1,"A:CALLERS",60:
  583.     FIELD #1, 60 AS RR$:
  584.     GET #1,1
  585. 4480    RE = VAL(RR$) + 1:
  586.     RL = 60
  587. 4490    GET #1,RE:
  588.     INPUT# 1,S$
  589. 4500    IF INSTR(S$,"UTIL") THEN
  590.         GOTO 4690
  591. 4510    S$ = S$ + " UTIL":
  592.     GOSUB 2400:
  593.     PUT #1,RE:
  594.     CLOSE #1
  595. 4520    PRINT "You know you're not the SYSOP, what are you doing here??"
  596. 4530    PRINT
  597. 4540    PRINT "Go away, your name has been logged for further action!"
  598. 4550    PRINT
  599. 4560    END
  600. 4600 '
  601. 4610 '  SYSOP password check
  602. 4620 '
  603. 4630    PRINT "2nd Codeword? ";:
  604.     B$ = INPUT$(10):
  605.     GOSUB 2330:
  606.     X$ = B$:
  607. 4640    PRINT
  608. 4650    IF INSTR(X$,P2$) THEN
  609.         IF (MID$(DT$,1,1) = MID$(X$,10,1)) AND (MID$(DT$,2,1) = MID$(X$,9,1)) THEN
  610.             F$ = "":
  611.             SYSOP = 1:
  612.             RETURN
  613. 4660    'Use this in place of 5680 if you dont have a real time clock
  614.     IF INSTR(X$,P$) THEN
  615.         F$ = "":
  616.         SYSOP = 1:
  617.         RETURN
  618. 4670    SYSOP = 0:
  619.     RETURN
  620. 4680    '
  621. 4690    F$ = "TW"        'User has achieved temporary twit status
  622. 4700    OPEN "O",2,"A:LASTCALR. " + CHR$(&HA0):
  623.     PRINT#2,N$;",";O$;",";F$;",";DZ$:
  624.     CLOSE
  625. 4710    PRINT "You were warned to stay out of the SYSOP's domain"
  626. 4720    PRINT
  627. 4730    PRINT "You are being logged off this system IMMEDIATELY"
  628. 4740    PRINT
  629. 4750    CHAIN "BYE"
  630. 4760    END
  631. 4800    '
  632. 4810    ' Kill (Erase) a file
  633. 4820    '
  634. 4830    B$ = MID$(PROMPT$,3):
  635.     IF B$ = "" THEN
  636.         INPUT "Filename? ",B$:
  637.         PRINT
  638. 4840    IF B$ = "" THEN
  639.         RETURN
  640.     ELSE
  641.         GOSUB 2330:
  642.         FILN$ = B$
  643. 4850    KILL FILN$
  644. 4860    PRINT
  645. 4870    RETURN
  646. 4900    '
  647. 4910    ' Rename a file
  648. 4920    '
  649. 4930    INPUT "Existing Filename? ",B$:
  650.     PRINT
  651. 4940    IF B$ = "" THEN
  652.         RETURN
  653.     ELSE
  654.         GOSUB 2330:
  655.         EFILN$ = B$
  656. 4950    PRINT:
  657.     INPUT "New Filename? ",B$:
  658.     PRINT
  659. 4960    IF B$ = "" THEN
  660.         RETURN
  661.     ELSE
  662.         GOSUB 2330:
  663.         NFILN$ = B$
  664. 4970    NAME EFILN$ AS NFILN$
  665. 4980    PRINT:
  666.     RETURN
  667.     PRINT
  668. 4960    IF B$ = "" THEN
  669.         RETURN
  670.     ELSE
  671.         GOSUB 2330:
  672.         NFILN$ = B$
  673. 4970    NAME