160 '
180 ' RBBSUTIL.BAS ==> UTILITY PROGRAM FOR THE RBBS REMOTE BULLETIN BOARD SYS
200 ' BY RON FOWLER, WESTLAND, MICH RBBS (313)-729-1905 (RINGBACK)
220 ' Please report any problems, bugs, fixes, etc. to the above RBBS if
221 ' if in USA or to: 
230 ' Bill Bolton, "Software Tools" RCPM (02)997-1836 (modem)
235 ' if in Australia
240 '
260 ' 06/Jun/82
280 ' Passwords in messages were being killed during purges only if
300 ' the messages were renumbered, fixed now. Added code to 
320 ' read date from LASTCALR (lifted from MINIRBBS) and default
340 ' to current date if new date not specifically entered. Added
360 ' password check so that this utility can be left out for remote
380 ' use (but make it an unusual name, SYS and TAG as well).
400 ' Bill Bolton (Australia)
420 '
430 ' 14/Jun/82
440 ' Upper case conversion added to file name entered with D option
445 ' and UTIL status permanetly written to CALLERS for those who
446 ' find this file. Also TW status written to LASTCALR and 
447 ' immediate log out for those that ignore warning. Bill Bolton
450 '
460 ' 21/Mar/82
470 ' Added password check for "*" in messages to ALL. Version 2.5
480 ' Bill Bolton
490 '
500 ' 07/Jul/83
510 ' Added more stringent password check from ENTRBBS version 3.1
520 ' and fixed some bugs in the command processor code. Added freeze
530 ' and abort code to D option. Added uppercase conversion to F
540 ' option. Version 2.6 Bill Bolton
550 '
560 ' 13/Jul/83
570 ' Added file renaming and deletion options. Version 2.7 Bill Bolton
580 '
980	DEFINT A-Z
990	VERS$ = "Vers 2.7"
1000	ON ERROR GOTO 4030
1010	DIM M(200,2)
1020	SEP$ = "=============================================="
1030	CRLF$ = CHR$(13) + CHR$(10)
1040	PURGED = 0:

	BACKUP = 0
1050	GOSUB 4210		' BUILD MSG INDEX
1060	N$ = "SYSOP":

	O$ = "":

	MAGIC$ = "SUPER"
1070	GOSUB 4390		'Test for SYSOP
1080	PRINT:

	PRINT "             RCPM Utilty ";VERS$
1090	PRINT SEP$
1100	MSGS = 1:

	CALLS = MSGS + 1:

	MNUM = CALLS + 1
1110	PRINT:

	INPUT "Command? ",PROMPT$
1120	PRINT:

	PRINT:

	IF PROMPT$ = "" THEN

		GOSUB 1160:

		GOTO 1110
1130	B$ = MID$(PROMPT$,1,1):

	GOSUB 2330:

	SM$ = B$:

	SM = INSTR ("TFDPEBKRA",SM$):

	GOSUB 1140:

	GOTO 1110
1140	IF SM = 0 THEN

		1160
1150	ON SM GOTO 1730,1630,1430,2500,1300,3210,4800,4900
1160	PRINT:

	PRINT "Commands allowed are:"
1170	PRINT "B   ==> build summary file from message file"
1180	PRINT "D   ==> display an ascii file"
1190	PRINT "E   ==> end the utility program"
1200	PRINT "F   ==> prints the disk directory
1210	PRINT "K   ==> kill a file"
1220	PRINT "P   ==> purge the message files"
1230	PRINT "R   ==> rename a file"
1240	PRINT "T   ==> transfers a disk file to the message file"
1250	RETURN
1260 '
1300 ' END OF PROGRAM
1310 '
1320	PRINT:

	PRINT:

	END
1400 '
1410 ' DISPLAY A FILE
1420 '
1430	B$ = MID$(PROMPT$,2):

	IF B$ = "" THEN

		INPUT "Filename? ",B$:

		PRINT
