home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol084 / rbbsutil.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  12.2 KB  |  584 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 '
  25. 980    DEFINT A-Z
  26. 990    VERS$ = "Vers 2.4"
  27. 1000    ON ERROR GOTO 4500
  28. 1020    DIM M(200,2)
  29. 1040    SEP$ = "=============================================="
  30. 1060    CRLF$ = CHR$(13) + CHR$(10)
  31. 1080    PURGED = 0:
  32.     BACKUP = 0
  33. 1120    GOSUB 4580        ' BUILD MSG INDEX
  34. 1140    N$ = "SYSOP":
  35.     O$ = "":
  36.     MAGIC$ = "SUPER"
  37. 1160    GOSUB 5000        'Test for SYSOP
  38. 1180    PRINT:
  39.     PRINT "             RCPM Utilty ";VERS$
  40. 1200    PRINT SEP$
  41. 1220    MSGS = 1:
  42.     CALLS = MSGS + 1:
  43.     MNUM = CALLS + 1
  44. 1240    PRINT:
  45.     INPUT "Command? ",PROMPT$
  46. 1260    PRINT:
  47.     PRINT:
  48.     IF PROMPT$ = "" THEN
  49.         1340
  50. 1280    B$ = MID$(PROMPT$,1,1):
  51.     GOSUB 2720:
  52.     SM$ = B$:
  53.     SM = INSTR ("TFDPEB",SM$):
  54.     GOSUB 1300:
  55.     GOTO 1240
  56. 1300    IF SM = 0 THEN
  57.         1340
  58. 1320    ON SM GOTO 1780,1720,1560,2840,1500,4200
  59. 1340    PRINT:
  60.     PRINT "Commands allowed are:"
  61. 1360    PRINT "B   ==> build summary file from message file."
  62. 1380    PRINT "D   ==> display an ascii file"
  63. 1400    PRINT "E   ==> end the utility program."
  64. 1420    PRINT "F   ==> prints the disk directory."
  65. 1440    PRINT "P   ==> purge the message files"
  66. 1460    PRINT "T   ==> transfers a disk file to the message file."
  67. 1480    RETURN
  68. 1490 '
  69. 1500 ' END OF PROGRAM
  70. 1510 '
  71. 1520    PRINT:
  72.     PRINT:
  73.     END
  74. 1530 '
  75. 1540 ' DISPLAY A FILE
  76. 1550 '
  77. 1560    B$ = MID$(PROMPT$,2):
  78.     PRINT:
  79.     IF B$ = "" THEN
  80.         INPUT "Filename? ",B$:
  81.         PRINT
  82. 1570    GOSUB 2720:
  83.     FILN$ = B$
  84. 1580    OPEN "I",1,FILN$
  85. 1600    IF EOF(1) THEN
  86.         1660
  87. 1620    IF INKEY$ <> "" THEN
  88.         CLOSE:
  89.         PRINT:
  90.         PRINT "++ Aborted ++":
  91.         PRINT:
  92.         RETURN
  93. 1640    LINE INPUT #1,LIN$:
  94.     PRINT LIN$:
  95.     GOTO 1600
  96. 1660    CLOSE:
  97.     PRINT:
  98.     PRINT:
  99.     PRINT "++ END OF FILE ++":
  100.     PRINT
  101. 1680    RETURN
  102. 1690 '
  103. 1700 ' DISPLAY DIRECTORY
  104. 1710 '
  105. 1720    IF LEN(PROMPT$) > 1 THEN
  106.         SPEC$ = MID$(PROMPT$,2)
  107.     ELSE
  108.         SPEC$ = "*.*"
  109. 1740    FILES SPEC$:
  110.     PRINT:
  111.     RETURN
  112. 1750 '
  113. 1760 ' TRANSFER A DISK FILE
  114. 1770 '
  115. 1780    PRINT "Active # of msg's ";:
  116.     OPEN "R",1,"COUNTERS",5:
  117.     FIELD#1,5 AS RR$:
  118.     GET#1,MSGS:
  119.     M = VAL(RR$)
  120. 1800    PRINT STR"$(M) + " "
  121. 1820    PRINT "Last caller was # ";:
  122.     GET#1,CALLS:
  123.     PRINT STR$(VAL(RR$))
  124. 1840    PRINT "This msg # will be ";:
  125.     GET#1,MNUM:
  126.     U = VAL(RR$):
  127.     PRINT STR$(U + 1):
  128.     CLOSE
  129. 1860 '
  130. 1880 ' ***ENTER A NEW MESSAGE***
  131. 1900 '
  132. 1920    IF NOT PURGED THEN
  133.         PRINT "Files must be purged before messages can be added":
  134.         RETURN
  135. 1940    OPEN "R",1,"COUNTERS",5:
  136.     PRINT "Msg # will be ";:
  137.     FIELD#1,5 AS RR$:
  138.     GET#1,MNUM:
  139.     V = VAL(RR$)
  140. 1960    PRINT STR$(V + 1):
  141.     CLOSE
  142. 1980    INPUT "Message file name? ",B$:
  143.     GOSUB 2720:
  144.     FIL$ = B$
  145. 2000    INPUT "Todays date (DD/MM/YY)?",B$:
  146.     GOSUB 2720:
  147.     IF B$ = "" THEN
  148.         D$ = DT$
  149.     ELSE
  150.         D$ = B$
  151. 2020    INPUT "Who to (C/R for ALL)?";B$:
  152.     GOSUB 2720:
  153.     IF B$ = "" THEN
  154.         T$ = "ALL"
  155.     ELSE
  156.         T$ = B$
  157. 2040    INPUT "Subject?",B$:
  158.     GOSUB 2720:
  159.     K$ = B$:
  160.     INPUT "Password?",B$:
  161.     GOSUB 2720:
  162.     PW$ = B$
  163. 2060    F = 0            ' F IS MESSAGE LENGTH
  164. 2080    PRINT "Updating counters":
  165.     OPEN "R",1,"COUNTERS",5:
  166.     FIELD#1,5 AS RR$
  167. 2100    GET#1,MNUM:
  168.     LSET RR$ = STR$(VAL(RR$) + 1):
  169.     PUT#1,MNUM
  170. 2120    GET#1,MSGS:
  171.     LSET RR$ = STR$(VAL(RR$) + 1):
  172.     PUT#1,MSGS:
  173.     CLOSE#1
  174. 2140    PRINT "Updating msg file":
  175.     OPEN "R",1,"MESSAGES",65:
  176.     RL = 65
  177. 2160    FIELD#1,65 AS RR$
  178. 2180    RE = MX + 7:
  179.     F = 0
  180. 2200    OPEN "I",2,FIL$:
  181.     IF EOF(2) THEN
  182.         PRINT "File empty.":
  183.         CLOSE#1:
  184.         CLOSE#2:
  185.         END
  186. 2220    IF EOF(2) THEN
  187.         S$ = "9999":
  188.         GOSUB 2740:
  189.         PUT #1,RE:
  190.         CLOSE #2:
  191.         GOTO 2300
  192. 2240    LINE INPUT #2,S$
  193. 2260    IF LEN(S$) > 63 THEN
  194.         S$ = LEFT$(S$,63)
  195. 2280    PRINT S$:
  196.     GOSUB 2740:
  197.     PUT #1,RE:
  198.     RE = RE + 1:
  199.     F = F + 1:
  200.     GOTO 2220
  201. 2300    RE = MX + 1
  202. 2320    S$ = STR$(V + 1):
  203.     GOSUB 2740:
  204.     PUT#1,RE
  205. 2340    RE = RE + 1:
  206.     S$ = D$:
  207.     GOSUB 2740:
  208.     PUT#1,RE
  209. 2360    RE = RE + 1:
  210.     S$ = N$ + " " + O$:
  211.     GOSUB 2740:
  212.     PUT#1,RE
  213. 2380    RE = RE + 1:
  214.     S$ = T$:
  215.     GOSUB 2740:
  216.     PUT#1,RE
  217. 2400    RE = RE + 1:
  218.     S$ = K$:
  219.     GOSUB 2740:
  220.     PUT#1,RE:
  221.     RE = RE + 1:
  222.     S$ = STR$(F):
  223.     GOSUB 2740:
  224.     PUT#1,RE
  225. 2420    CLOSE #1
  226. 2440    IF PW$ <> "" THEN
  227.         PW$ = ";" + PW$
  228. 2460    PRINT "Updating summary file."
  229. 2480    OPEN "R",1,"SUMMARY",30:
  230.     RE = 1:
  231.     FIELD#1,30 AS RR$:
  232.     RL = 30
  233. 2500    RE = MZ * 6 + 1:
  234.     S$ = STR$(V + 1) + PW$:
  235.     GOSUB 2740:
  236.     PUT#1,RE
  237. 2520    RE = RE + 1:
  238.     S$ = D$:
  239.     GOSUB 2740:
  240.     PUT#1,RE
  241. 2540    RE = RE + 1:
  242.     S$ = N$ + " " + O$:
  243.     GOSUB 2740:
  244.     PUT#1,RE
  245. 2560    RE = RE + 1:
  246.     S$ = T$:
  247.     GOSUB 2740:
  248.     PUT#1,RE
  249. 2580    RE = RE + 1:
  250.     S$ = K$:
  251.     GOSUB 2740:
  252.     PUT#1,RE
  253. 2600    RE = RE + 1:
  254.     S$ = STR$(F):
  255.     GOSUB 2740:
  256.     PUT#1,RE
  257. 2620    RE = RE + 1:
  258.     S$ = " 9999":
  259.     GOSUB 2740:
  260.     PUT#1,RE
  261. 2640    CLOSE#1
  262. 2660    MX = MX + F + 6:
  263.     MZ = MZ + 1:
  264.     M(MZ,1) = V + 1:
  265.     M(MZ,2) = F
  266. 2680    U = U + 1
  267. 2700    RETURN
  268. 2705 '
  269. 2710 ' Convert the string B$ to upper case
  270. 2715 '
  271. 2720    FOR ZZ=1 TO LEN(B$):
  272.         MID$(B$,ZZ,1) = CHR$(ASC(MID$(B$,ZZ,1)) + 32 * (ASC(MID$(B$,ZZ,1)) > 96)):
  273.     NEXT ZZ:
  274.     RETURN
  275. 2740 '
  276. 2760 ' FILL AND STORE DISK RECORD
  277. 2780 '
  278. 2800    LSET RR$ = LEFT$(S$ + SPACE$(RL - 2),RL - 2) + CHR$(13) + CHR$(10)
  279. 2820    RETURN
  280. 2840 '
  281. 2860 ' PURGE KILLED MESSAGES FROM FILES
  282. 2880 '
  283. 2900    IF PURGED THEN
  284.         PRINT "Files already purged.":
  285.         RETURN
  286. 2920    INPUT "Today's date (DD/MM/YY) ?",DATE$
  287. 2940    IF LEN(DATE$) > 8 THEN
  288.         PRINT "Must be less then 8 characters.":
  289.         GOTO 2920
  290. 2960    IF DATE$ = "" THEN
  291.         DATE$ = DT$
  292. 2980    OPEN "R",1,DATE$+".ARC"
  293. 3000    IF LOF(1) > 0 THEN
  294.         PRINT "Archive file: ";DATE$ + ".ARC";" exists.":
  295.         CLOSE:
  296.         RETURN
  297. 3020    CLOSE
  298. 3040    MSGN = 1:
  299.     INPUT "Renumber messages?",PK$:
  300.     PK$ = MID$(PK$,1,1)
  301. 3060    IF PK$ = "y" THEN
  302.         PK$ = "Y"
  303. 3080    IF PK$ <> "Y" THEN
  304.         3140
  305. 3100    INPUT "Message number to start (CR=1)?",MSG$:
  306.     IF MSG$ = "" THEN
  307.         MSG$="1"
  308. 3120    MSGN = VAL(MSG$):
  309.     IF MSGN = 0 THEN
  310.         PRINT "Invalid msg #.":
  311.         RETURN
  312. 3140    PRINT "Purging summary file...":
  313.     OPEN "R",1,"SUMMARY",30
  314. 3160    FIELD#1,30 AS R1$
  315. 3180    R1 = 1
  316. 3200    OPEN "R",2,"$SUMMARY.$$$",30
  317. 3220    FIELD#2,30 AS R2$
  318. 3240    R2 = 1
  319. 3260    PRINT SEP$:
  320.     GET#1,R1:
  321.     IF EOF(1) THEN
  322.         3520
  323. 3280    IF VAL(R1$) = 0 THEN
  324.         R1 = R1 + 6:
  325.         PRINT "Deletion":
  326.         GOTO 3260
  327. 3300    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  328.         IF INSTR(R1$,";") THEN
  329.             PASS$ = MID$(R1$,INSTR(R1$,";"),27)
  330.         ELSE
  331.             PASS$ = SPACE$(28)
  332. 3320    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  333.         LSET R2$ = LEFT$(STR$(MSGN) + PASS$,28) + CHR$(13) + CHR$(10):
  334.         MSGN = MSGN + 1:
  335.         GOTO 3360
  336. 3340    LSET R2$ = R1$
  337. 3360    PUT #2,R2
  338. 3380    PRINT LEFT$(R2$,28)
  339. 3400    IF VAL(R1$) > 9998 THEN
  340.         3520
  341. 3420    FOR I = 1 TO 5
  342. 3440        R1 = R1 + 1:
  343.         R2 = R2 + 1:
  344.         GET#1,R1:
  345.         LSET R2$ = R1$:
  346.         PUT#2,R2
  347. 3460        PRINT LEFT$(R2$,28)
  348. 3480    NEXT I
  349. 3500    R1 = R1 + 1:
  350.     R2 = R2 + 1:
  351.     GOTO 3260
  352. 3520    CLOSE:
  353.     OPEN "O",1,"SUMMARY.BAK":
  354.     CLOSE:
  355.     KILL "SUMMARY.BAK":
  356.     NAME "SUMMARY" AS "SUMMARY.BAK":
  357.     NAME "$SUMMARY.$$$" AS "SUMMARY"
  358. 3540    PRINT "Purging message file...":
  359.     MSGN = VAL(MSG$)
  360. 3560    OPEN "R",1,"MESSAGES",65:
  361.     FIELD #1,65 AS R1$
  362. 3580    OPEN "R",2,"$MESSAGS.$$$",65:
  363.     FIELD #2,65 AS R2$
  364. 3600    OPEN "O",3,DATE$+".ARC":
  365.     R1 = 1:
  366.     KIL = 0
  367. 3620    R1 = 1:
  368.     R2 = 1
  369. 3640    PRINT SEP$:
  370.     GET #1,R1:
  371.     IF EOF(1) THEN
  372.          4020
  373. 3660    IF VAL(R1$) = 0 THEN
  374.         KIL = -1:
  375.         PRINT "Archiving message":
  376.         GOTO 3780
  377. 3680    KIL = 0
  378. 3700    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  379.         IF INSTR(R1$,";") THEN
  380.             PASS$ = MID$(R1$,INSTR(R1$,";"),62)
  381.         ELSE
  382.             PASS$ = SPACE$(62)
  383. 3720    IF PK$ = "Y" AND VAL(R1$) < 9999 THEN
  384.         LSET R2$ = LEFT$(STR$(MSGN) + PASS$,63) + CHR$(13) + CHR$(10):
  385.         MSGN = MSGN + 1:
  386.         PRINT LEFT$(R2$,63):
  387.         GOTO 3760
  388. 3740    LSET R2$ = R1$:
  389.     PRINT LEFT$(R2$,6)
  390. 3760    PUT #2,R2
  391. 3780    IF KIL THEN
  392.         GOSUB 4740:
  393.         PRINT #3,KL$
  394. 3800    IF VAL(R1$) > 9998 THEN
  395.         4020
  396. 3820    FOR I = 1 TO 5
  397. 3840        R1 = R1 + 1:
  398.         IF NOT KIL THEN
  399.             R2 = R2 + 1
  400. 3860        GET #1,R1:
  401.         IF KIL THEN
  402.             GOSUB 4740:
  403.             PRINT #3,KL$:
  404.             GOTO 3900
  405. 3880        LSET R2$ = R1$:
  406.         PUT #2,R2:
  407.         PRINT LEFT$(R2$,63)
  408. 3900    NEXT I
  409. 3920    FOR I = 1 TO VAL(R1$):
  410.         R1 = R1 + 1:
  411.         IF NOT KIL THEN
  412.             R2 = R2 + 1
  413. 3940        GET #1,R1:
  414.         IF KIL THEN
  415.             GOSUB 4740:
  416.             PRINT #3,KL$:
  417.             GOTO 3980
  418. 3960        LSET R2$ = R1$:
  419.         PUT #2,R2:
  420.         PRINT LEFT$(R2$,63)
  421. 3980    NEXT I:
  422.     R1 = R1 + 1:
  423.     IF NOT KIL THEN
  424.         R2 = R2 + 1
  425. 4000    GOTO 3640
  426. 4010 '
  427. 4020    CLOSE:
  428.     OPEN "O",1,"MESSAGES.BAK":
  429.     CLOSE:
  430.     KILL "MESSAGES.BAK":
  431.     NAME "MESSAGES" AS "MESSAGES.BAK":
  432.     NAME "$MESSAGS.$$$" AS "MESSAGES"
  433. 4040    PRINT "Updating counters..."
  434. 4060    OPEN "O",1,"COUNTERS.BAK":
  435.     CLOSE:
  436.     KILL "COUNTERS.BAK"
  437. 4080    OPEN "R",1,"COUNTERS",15:
  438.     FIELD #1,10 AS C1$,5 AS C2$
  439. 4100    OPEN "R",2,"COUNTERS.BAK",15:
  440.     FIELD #2,15 AS R2$
  441. 4120    GET #1,1:
  442.     LSET R2$ = C1$ + C2$:
  443.     PUT #2,1
  444. 4140    IF PK$ = "Y" THEN
  445.         LSET C2$ = STR$(MSGN - 1):
  446.         PUT #1,1
  447. 4160    CLOSE
  448. 4180    PURGED = -1:
  449.     GOSUB 4580:
  450.     RETURN
  451. 4190 '
  452. 4200 ' BUILD SUMMARY FILE FROM MESSAGE FILE
  453. 4210 '
  454. 4220    PRINT "Building summary file..."
  455. 4240    OPEN "O",1,"SUMMARY.BAK":
  456.     CLOSE:
  457.     KILL "SUMMARY.BAK"
  458. 4260    OPEN "R",1,"MESSAGES",65:
  459.     FIELD #1,65 AS R1$:
  460.     R1 = 1
  461. 4280    OPEN "R",2,"SUMMARY.$$$",30:
  462.     FIELD #2,30 AS R2$:
  463.     R2 = 1
  464. 4300    PRINT SEP$
  465. 4320    FOR I = 1 TO 6
  466. 4340        GET #1,R1:
  467.         IF EOF(1) THEN
  468.             4440
  469. 4360        LSET R2$ = LEFT$(R1$,28) + CRLF$:
  470.         PUT #2,R2
  471. 4380        R1 = R1 + 1:
  472.         R2 = R2 + 1:
  473.         PRINT LEFT$(R2$,28):
  474.         IF EOF(1) THEN
  475.             4440
  476. 4400        IF I = 1 THEN
  477.             IF VAL(R1$) > 9998 THEN
  478.                 4440
  479. 4420    NEXT I:
  480.     R1 = R1 + VAL(R1$):
  481.     GOTO 4300
  482. 4440    CLOSE:
  483.     NAME "SUMMARY" AS "SUMMARY.BAK":
  484.     NAME "SUMMARY.$$$" AS "SUMMARY"
  485. 4460    PRINT "Summary file built.":
  486.     RETURN
  487. 4470 '
  488. 4475 ' Error handlers
  489. 4478 '
  490. 4480    PRINT "Error number: ";ERR;" occurred at line number:";ERL
  491. 4500    IF ERL = 1740 AND ERR = 53 THEN
  492.         PRINT "File not found.":
  493.         RETURN
  494. 4520    IF ERL = 1580 AND ERR = 53 THEN
  495.         PRINT "File not found.":
  496.         CLOSE:
  497.         RESUME 1680
  498. 4540    PRINT "Error number ";ERR;" in line number ";ERL
  499. 4560    RESUME 1240
  500. 4570 '
  501. 4580 ' build message index
  502. 4590 '
  503. 4600    MX = 0:
  504.     MZ = 0
  505. 4620    OPEN "R",1,"SUMMARY",30:
  506.     RE = 1:
  507.     FIELD#1,28 AS RR$
  508. 4640    GET#1,RE:
  509.     IF EOF(1) THEN
  510.         4720
  511. 4660    G = VAL(RR$):
  512.     MZ = MZ + 1:
  513.     M(MZ,1) = G:
  514.     IF G = 0 THEN
  515.         4700
  516. 4680    IF G > 9998 THEN
  517.         MZ = MZ - 1:
  518.         GOTO 4720
  519. 4700    GET#1,RE + 5:
  520.     M(MZ,2) = VAL(RR$):
  521.     MX = MX + M(MZ,2) + 6:
  522.     RE = RE + 6:
  523.     GOTO 4640
  524. 4720    CLOSE:
  525.     RETURN
  526. 4730 '
  527. 4740 ' unpack record
  528. 4750 '
  529. 4760    ZZ = LEN(R1$) - 2
  530. 4780    WHILE MID$(R1$,ZZ,1) = " "
  531. 4800    ZZ = ZZ - 1:
  532.     IF ZZ = 1 THEN
  533.         4840
  534. 4820    WEND
  535. 4840    KL$ = LEFT$(R1$,ZZ)
  536. 4860    RETURN
  537. 5000 '
  538. 5020 ' Test to only allow the SYSOP to use UTIL remotely
  539. 5040 '
  540. 5060    OPEN "I",1,"A:LASTCALR":
  541.     INPUT #1,N$,O$,F$,DT$:
  542.     CLOSE
  543. 5120    OPEN "I",1,"A:PWDS":
  544.     INPUT #1,P1$,P2$:
  545.     CLOSE #1
  546. 5180    PRINT
  547. 5200    IF N$ = MAGIC$ AND O$ = "" THEN
  548.         PRINT "What is the second codeword ? ";:
  549.         B$ = INPUT$(8):
  550.         PRINT:
  551.         GOSUB 2720:
  552.         IF INSTR(B$,P2$) THEN
  553.             RETURN
  554. 5220    PRINT
  555. 5360    OPEN "R",1,"A:CALLERS",60:
  556.     FIELD #1, 60 AS RR$:
  557.     GET #1,1
  558. 5380    RE = VAL(RR$) + 1:
  559.     RL = 60
  560. 5400    GET #1,RE:
  561.     INPUT# 1,S$
  562. 5410    IF INSTR(S$,"UTIL") THEN
  563.         GOTO 6000
  564. 5420    S$ = S$ + " UTIL":
  565.     GOSUB 2740:
  566.     PUT #1,RE:
  567.     CLOSE #1
  568. 5440    PRINT "You know you're not the SYSOP, what are you doing here??"
  569. 5460    PRINT
  570. 5480    PRINT "Go away, your name has been logged for further action!"
  571. 5500    PRINT
  572. 5520    END
  573. 5540 '
  574. 6000    F$ = "TW"        'User has achieved temporary twit status
  575. 6020    OPEN "O",2,"A:LASTCALR. " + CHR$(&HA0):
  576.     PRINT#2,N$;",";O$;",";F$;",";DZ$:
  577.     CLOSE
  578. 6030    PRINT "You were warned to stay out of the SYSOP's domain"
  579. 6040    PRINT
  580. 6050    PRINT "You are being logged off this system IMMEDIATELY"
  581. 6060    PRINT
  582. 6070    CHAIN "BYE"
  583. 6080    END
  584.