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 '
980	DEFINT A-Z
990	VERS$ = "Vers 2.4"
1000	ON ERROR GOTO 4500
1020	DIM M(200,2)
1040	SEP$ = "=============================================="
1060	CRLF$ = CHR$(13) + CHR$(10)
1080	PURGED = 0:

	BACKUP = 0
1120	GOSUB 4580		' BUILD MSG INDEX
1140	N$ = "SYSOP":

	O$ = "":

	MAGIC$ = "SUPER"
1160	GOSUB 5000		'Test for SYSOP
1180	PRINT:

	PRINT "             RCPM Utilty ";VERS$
1200	PRINT SEP$
1220	MSGS = 1:

	CALLS = MSGS + 1:

	MNUM = CALLS + 1
1240	PRINT:

	INPUT "Command? ",PROMPT$
1260	PRINT:

	PRINT:

	IF PROMPT$ = "" THEN

		1340
1280	B$ = MID$(PROMPT$,1,1):

	GOSUB 2720:

	SM$ = B$:

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

	GOSUB 1300:

	GOTO 1240
1300	IF SM = 0 THEN

		1340
1320	ON SM GOTO 1780,1720,1560,2840,1500,4200
1340	PRINT:

	PRINT "Commands allowed are:"
1360	PRINT "B   ==> build summary file from message file."
1380	PRINT "D   ==> display an ascii file"
1400	PRINT "E   ==> end the utility program."
1420	PRINT "F   ==> prints the disk directory."
1440	PRINT "P   ==> purge the message files"
1460	PRINT "T   ==> transfers a disk file to the message file."
1480	RETURN
1490 '
1500 ' END OF PROGRAM
1510 '
1520	PRINT:

	PRINT:

	END
1530 '
1540 ' DISPLAY A FILE
1550 '
1560	B$ = MID$(PROMPT$,2):

	PRINT:

	IF B$ = "" THEN

		INPUT "Filename? ",B$:

		PRINT
1570	GOSUB 2720:

	FILN$ = B$
1580	OPEN "I",1,FILN$
1600	IF EOF(1) THEN

		1660
1620	IF INKEY$ <> "" THEN

		CLOSE:

		PRINT:

		PRINT "++ Aborted ++":

		PRINT:

		RETURN
1640	LINE INPUT #1,LIN$:

	PRINT LIN$:

	GOTO 1600
1660	CLOSE:

	PRINT:

	PRINT:

	PRINT "++ END OF FILE ++":

	PRINT
1680	RETURN
1690 '
1700 ' DISPLAY DIRECTORY
1710 '
1720	IF LEN(PROMPT$) > 1 THEN

		SPEC$ = MID$(PROMPT$,2)

	ELSE

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

	PRINT:

	RETURN
1750 '
1760 ' TRANSFER A DISK FILE
1770 '
1780	PRINT "Active # of msg's ";:

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

	FIELD#1,5 AS RR$:

	GET#1,MSGS:

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

	GET#1,CALLS:

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

	GET#1,MNUM:

	U = VAL(RR$):

	PRINT STR$(U + 1):

	CLOSE
1860 '
1880 ' ***ENTER A NEW MESSAGE***
1900 '
1920	IF NOT PURGED THEN

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

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

	PRINT "Msg # will be ";:

	FIELD#1,5 AS RR$:

	GET#1,MNUM:

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

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

	GOSUB 2720:

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

	GOSUB 2720:

	IF B$ = "" THEN

		D$ = DT$

	ELSE

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

	GOSUB 2720:

	IF B$ = "" THEN

		T$ = "ALL"

	ELSE

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

	GOSUB 2720:

	K$ = B$:

	INPUT "Password?",B$:

	GOSUB 2720:

	PW$ = B$
2060	F = 0			' F IS MESSAGE LENGTH
2080	PRINT "Updating counters":

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

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

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

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

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

	PUT#1,MSGS:

	CLOSE#1
2140	PRINT "Updating msg file":

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

	RL = 65
2160	FIELD#1,65 AS RR$
2180	RE = MX + 7:

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

	IF EOF(2) THEN

		PRINT "File empty.":

		CLOSE#1:

		CLOSE#2:

		END
2220	IF EOF(2) THEN

		S$ = "9999":

		GOSUB 2740:

		PUT #1,RE:

		CLOSE #2:

		GOTO 2300
2240	LINE INPUT #2,S$
2260	IF LEN(S$) > 63 THEN

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

	GOSUB 2740:

	PUT #1,RE:

	RE = RE + 1:

	F = F + 1:

	GOTO 2220