1440	IF B$ = "" THEN

		RETURN

	ELSE

		GOSUB 2330:

		FILN$ = B$
1450	OPEN "I",1,FILN$
1460	IF EOF(1) THEN

		1500
1470	BI = ASC(INKEY$+" "):

	IF BI = 19 THEN

		BI = ASC(INPUT$(1))
1480	IF BI = 11 THEN

		PRINT:

		PRINT "++ Aborted ++":

		PRINT:

		CLOSE:

		RETURN
1490	LINE INPUT #1,LIN$:

	PRINT LIN$:

	GOTO 1460
1500	CLOSE:

	PRINT:

	PRINT:

	PRINT "++ End Of File ++":

	PRINT
1510	RETURN
1600 '
1610 ' DISPLAY DIRECTORY
1620 '
1630	B$ = PROMPT$:

	GOSUB 2330:

	IF LEN(B$) > 1 THEN

		SPEC$ = MID$(B$,3)

	ELSE

		SPEC$ = "*.*"
1640	FILES SPEC$:

	PRINT:

	RETURN
1700 '
1710 ' TRANSFER A DISK FILE
1720 '
1730	PRINT "Active # of msg's ";:

	OPEN "R",1,"COUNTERS",5:

	FIELD#1,5 AS RR$:

	GET#1,MSGS:

	M = VAL(RR$)
1740	PRINT STR"$(M) + " "
1750	PRINT "Last caller was # ";:

	GET#1,CALLS:

	PRINT STR$(VAL(RR$))
1760	PRINT "This msg # will be ";:

	GET#1,MNUM:

	U = VAL(RR$):

	PRINT STR$(U + 1):

	CLOSE
1800 '
1810 ' ***ENTER A NEW MESSAGE***
1820 '
1830	IF NOT PURGED THEN

		PRINT "Files must be purged before messages can be added":

		RETURN
1840	OPEN "R",1,"COUNTERS",5:

	PRINT "Msg # will be ";:

	FIELD#1,5 AS RR$:

	GET#1,MNUM:

	V = VAL(RR$)
1850	PRINT STR$(V + 1):

	CLOSE
1860	INPUT "Message file name? ",B$:

	GOSUB 2330:

	FIL$ = B$
1870	INPUT "Todays date (DD/MM/YY)?",B$:

	GOSUB 2330:

	IF B$ = "" THEN

		D$ = DT$

	ELSE

		D$ = B$
1880	INPUT "Who to (C/R for ALL)?";B$:

	GOSUB 2330:

	IF B$ = "" THEN

		T$ = "ALL"

	ELSE

		T$ = B$
1890	INPUT "Subject?",B$:

	GOSUB 2330:

	K$ = B$
1900	INPUT "Password?",B$:

	GOSUB 2330:

	PW$ = B$:

	IF T$ = "ALL" AND LEFT$(PW$,1) = "*" THEN

		PRINT CHR$(7);"You CANNOT use '*' with ALL.":

		GOTO 1900
1910	F = 0			' F IS MESSAGE LENGTH
1920	PRINT "Updating counters":

	OPEN "R",1,"COUNTERS",5:

	FIELD#1,5 AS RR$
1930	GET#1,MNUM:

	LSET RR$ = STR$(VAL(RR$) + 1):

	PUT#1,MNUM
1940	GET#1,MSGS:

	LSET RR$ = STR$(VAL(RR$) + 1):

	PUT#1,MSGS:

	CLOSE#1
1950	PRINT "Updating msg file":

	OPEN "R",1,"MESSAGES",65:

	RL = 65
1960	FIELD#1,65 AS RR$
1970	RE = MX + 7:

	F = 0
1980	OPEN "I",2,FIL$:

	IF EOF(2) THEN

		PRINT "File empty.":

		CLOSE#1:

		CLOSE#2:

		END
1990	IF EOF(2) THEN

		S$ = "9999":

		GOSUB 2400:

		PUT #1,RE:

		CLOSE #2:

		GOTO 2030
