100   ' RBSUTL35.BAS     A Utility program for use with RBBS35 
110   ' Revised from Version 2.7/3.1 of RBBSUTIL 
120   '
130   '              Dennis Recla 2/01/84
140   '
150   ' Removed the SYSOP recognition codes from 2.7 since this
160   ' version when used with RBBS35 is not required.
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   '  
230	DEFINT A-Z
240     VERS$ = "Vers 3.5"
250	ON ERROR GOTO 2190
260	DIM M(200,2)
270	SEP$ = "=============================================="
280	CRLF$ = CHR$(13) + CHR$(10)
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 ("TFDPEBKRA",SM$):

	GOSUB 380:

	GOTO 350
380	IF SM = 0 THEN

		400
390	ON SM GOTO 740,690,570,1310,510,2010,2440,2520
400	PRINT:

	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"
490	RETURN
500 '
510 ' END OF PROGRAM
520 '
530	PRINT:

	PRINT:

	END
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",5:

	FIELD#1,5 AS RR$:

	GET#1,MSGS:

	M = VAL(RR$)
750	PRINT STR"$(M) + " "
760	PRINT "Last caller 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",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",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",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",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
1342 INPUT "Create Archive File <Y or N> ?";CRF$
1344 IF CRF$<>"Y" THEN GOTO 1410
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$+".ARC"
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",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" AS "SUMMARY.BAK":

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

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

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

	FIELD #2,65 AS R2$
1690 R1=1:KIL=0:IF CRF$="Y" THEN OPEN "O",3,DATE$+".ARC"
1700	R1 = 1:

	R2 = 1
1710	PRINT SEP$:

	GET #1,R1:

	IF EOF(1) THEN

		 1910
1720 IF VAL(R1$)=0 THEN KIL=-1: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:IF CRF$="Y" THEN GOSUB 2800
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:IF CRF$="Y" THEN GOSUB 2800 ELSE

GOTO 1840: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:IF CRF$="Y" THEN GOSUB 2800 ELSE

GOTO 1880: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" AS "MESSAGES.BAK":

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

	CLOSE:

	KILL "COUNTERS.BAK"
1940	OPEN "R",1,"COUNTERS",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",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" AS "SUMMARY.BAK":

	NAME "SUMMARY.$$$" AS "SUMMARY"
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",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
2365 IF CNS$="Y" THEN 2380 ELSE RETURN
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
2800 PRINT #3,KL$:RETURN
EN

		RETURN

	ELSE

		GOSUB 1250:

		NFILN$ = B$
2590	NAME