2300	RE = MX + 1
2320	S$ = STR$(V + 1):

	GOSUB 2740:

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

	S$ = D$:

	GOSUB 2740:

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

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

	GOSUB 2740:

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

	S$ = T$:

	GOSUB 2740:

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

	S$ = K$:

	GOSUB 2740:

	PUT#1,RE:

	RE = RE + 1:

	S$ = STR$(F):

	GOSUB 2740:

	PUT#1,RE
2420	CLOSE #1
2440	IF PW$ <> "" THEN

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

	RE = 1:

	FIELD#1,30 AS RR$:

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

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

	GOSUB 2740:

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

	S$ = D$:

	GOSUB 2740:

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

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

	GOSUB 2740:

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

	S$ = T$:

	GOSUB 2740:

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

	S$ = K$:

	GOSUB 2740:

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

	S$ = STR$(F):

	GOSUB 2740:

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

	S$ = " 9999":

	GOSUB 2740:

	PUT#1,RE
2640	CLOSE#1
2660	MX = MX + F + 6:

	MZ = MZ + 1:

	M(MZ,1) = V + 1:

	M(MZ,2) = F
2680	U = U + 1
2700	RETURN
2705 '
2710 ' Convert the string B$ to upper case
2715 '
2720	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
2740 '
2760 ' FILL AND STORE DISK RECORD
2780 '
2800	LSET RR$ = LEFT$(S$ + SPACE$(RL - 2),RL - 2) + CHR$(13) + CHR$(10)
2820	RETURN
2840 '
2860 ' PURGE KILLED MESSAGES FROM FILES
2880 '
2900	IF PURGED THEN

		PRINT "Files already purged.":

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

		PRINT "Must be less then 8 characters.":

		GOTO 2920
2960	IF DATE$ = "" THEN

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

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

		CLOSE:

		RETURN
3020	CLOSE
3040	MSGN = 1:

	INPUT "Renumber messages?",PK$:

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

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

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

	IF MSG$ = "" THEN

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

	IF MSGN = 0 THEN

		PRINT "Invalid msg #.":

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

	OPEN "R",1,"SUMMARY",30
3160	FIELD#1,30 AS R1$
3180	R1 = 1
3200	OPEN "R",2,"$SUMMARY.$$$",30
3220	FIELD#2,30 AS R2$
3240	R2 = 1
3260	PRINT SEP$:

	GET#1,R1:

	IF EOF(1) THEN

		3520
3280	IF VAL(R1$) = 0 THEN

		R1 = R1 + 6:

		PRINT "Deletion":

		GOTO 3260
3300	IF PK$ = "Y" AND VAL(R1$) < 9999 THEN

		IF INSTR(R1$,";") THEN

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

		ELSE

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

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

		MSGN = MSGN + 1:

		GOTO 3360
3340	LSET R2$ = R1$
3360	PUT #2,R2
3380	PRINT LEFT$(R2$,28)
3400	IF VAL(R1$) > 9998 THEN

		3520
3420	FOR I = 1 TO 5
3440		R1 = R1 + 1:

		R2 = R2 + 1:

		GET#1,R1:

		LSET R2$ = R1$:

		PUT#2,R2
3460		PRINT LEFT$(R2$,28)
3480	NEXT I
3500	R1 = R1 + 1:

	R2 = R2 + 1:

	GOTO 3260
3520	CLOSE:

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

	CLOSE:

	KILL "SUMMARY.BAK":

	NAME "SUMMARY" AS "SUMMARY.BAK":

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

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

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

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

	R1 = 1:

	KIL = 0
3620	R1 = 1:

	R2 = 1
3640	PRINT SEP$:

	GET #1,R1:

	IF EOF(1) THEN

		 4020
3660	IF VAL(R1$) = 0 THEN

		KIL = -1:

		PRINT "Archiving message":

		GOTO 3780
3680	KIL = 0
3700	IF PK$ = "Y" AND VAL(R1$) < 9999 THEN

		IF INSTR(R1$,";") THEN

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

		ELSE

			PASS$ = SPACE$(62)
3720	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 3760
3740	LSET R2$ = R1$:

	PRINT LEFT$(R2$,6)
3760	PUT #2,R2
3780	IF KIL THEN

		GOSUB 4740:

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

		4020
3820	FOR I = 1 TO 5
3840		R1 = R1 + 1:

		IF NOT KIL THEN

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

		IF KIL THEN

			GOSUB 4740:

			PRINT #3,KL$:

			GOTO 3900