2000	LINE INPUT #2,S$
2010	IF LEN(S$) > 63 THEN

		S$ = LEFT$(S$,63)
2020	PRINT S$:

	GOSUB 2400:

	PUT #1,RE:

	RE = RE + 1:

	F = F + 1:

	GOTO 1990
2030	RE = MX + 1
2040	S$ = STR$(V + 1):

	GOSUB 2400:

	PUT#1,RE
2050	RE = RE + 1:

	S$ = D$:

	GOSUB 2400:

	PUT#1,RE
2060	RE = RE + 1:

	S$ = N$ + " " + O$:

	GOSUB 2400:

	PUT#1,RE
2070	RE = RE + 1:

	S$ = T$:

	GOSUB 2400:

	PUT#1,RE
2080	RE = RE + 1:

	S$ = K$:

	GOSUB 2400:

	PUT#1,RE:

	RE = RE + 1:

	S$ = STR$(F):

	GOSUB 2400:

	PUT#1,RE
2090	CLOSE #1
2100	IF PW$ <> "" THEN

		PW$ = ";" + PW$
2110	PRINT "Updating summary file."
2120	OPEN "R",1,"SUMMARY",30:

	RE = 1:

	FIELD#1,30 AS RR$:

	RL = 30
2130	RE = MZ * 6 + 1:

	S$ = STR$(V + 1) + PW$:

	GOSUB 2400:

	PUT#1,RE
2140	RE = RE + 1:

	S$ = D$:

	GOSUB 2400:

	PUT#1,RE
2150	RE = RE + 1:

	S$ = N$ + " " + O$:

	GOSUB 2400:

	PUT#1,RE
2160	RE = RE + 1:

	S$ = T$:

	GOSUB 2400:

	PUT#1,RE
2170	RE = RE + 1:

	S$ = K$:

	GOSUB 2400:

	PUT#1,RE
2180	RE = RE + 1:

	S$ = STR$(F):

	GOSUB 2400:

	PUT#1,RE
2190	RE = RE + 1:

	S$ = " 9999":

	GOSUB 2400:

	PUT#1,RE
2200	CLOSE#1
2210	MX = MX + F + 6:

	MZ = MZ + 1:

	M(MZ,1) = V + 1:

	M(MZ,2) = F
2220	U = U + 1
2230	RETURN
2300 '
2310 ' Convert the string B$ to upper case
2320 '
2330	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
2400 '
2410 ' FILL AND STORE DISK RECORD
2420 '
2430	LSET RR$ = LEFT$(S$ + SPACE$(RL - 2),RL - 2) + CHR$(13) + CHR$(10)
2440	RETURN
2500 '
2510 ' PURGE KILLED MESSAGES FROM FILES
2520 '
2530	IF PURGED THEN

		PRINT "Files already purged.":

		RETURN
2540	INPUT "Today's date (DD/MM/YY) ?",DATE$
2550	IF LEN(DATE$) > 8 THEN

		PRINT "Must be less then 8 characters.":

		GOTO 2540
2560	IF DATE$ = "" THEN

		DATE$ = DT$
2570	OPEN "R",1,DATE$+".ARC"
2580	IF LOF(1) > 0 THEN

		PRINT "Archive file: ";DATE$ + ".ARC";" exists.":

		CLOSE:

		RETURN
2590	CLOSE
2600	MSGN = 1:

	INPUT "Renumber messages?",PK$:

	PK$ = MID$(PK$,1,1)
2610	IF PK$ = "y" THEN

		PK$ = "Y"
2620	IF PK$ <> "Y" THEN

		2650
2630	INPUT "Message number to start (CR=1)?",MSG$:

	IF MSG$ = "" THEN

		MSG$="1"
2640	MSGN = VAL(MSG$):

	IF MSGN = 0 THEN

		PRINT "Invalid msg #.":

		RETURN
