100 ' RBSUTL40.BAS A Utility program for use with RBBS35 110 ' Revised from Version 2.7/3.1/3.6 of RBBSUTIL 120 ' 130 ' Randy Cosby 140 ' 150 ' Added purging ability for all of the different boards... 160 ' 170 ' This version does contains the updates from Bill Bolton 180 ' vers 2.7 UTIL.BAS--and Ron Fowlers vers. 3.2 RBSUTL31.BAS 190 ' 200 ' 210 ' Program Starts here..... 220 ' 225 DIM ZZ$(999) 230 DEFINT A-Z 240 VERS$ = "Vers 4.0" 250 ON ERROR GOTO 2190 260 DIM M(200,2) 270 SEP$ = "==============================================" 280 CRLF$ = CHR$(13) + CHR$(10) 285 BS$="0" 290 PURGED = 0: BACKUP = 0 300 GOSUB 2260 ' BUILD MSG INDEX 310 N$ = "SYSOP": O$ = "" 320 PRINT: PRINT " RBBS Utility ";VERS$ 330 PRINT SEP$ 340 MSGS = 1: CALLS = MSGS + 1: MNUM = CALLS + 1 350 PRINT: INPUT "Command? ",PROMPT$ 360 PRINT: PRINT: IF PROMPT$ = "" THEN GOSUB 400: GOTO 350 370 B$ = MID$(PROMPT$,1,1): GOSUB 1250: SM$ = B$: SM = INSTR ("TFDPEBKRU#",SM$): GOSUB 380: GOTO 350 380 IF SM = 0 THEN 400 390 ON SM GOTO 740,690,570,1310,510,2010,2440,2520,2610,3000 400 PRINT "You're on message base ";BS$: PRINT "Commands allowed are:" 410 PRINT "B ==> build summary file from message file" 420 PRINT "D ==> display an ascii file" 430 PRINT "E ==> end the utility program" 440 PRINT "F ==> list the disk directory" 450 PRINT "K ==> kill a file" 460 PRINT "P ==> purge the message files" 470 PRINT "R ==> rename a file" 480 PRINT "T ==> transfers a disk file to the message file" 485 PRINT "U ==> unerase killed messages" 490 PRINT "# ==> change message base number" 491 GOTO 350 500 ' 510 ' END OF PROGRAM 520 ' 530 PRINT:PRINT:SYSTEM 540 ' 550 ' DISPLAY A FILE 560 ' 570 B$ = MID$(PROMPT$,2): IF B$ = "" THEN INPUT "Filename? ",B$: PRINT 580 IF B$ = "" THEN RETURN ELSE GOSUB 1250: FILN$ = B$ 590 OPEN "I",1,FILN$ 600 IF EOF(1) THEN 640 610 BI = ASC(INKEY$+" "): IF BI = 19 THEN BI = ASC(INPUT$(1)) 620 IF BI = 11 THEN PRINT: PRINT "++ Aborted ++": PRINT: CLOSE: RETURN 630 LINE INPUT #1,LIN$: PRINT LIN$: GOTO 600 640 CLOSE: PRINT: PRINT: PRINT "++ End Of File ++": PRINT 650 RETURN 660 ' 670 ' DISPLAY DIRECTORY 680 ' 690 B$ = PROMPT$: GOSUB 1250: IF LEN(B$) > 1 THEN SPEC$ = MID$(B$,3) ELSE SPEC$ = "*.*" 700 FILES SPEC$: PRINT: RETURN 710 ' 720 ' TRANSFER A DISK FILE 730 ' 740 PRINT "Active # of msg's ";: OPEN "R",1,"COUNTERS."+BS$,5: FIELD#1,5 AS RR$: GET#1,MSGS: M = VAL(RR$) 750 PRINT STR"$(M) + " " 760 PRINT "Last caller (this board) was # ";: GET#1,CALLS: PRINT STR$(VAL(RR$)) 770 PRINT "This msg # will be ";: GET#1,MNUM: U = VAL(RR$): PRINT STR$(U + 1): CLOSE 780 ' 790 ' ***ENTER A NEW MESSAGE*** 800 ' 810 IF NOT PURGED THEN PRINT "Files must be purged before messages can be added": RETURN 820 OPEN "R",1,"COUNTERS."+BS$,5: PRINT "Msg # will be ";: FIELD#1,5 AS RR$: GET#1,MNUM: V = VAL(RR$) 830 PRINT STR$(V + 1): CLOSE 840 INPUT "Message file name? ",B$: GOSUB 1250: FIL$ = B$ 850 INPUT "Todays date (DD/MM|HH/MM)?",B$: GOSUB 1250: IF B$ = "" THEN D$ = DT$ ELSE D$ = B$ 860 INPUT "Who to (C/R for ALL)?";B$: GOSUB 1250: IF B$ = "" THEN T$ = "ALL" ELSE T$ = B$ 870 INPUT "Subject?",B$: GOSUB 1250: K$ = B$ 880 INPUT "Password?",B$: GOSUB 1250: PW$ = B$: IF T$ = "ALL" AND LEFT$(PW$,1) = "*" THEN PRINT CHR$(7);"You CANNOT use '*' with ALL.": GOTO 880 890 F = 0 ' F IS MESSAGE LENGTH 900 PRINT "Updating counters": OPEN "R",1,"COUNTERS."+BS$,5: FIELD#1,5 AS RR$ 910 GET#1,MNUM: LSET RR$ = STR$(VAL(RR$) + 1): PUT#1,MNUM 920 GET#1,MSGS: LSET RR$ = STR$(VAL(RR$) + 1): PUT#1,MSGS: CLOSE#1 930 PRINT "Updating msg file": OPEN "R",1,"MESSAGES."+BS$,65: RL = 65 940 FIELD#1,65 AS RR$ 950 RE = MX + 7: F = 0 960 OPEN "I",2,FIL$: IF EOF(2) THEN PRINT "File empty.": CLOSE#1: CLOSE#2: END 970 IF EOF(2) THEN S$ = "9999": GOSUB 1260: PUT #1,RE: CLOSE #2: GOTO 1010 980 LINE INPUT #2,S$ 990 IF LEN(S$) > 63 THEN S$ = LEFT$(S$,63) 1000 PRINT S$: GOSUB 1260: PUT #1,RE: RE = RE + 1: F = F + 1: GOTO 970 1010 RE = MX + 1 1020 S$ = STR$(V + 1): GOSUB 1260: PUT#1,RE 1030 RE = RE + 1: S$ = D$: GOSUB 1260: PUT#1,RE 1040 RE = RE + 1: S$ = N$ + " " + O$: GOSUB 1260: PUT#1,RE 1050 RE = RE + 1: S$ = T$: GOSUB 1260: PUT#1,RE 1060 RE = RE + 1: S$ = K$: GOSUB 1260: PUT#1,RE: RE = RE + 1: S$ = STR$(F): GOSUB 1260: PUT#1,RE 1070 CLOSE #1 1080 IF PW$ <> "" THEN PW$ = ";" + PW$ 1090 PRINT "Updating summary file." 1100 OPEN "R",1,"SUMMARY."+BS$,30: RE = 1: FIELD#1,30 AS RR$: RL = 30 1110 RE = MZ * 6 + 1: S$ = STR$(V + 1) + PW$: GOSUB 1260: PUT#1,RE 1120 RE = RE + 1: S$ = D$: GOSUB 1260: PUT#1,RE 1130 RE = RE + 1: S$ = N$ + " " + O$: GOSUB 1260: PUT#1,RE 1140 RE = RE + 1: S$ = T$: GOSUB 1260: PUT#1,RE 1150 RE = RE + 1: S$ = K$: GOSUB 1260: PUT#1,RE 1160 RE = RE + 1: S$ = STR$(F): GOSUB 1260: PUT#1,RE 1170 RE = RE + 1: S$ = " 9999": GOSUB 1260: PUT#1,RE 1180 CLOSE#1 1190 MX = MX + F + 6: MZ = MZ + 1: M(MZ,1) = V + 1: M(MZ,2) = F 1200 U = U + 1 1210 RETURN 1220 ' 1230 ' Convert the string B$ to upper case 1240 ' 1250 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 1260 ' 1270 ' FILL AND STORE DISK RECORD 1280 ' 1290 LSET RR$ = LEFT$(S$ + SPACE$(RL - 2),RL - 2) + CHR$(13) + CHR$(10) 1300 RETURN 1310 ' 1320 ' PURGE KILLED MESSAGES FROM FILES 1330 ' 1340 IF PURGED THEN PRINT "Files already purged.": RETURN 1350 INPUT "Today's date (DD/MM/YY) ?",DATE$ 1360 IF LEN(DATE$) > 8 THEN PRINT "Must be less then 8 characters.": GOTO 1350 1370 IF DATE$ = "" THEN DATE$ = DT$ 1380 OPEN "R",1,DATE$+".AR"+BS$ 1390 IF LOF(1) > 0 THEN PRINT "Archive file: ";DATE$ + ".ARC";" exists.": CLOSE: RETURN 1400 CLOSE 1410 MSGN = 1: INPUT "Renumber messages?",PK$: PK$ = MID$(PK$,1,1) 1420 IF PK$ = "y" THEN PK$ = "Y" 1430 IF PK$ <> "Y" THEN 1460 1440 INPUT "Message number to start (CR=1)?",MSG$: IF MSG$ = "" THEN MSG$="1" 1450 MSGN = VAL(MSG$): IF MSGN = 0 THEN PRINT "Invalid msg #.": RETURN 1460 PRINT "Purging summary file...": OPEN "R",1,"SUMMARY."+BS$,30 1470 FIELD#1,30 AS R1$ 1480 R1 = 1 1490 OPEN "R",2,"$SUMMARY.$$$",30 1500 FIELD#2,30 AS R2$ 1510 R2 = 1 1520 PRINT SEP$: GET#1,R1: IF EOF(1) THEN 1650 1530 IF VAL(R1$) = 0 THEN R1 = R1 + 6: PRINT "Deletion": GOTO 1520 1540 IF PK$ = "Y" AND VAL(R1$) < 9999 THEN IF INSTR(R1$,";") THEN PASS$ = MID$(R1$,INSTR(R1$,";"),27) ELSE PASS$ = SPACE$(28) 1550 IF PK$ = "Y" AND VAL(R1$) < 9999 THEN LSET R2$ = LEFT$(STR$(MSGN) + PASS$,28) + CHR$(13) + CHR$(10): MSGN = MSGN + 1: GOTO 1570 1560 LSET R2$ = R1$ 1570 PUT #2,R2 1580 PRINT LEFT$(R2$,28) 1590 IF VAL(R1$) > 9998 THEN 1650 1600 FOR I = 1 TO 5 1610 R1 = R1 + 1: R2 = R2 + 1: GET#1,R1: LSET R2$ = R1$: PUT#2,R2 1620 PRINT LEFT$(R2$,28) 1630 NEXT I 1640 R1 = R1 + 1: R2 = R2 + 1: GOTO 1520 1650 CLOSE: OPEN "O",1,"SUMMARY.BAK": CLOSE: KILL "SUMMARY.BAK": NAME "SUMMARY."+BS$ AS "SUMMARY.BAK": NAME "$SUMMARY.$$$" AS "SUMMARY."+BS$ 1660 PRINT "Purging message file...": MSGN = VAL(MSG$) 1670 OPEN "R",1,"MESSAGES."+BS$,65: FIELD #1,65 AS R1$ 1680 OPEN "R",2,"$MESSAGS.$$$",65: FIELD #2,65 AS R2$ 1690 OPEN "O",3,DATE$+".AR"+BS$: R1 = 1: KIL = 0 1700 R1 = 1: R2 = 1 1710 PRINT SEP$: GET #1,R1: IF EOF(1) THEN 1910 1720 IF VAL(R1$) = 0 THEN KIL = -1: PRINT "Archiving message": GOTO 1780 1730 KIL = 0 1740 IF PK$ = "Y" AND VAL(R1$) < 9999 THEN IF INSTR(R1$,";") THEN PASS$ = MID$(R1$,INSTR(R1$,";"),62) ELSE PASS$ = SPACE$(62) 1750 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 1770 1760 LSET R2$ = R1$: PRINT LEFT$(R2$,6) 1770 PUT #2,R2 1780 IF KIL THEN GOSUB 2360: PRINT #3,KL$ 1790 IF VAL(R1$) > 9998 THEN 1910 1800 FOR I = 1 TO 5 1810 R1 = R1 + 1: IF NOT KIL THEN R2 = R2 + 1 1820 GET #1,R1: IF KIL THEN GOSUB 2360: PRINT #3,KL$: GOTO 1840 1830 LSET R2$ = R1$: PUT #2,R2: PRINT LEFT$(R2$,63) 1840 NEXT I 1850 FOR I = 1 TO VAL(R1$): R1 = R1 + 1: IF NOT KIL THEN R2 = R2 + 1 1860 GET #1,R1: IF KIL THEN GOSUB 2360: PRINT #3,KL$: GOTO 1880 1870 LSET R2$ = R1$: PUT #2,R2: PRINT LEFT$(R2$,63) 1880 NEXT I: R1 = R1 + 1: IF NOT KIL THEN R2 = R2 + 1 1890 GOTO 1710 1900 ' 1910 CLOSE: OPEN "O",1,"MESSAGES.BAK": CLOSE: KILL "MESSAGES.BAK": NAME "MESSAGES."+BS$ AS "MESSAGES.BAK": NAME "$MESSAGS.$$$" AS "MESSAGES."+BS$ 1920 PRINT "Updating counters..." 1930 OPEN "O",1,"COUNTERS.BAK": CLOSE: KILL "COUNTERS.BAK" 1940 OPEN "R",1,"COUNTERS."+BS$,15: FIELD #1,10 AS C1$,5 AS C2$ 1950 OPEN "R",2,"COUNTERS.BAK",15: FIELD #2,15 AS R2$ 1960 GET #1,1: LSET R2$ = C1$ + C2$: PUT #2,1 1970 IF PK$ = "Y" THEN LSET C2$ = STR$(MSGN - 1): PUT #1,1 1980 CLOSE 1990 PURGED = -1: GOSUB 2260: RETURN 2000 ' 2010 ' BUILD SUMMARY FILE FROM MESSAGE FILE 2020 ' 2030 PRINT "Building summary file..." 2040 OPEN "O",1,"SUMMARY.BAK": CLOSE: KILL "SUMMARY.BAK" 2050 OPEN "R",1,"MESSAGES."+BS$,65: FIELD #1,65 AS R1$: R1 = 1 2060 OPEN "R",2,"SUMMARY.$$$",30: FIELD #2,30 AS R2$: R2 = 1 2070 PRINT SEP$ 2080 FOR I = 1 TO 6 2090 GET #1,R1: IF EOF(1) THEN 2140 2100 LSET R2$ = LEFT$(R1$,28) + CRLF$: PUT #2,R2 2110 R1 = R1 + 1: R2 = R2 + 1: PRINT LEFT$(R2$,28): IF EOF(1) THEN 2140 2120 IF I = 1 THEN IF VAL(R1$) > 9998 THEN 2140 2130 NEXT I: R1 = R1 + VAL(R1$): GOTO 2070 2140 CLOSE: NAME "SUMMARY."+BS$ AS "SUMMARY.BAK": NAME "SUMMARY.$$$" AS "SUMMARY."+BS$ 2150 PRINT "Summary file built.": RETURN 2160 ' 2170 ' Error handlers 2180 ' 2190 IF (ERL = 700) AND (ERR = 53) THEN PRINT "File not found.": RESUME 350 2200 IF (ERL = 590) AND (ERR = 53) THEN PRINT "File not found.": CLOSE: RESUME 650 2210 IF (ERL = 2590) AND (ERR = 53) THEN PRINT "You cannot rename a file that doesn't already exist": RESUME 350 2220 IF (ERL = 2490) AND (ERR = 53) THEN PRINT "That file doesn't exist so you can't erase it": RESUME 350 2230 PRINT "Error number ";ERR;" in line number ";ERL 2240 RESUME 350 2250 ' 2260 ' build message index 2270 ' 2280 MX = 0: MZ = 0 2290 OPEN "R",1,"SUMMARY."+BS$,30: RE = 1: FIELD#1,28 AS RR$ 2300 GET#1,RE: IF EOF(1) THEN 2340 2310 G = VAL(RR$): MZ = MZ + 1: M(MZ,1) = G: IF G = 0 THEN 2330 2320 IF G > 9998 THEN MZ = MZ - 1: GOTO 2340 2330 GET#1,RE + 5: M(MZ,2) = VAL(RR$): MX = MX + M(MZ,2) + 6: RE = RE + 6: GOTO 2300 2340 CLOSE: RETURN 2350 ' 2360 ' unpack record 2370 ' 2380 ZZ = LEN(R1$) - 2 2390 WHILE MID$(R1$,ZZ,1) = " " 2400 ZZ = ZZ - 1: IF ZZ = 1 THEN 2420 2410 WEND 2420 KL$ = LEFT$(R1$,ZZ) 2430 RETURN 2440 ' 2450 ' Kill (Erase) a file 2460 ' 2470 B$ = MID$(PROMPT$,3): IF B$ = "" THEN INPUT "Filename? ",B$: PRINT 2480 IF B$ = "" THEN RETURN ELSE GOSUB 1250: FILN$ = B$ 2490 KILL FILN$ 2500 PRINT 2510 RETURN 2520 ' 2530 ' Rename a file 2540 ' 2550 INPUT "Existing Filename? ",B$: PRINT 2560 IF B$ = "" THEN RETURN ELSE GOSUB 1250: EFILN$ = B$ 2570 PRINT: INPUT "New Filename? ",B$: PRINT 2580 IF B$ = "" THEN RETURN ELSE GOSUB 1250: NFILN$ = B$ 2590 NAME EFILN$ AS NFILN$ 2600 PRINT: RETURN 2610 REM 2620 REM ===> UNKILL A MESSAGE 2630 REM 2640 PRINT"Unerased messages:":PRINT 2645 V=0 2650 OPEN"R",1,DSK2$+"SUMMARY."+BS$,30:RE=1:FIELD#1,30 AS RR$:RL=30 2660 GET#1,RE 2665 IF LEFT$(RR$,5)=" 9999"THEN 2800 2670 IF LEFT$(RR$,3)<>" 0:"THEN RE=RE+1:GOTO 2660 2680 A=INSTR(RR$,";"):IF A=0 THEN A=10 2685 ZZ$=MID$(RR$,5,A-6):PRINT ZZ$ 2690 FOR A=1 TO 5:RE=RE+1:GET#1,RE 2700 IF A=1 THEN PRINT"sent: "RR$; 2710 IF A=2 THEN PRINT"from: "RR$; 2720 IF A=3 THEN PRINT"to: "RR$; 2730 IF A=4 THEN PRINT"re: "RR$; 2740 IF A=5 THEN PRINT 2750 NEXT A 2760 RE=RE+1 2770 GOTO 2660 2800 CLOSE:INPUT"Unerase message #: ";M$ 2805 IF M$=""THEN 350 2806 OPEN"R",1,"SUMMARY."+BS$,30:FIELD#1,30 AS RR$ 2807 PRINT"updating summary..."; 2810 RE=1 2820 GET#1,RE 2825 IF LEFT$(RR$,5)=" 9999"THEN PRINT"not found":GOTO 2800 2830 A=INSTR(RR$,":"):IF A=0 THEN A=INSTR(RR$,",") 2840 ZZ$=LEFT$(RR$,4+LEN(M$)) 2850 IF ZZ$<>" 0: "+M$ THEN RE=RE+6:GOTO 2820 2860 LSET RR$=RIGHT$(RR$,26) 2870 PUT#1,RE 2880 CLOSE 2885 PRINT"updating messages..."; 2890 OPEN"R",1,"MESSAGES."+BS$,65:FIELD#1,65 AS RR$ 2900 RE=1 2910 GET#1,RE 2915 IF LEFT$(RR$,5)=" 9999"THEN CLOSE:GOTO 2950 2920 IF LEFT$(RR$,4+LEN(M$))=" 0: "+M$ THEN LSET RR$=RIGHT$(RR$,61):PUT#1,RE: CLOSE: GOTO 2950 2930 RE=RE+1 2940 GOTO 2910 2950 PRINT"updating counters..."; 2960 OPEN"R",1,DSK2$+"COUNTERS",5:FIELD#1,5 AS RR$ 2970 GET#1,1 2980 LSET RR$=STR$(VAL(RR$)+1):PUT#1,1 2985 CLOSE 2990 PRINT:PRINT"message unerased.":GOTO 2800 3000 PRINT "CHANGE BASES..." 3010 PRINT "Make SURE that you don't go above the number of bases..." 3020 PRINT:PRINT "BASE:";:INPUT B 3030 BS$=STR$(B) 3040 GOTO 350