3880		LSET R2$ = R1$:

		PUT #2,R2:

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

		R1 = R1 + 1:

		IF NOT KIL THEN

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

		IF KIL THEN

			GOSUB 4740:

			PRINT #3,KL$:

			GOTO 3980
3960		LSET R2$ = R1$:

		PUT #2,R2:

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

	R1 = R1 + 1:

	IF NOT KIL THEN

		R2 = R2 + 1
4000	GOTO 3640
4010 '
4020	CLOSE:

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

	CLOSE:

	KILL "MESSAGES.BAK":

	NAME "MESSAGES" AS "MESSAGES.BAK":

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

	CLOSE:

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

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

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

	LSET R2$ = C1$ + C2$:

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

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

		PUT #1,1
4160	CLOSE
4180	PURGED = -1:

	GOSUB 4580:

	RETURN
4190 '
4200 ' BUILD SUMMARY FILE FROM MESSAGE FILE
4210 '
4220	PRINT "Building summary file..."
4240	OPEN "O",1,"SUMMARY.BAK":

	CLOSE:

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

	FIELD #1,65 AS R1$:

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

	FIELD #2,30 AS R2$:

	R2 = 1
4300	PRINT SEP$
4320	FOR I = 1 TO 6
4340		GET #1,R1:

		IF EOF(1) THEN

			4440
4360		LSET R2$ = LEFT$(R1$,28) + CRLF$:

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

		R2 = R2 + 1:

		PRINT LEFT$(R2$,28):

		IF EOF(1) THEN

			4440
4400		IF I = 1 THEN

			IF VAL(R1$) > 9998 THEN

				4440
4420	NEXT I:

	R1 = R1 + VAL(R1$):

	GOTO 4300
4440	CLOSE:

	NAME "SUMMARY" AS "SUMMARY.BAK":

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

	RETURN
4470 '
4475 ' Error handlers
4478 '
4480	PRINT "Error number: ";ERR;" occurred at line number:";ERL
4500	IF ERL = 1740 AND ERR = 53 THEN

		PRINT "File not found.":

		RETURN
4520	IF ERL = 1580 AND ERR = 53 THEN

		PRINT "File not found.":

		CLOSE:

		RESUME 1680
4540	PRINT "Error number ";ERR;" in line number ";ERL
4560	RESUME 1240
4570 '
4580 ' build message index
4590 '
4600	MX = 0:

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

	RE = 1:

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

	IF EOF(1) THEN

		4720
4660	G = VAL(RR$):

	MZ = MZ + 1:

	M(MZ,1) = G:

	IF G = 0 THEN

		4700
4680	IF G > 9998 THEN

		MZ = MZ - 1:

		GOTO 4720
4700	GET#1,RE + 5:

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

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

	RE = RE + 6:

	GOTO 4640
4720	CLOSE:

	RETURN
4730 '
4740 ' unpack record
4750 '
4760	ZZ = LEN(R1$) - 2
4780	WHILE MID$(R1$,ZZ,1) = " "
4800	ZZ = ZZ - 1:

	IF ZZ = 1 THEN

		4840
4820	WEND
4840	KL$ = LEFT$(R1$,ZZ)
4860	RETURN
5000 '
5020 ' Test to only allow the SYSOP to use UTIL remotely
5040 '
5060	OPEN "I",1,"A:LASTCALR":

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

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

	INPUT #1,P1$,P2$:

	CLOSE #1
5180	PRINT
5200	IF N$ = MAGIC$ AND O$ = "" THEN

		PRINT "What is the second codeword ? ";:

		B$ = INPUT$(8):

		PRINT:

		GOSUB 2720:

		IF INSTR(B$,P2$) THEN

			RETURN
5220	PRINT
5360	OPEN "R",1,"A:CALLERS",60:

	FIELD #1, 60 AS RR$:

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

	RL = 60
5400	GET #1,RE:

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

		GOTO 6000
5420	S$ = S$ + " UTIL":

	GOSUB 2740:

	PUT #1,RE:

	CLOSE #1
5440	PRINT "You know you're not the SYSOP, what are you doing here??"
5460	PRINT
5480	PRINT "Go away, your name has been logged for further action!"
5500	PRINT
5520	END
5540 '
6000	F$ = "TW"		'User has achieved temporary twit status
6020	OPEN "O",2,"A:LASTCALR. " + CHR$(&HA0):

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

	CLOSE
6030	PRINT "You were warned to stay out of the SYSOP's domain"
6040	PRINT
6050	PRINT "You are being logged off this system IMMEDIATELY"
6060	PRINT
6070	CHAIN "BYE"
6080	END