2650	PRINT "Purging summary file...":

	OPEN "R",1,"SUMMARY",30
2660	FIELD#1,30 AS R1$
2670	R1 = 1
2680	OPEN "R",2,"$SUMMARY.$$$",30
2690	FIELD#2,30 AS R2$
2700	R2 = 1
2710	PRINT SEP$:

	GET#1,R1:

	IF EOF(1) THEN

		2840
2720	IF VAL(R1$) = 0 THEN

		R1 = R1 + 6:

		PRINT "Deletion":

		GOTO 2710
2730	IF PK$ = "Y" AND VAL(R1$) < 9999 THEN

		IF INSTR(R1$,";") THEN

			PASS$ = MID$(R1$,INSTR(R1$,";"),27)

		ELSE

			PASS$ = SPACE$(28)
2740	IF PK$ = "Y" AND VAL(R1$) < 9999 THEN

		LSET R2$ = LEFT$(STR$(MSGN) + PASS$,28) + CHR$(13) + CHR$(10):

		MSGN = MSGN + 1:

		GOTO 2760
2750	LSET R2$ = R1$
2760	PUT #2,R2
2770	PRINT LEFT$(R2$,28)
2780	IF VAL(R1$) > 9998 THEN

		2840
2790	FOR I = 1 TO 5
2800		R1 = R1 + 1:

		R2 = R2 + 1:

		GET#1,R1:

		LSET R2$ = R1$:

		PUT#2,R2
2810		PRINT LEFT$(R2$,28)
2820	NEXT I
2830	R1 = R1 + 1:

	R2 = R2 + 1:

	GOTO 2710
2840	CLOSE:

	OPEN "O",1,"SUMMARY.BAK":

	CLOSE:

	KILL "SUMMARY.BAK":

	NAME "SUMMARY" AS "SUMMARY.BAK":

	NAME "$SUMMARY.$$$" AS "SUMMARY"
2850	PRINT "Purging message file...":

	MSGN = VAL(MSG$)
2860	OPEN "R",1,"MESSAGES",65:

	FIELD #1,65 AS R1$
2870	OPEN "R",2,"$MESSAGS.$$$",65:

	FIELD #2,65 AS R2$
2880	OPEN "O",3,DATE$+".ARC":

	R1 = 1:

	KIL = 0
2890	R1 = 1:

	R2 = 1
2900	PRINT SEP$:

	GET #1,R1:

	IF EOF(1) THEN

		 3100
2910	IF VAL(R1$) = 0 THEN

		KIL = -1:

		PRINT "Archiving message":

		GOTO 2970
2920	KIL = 0
2930	IF PK$ = "Y" AND VAL(R1$) < 9999 THEN

		IF INSTR(R1$,";") THEN

			PASS$ = MID$(R1$,INSTR(R1$,";"),62)

		ELSE

			PASS$ = SPACE$(62)
2940	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 2960
2950	LSET R2$ = R1$:

	PRINT LEFT$(R2$,6)
2960	PUT #2,R2
2970	IF KIL THEN

		GOSUB 4310:

		PRINT #3,KL$
2980	IF VAL(R1$) > 9998 THEN

		3100
2990	FOR I = 1 TO 5
3000		R1 = R1 + 1:

		IF NOT KIL THEN

			R2 = R2 + 1
3010		GET #1,R1:

		IF KIL THEN

			GOSUB 4310:

			PRINT #3,KL$:

			GOTO 3030
3020		LSET R2$ = R1$:

		PUT #2,R2:

		PRINT LEFT$(R2$,63)
3030	NEXT I
3040	FOR I = 1 TO VAL(R1$):

		R1 = R1 + 1:

		IF NOT KIL THEN

			R2 = R2 + 1
3050		GET #1,R1:

		IF KIL THEN

			GOSUB 4310:

			PRINT #3,KL$:

			GOTO 3070
3060		LSET R2$ = R1$:

		PUT #2,R2:

		PRINT LEFT$(R2$,63)
3070	NEXT I:

	R1 = R1 + 1:

	IF NOT KIL THEN

		R2 = R2 + 1
3080	GOTO 2900
3090 '
3100	CLOSE:

	OPEN "O",1,"MESSAGES.BAK":

	CLOSE:

	KILL "MESSAGES.BAK":

	NAME "MESSAGES" AS "MESSAGES.BAK":

	NAME "$MESSAGS.$$$" AS "MESSAGES"
3110	PRINT "Updating counters..."
3120	OPEN "O",1,"COUNTERS.BAK":

	CLOSE:

	KILL "COUNTERS.BAK"
3130	OPEN "R",1,"COUNTERS",15:

	FIELD #1,10 AS C1$,5 AS C2$
3140	OPEN "R",2,"COUNTERS.BAK",15:

	FIELD #2,15 AS R2$
3150	GET #1,1:

	LSET R2$ = C1$ + C2$:

	PUT #2,1
3160	IF PK$ = "Y" THEN

		LSET C2$ = STR$(MSGN - 1):

		PUT #1,1
3170	CLOSE
3180	PURGED = -1:

	GOSUB 4210:

	RETURN
3200 '
3210 ' BUILD SUMMARY FILE FROM MESSAGE FILE
3220 '
3230	PRINT "Building summary file..."
3240	OPEN "O",1,"SUMMARY.BAK":

	CLOSE:

	KILL "SUMMARY.BAK"
3250	OPEN "R",1,"MESSAGES",65:

	FIELD #1,65 AS R1$:

	R1 = 1
3260	OPEN "R",2,"SUMMARY.$$$",30:

	FIELD #2,30 AS R2$:

	R2 = 1
3270	PRINT SEP$
3280	FOR I = 1 TO 6
3290		GET #1,R1:

		IF EOF(1) THEN

			3340
3300		LSET R2$ = LEFT$(R1$,28) + CRLF$:

		PUT #2,R2
3310		R1 = R1 + 1:

		R2 = R2 + 1:

		PRINT LEFT$(R2$,28):

		IF EOF(1) THEN

			3340
3320		IF I = 1 THEN

			IF VAL(R1$) > 9998 THEN

				3340
3330	NEXT I:

	R1 = R1 + VAL(R1$):

	GOTO 3270
3340	CLOSE:

	NAME "SUMMARY" AS "SUMMARY.BAK":

	NAME "SUMMARY.$$$" AS "SUMMARY"
3350	PRINT "Summary file built.":

	RETURN
4000 '
4010 ' Error handlers
4020 '
4030	IF (ERL = 1640) AND (ERR = 53) THEN

		PRINT "File not found.":

		RESUME 1110
4040	IF (ERL = 1450) AND (ERR = 53) THEN

		PRINT "File not found.":

		CLOSE:

		RESUME 1510
4050	IF (ERL = 4970) AND (ERR = 53) THEN

		PRINT "You cannot rename a file that doesn't already exist":

		RESUME 1110
4060	IF (ERL = 4850) AND (ERR = 53) THEN

		PRINT "That file doesn't exist so you can't erase it":

		RESUME 1110
4070	PRINT "Error number ";ERR;" in line number ";ERL
4080	RESUME 1110
4200 '
4210 ' build message index
4220 '
4230	MX = 0:

	MZ = 0
4240	OPEN "R",1,"SUMMARY",30:

	RE = 1:

	FIELD#1,28 AS RR$
4250	GET#1,RE:

	IF EOF(1) THEN

		4290
4260	G = VAL(RR$):

	MZ = MZ + 1:

	M(MZ,1) = G:

	IF G = 0 THEN

		4280
4270	IF G > 9998 THEN

		MZ = MZ - 1:

		GOTO 4290
4280	GET#1,RE + 5:

	M(MZ,2) = VAL(RR$):

	MX = MX + M(MZ,2) + 6:

	RE = RE + 6:

	GOTO 4250
4290	CLOSE:

	RETURN
4300 '
4310 ' unpack record
4320 '
4330	ZZ = LEN(R1$) - 2
4340	WHILE MID$(R1$,ZZ,1) = " "
4350	ZZ = ZZ - 1:

	IF ZZ = 1 THEN

		4370
4360	WEND
4370	KL$ = LEFT$(R1$,ZZ)
4380	RETURN
4390 '
4400 ' Test to only allow the SYSOP to use UTIL remotely
4410 '
4420	OPEN "I",1,"A:LASTCALR":

	INPUT #1,N$,O$,F$,DT$:

	CLOSE
4430	OPEN "I",1,"A:PWDS":

	INPUT #1,P1$,P2$:

	CLOSE #1
4440	PRINT
4450	IF N$ = MAGIC$ AND O$ = "" THEN

			GOSUB 4610:

			IF SYSOP = 1 THEN

				RETURN
4460	PRINT
4470	OPEN "R",1,"A:CALLERS",60:

	FIELD #1, 60 AS RR$:

	GET #1,1
4480	RE = VAL(RR$) + 1:

	RL = 60
4490	GET #1,RE:

	INPUT# 1,S$
4500	IF INSTR(S$,"UTIL") THEN

		GOTO 4690
4510	S$ = S$ + " UTIL":

	GOSUB 2400:

	PUT #1,RE:

	CLOSE #1
4520	PRINT "You know you're not the SYSOP, what are you doing here??"
4530	PRINT
4540	PRINT "Go away, your name has been logged for further action!"
4550	PRINT
4560	END
4600 '
4610 '  SYSOP password check
4620 '
4630	PRINT "2nd Codeword? ";:

	B$ = INPUT$(10):

	GOSUB 2330:

	X$ = B$:
4640	PRINT
4650	IF INSTR(X$,P2$) THEN

		IF (MID$(DT$,1,1) = MID$(X$,10,1)) AND (MID$(DT$,2,1) = MID$(X$,9,1)) THEN

			F$ = "":

			SYSOP = 1:

			RETURN
4660	'Use this in place of 5680 if you dont have a real time clock

	IF INSTR(X$,P$) THEN

		F$ = "":

		SYSOP = 1:

		RETURN
4670	SYSOP = 0:

	RETURN
4680	'
4690	F$ = "TW"		'User has achieved temporary twit status
4700	OPEN "O",2,"A:LASTCALR. " + CHR$(&HA0):

	PRINT#2,N$;",";O$;",";F$;",";DZ$:

	CLOSE
4710	PRINT "You were warned to stay out of the SYSOP's domain"
4720	PRINT
4730	PRINT "You are being logged off this system IMMEDIATELY"
4740	PRINT
4750	CHAIN "BYE"
4760	END
4800	'
4810	' Kill (Erase) a file
4820	'
4830	B$ = MID$(PROMPT$,3):

	IF B$ = "" THEN

		INPUT "Filename? ",B$:

		PRINT
4840	IF B$ = "" THEN

		RETURN

	ELSE

		GOSUB 2330:

		FILN$ = B$
4850	KILL FILN$
4860	PRINT
4870	RETURN
4900	'
4910	' Rename a file
4920	'
4930	INPUT "Existing Filename? ",B$:

	PRINT
4940	IF B$ = "" THEN

		RETURN

	ELSE

		GOSUB 2330:

		EFILN$ = B$
4950	PRINT:

	INPUT "New Filename? ",B$:

	PRINT
4960	IF B$ = "" THEN

		RETURN

	ELSE

		GOSUB 2330:

		NFILN$ = B$
4970	NAME EFILN$ AS NFILN$
4980	PRINT:

	RETURN
	PRINT
4960	IF B$ = "" THEN

		RETURN

	ELSE

		GOSUB 2330:

		NFILN$ = B$
4970	NAME