10 DEFINT A-Z
20 DEF FNCT$(C$,SW)=STRING$(INT((SW-LEN(C$))/2)," ")+C$
30 SW=80
40 ON ERROR GOTO 2110
50 DIM M(200,2)
60 SEP$="=============================================="
70 CRLF$=CHR$(13)+CHR$(10)
80 PURGED=0:BACKUP=0
90 GOSUB 2210                                                           ' build message index
100 N$="SYSOP":O$=""
110 ' 
120 PRINT:PRINT
130 VERS$="RBBS v 3.8 UTILITY PROGRAM (07/17/85)"
135 ' Lillypond Softwares   Dennis Recla
140 PRINT FNCT$(VERS$,80)
150 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
160 ' 
170 PRINT:PRINT:INPUT "Command:  B,D,E,F,K,P,R,T,L ( or ?) ",PROMPT$
180 PRINT:PRINT:IF PROMPT$="" THEN GOSUB 230:GOTO 170
190 B$=MID$(PROMPT$,1,1):GOSUB 1110:SM$=B$:SM=INSTR("TFDPEBKRL",SM$):GOSUB 200:GOTO 170
200 IF SM=0 THEN 230
210 ON SM GOTO 590,540,420,1200,380,1950,2410,2490,2600
220 ' 
230 PRINT:PRINT "Commands: "
240 PRINT
250 PRINT "  <B>uild SUMMARY file from MESSAGE file"
260 PRINT "  <D>isplay an ASCII file on your screen"
270 PRINT "  <E>nd the utility program"
280 PRINT "  <F>iles (list the disk directory)"
290 PRINT "  <K>ill (erase) a file"
300 PRINT "  <P>urge the message files"
310 PRINT "  <R>ename a file"
320 PRINT "  <T>ransfer a disk file to the message file"
330 PRINT "  <L>ist an ASCII file on your printer"
340 RETURN
350 ' 
360 ' End of program
370 ' 
380 PRINT:PRINT:SYSTEM:END
390 ' 
400 ' Display an ASCII file
410 ' 
420 B$=MID$(PROMPT$,2):IF B$="" THEN INPUT "Filename? ",B$:PRINT
430 IF B$="" THEN RETURN ELSE GOSUB 1110:FILN$=B$
440 OPEN "I",1,FILN$
450 IF EOF(1) THEN 490
460 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
470 IF BI=11 THEN PRINT:PRINT "++ Aborted ++":PRINT:CLOSE:RETURN
480 LINE INPUT #1,LIN$:PRINT LIN$:GOTO 450
490 CLOSE:PRINT:PRINT:PRINT "++ End Of File ++":PRINT
500 RETURN
510 ' 
520 ' Display directory
530 ' 
540 B$=PROMPT$:GOSUB 1110:IF LEN(B$)>1 THEN SPEC$=MID$(B$,3) ELSE SPEC$="*.*"
550 FILES SPEC$:PRINT:RETURN
560 ' 
570 ' Transfer a disk file
580 ' 
590 PRINT "Active # of msgs   ";:OPEN "R",1,"COUNTERS",5:FIELD #1,5 AS RR$:GET #1,MSGS:M=VAL(RR$)
600 PRINT STR$(M)
610 PRINT "Last caller was #  ";:GET #1,CALLS:PRINT STR$(VAL(RR$))
620 PRINT "This msg # will be ";:GET #1,MNUM:U=VAL(RR$):PRINT STR$(U+1):CLOSE
630 ' 
640 ' Enter a new message
650 ' 
660 IF NOT PURGED THEN PRINT "Files must be purged before messages can be added":RETURN
670 OPEN "R",1,"COUNTERS",5:PRINT "Msg # will be ";:FIELD #1,5 AS RR$:GET #1,MNUM:V=VAL(RR$)
680 PRINT STR$(V+1):CLOSE
690 INPUT "Message file name? ",B$:GOSUB 1110:FIL$=B$
700 INPUT "Todays date? (MM/DD/YY) ",B$:GOSUB 1110:IF B$="" THEN D$=DT$ ELSE D$=B$
710 INPUT "Who to? (C/R for ALL) ";B$:GOSUB 1110:IF B$="" THEN T$="ALL" ELSE T$=B$
720 INPUT "Subject: ",B$:GOSUB 1110:K$=B$
730 PW$="":IF T$="ALL" THEN 750
740 INPUT "Private? (Y/N) ",B$:GOSUB 1110:IF B$="Y" THEN PW$="*" ELSE PW$=""
750 F=0                                                                 ' F is message length
760 PRINT:PRINT "Updating counters":OPEN "R",1,"COUNTERS",5:FIELD #1,5 AS RR$
770 GET #1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT #1,MNUM
780 GET #1,MSGS:LSET RR$=STR$(VAL(RR$) + 1):PUT #1,MSGS:CLOSE #1
790 PRINT:PRINT "Updating msg file":OPEN "R",1,"MESSAGES",65:RL=65
800 FIELD #1,65 AS RR$
810 RE=MX+7:F=0
820 OPEN "I",2,FIL$:IF EOF(2) THEN PRINT "File empty.":CLOSE #1:CLOSE #2:END
830 IF EOF(2) THEN S$="9999":GOSUB 1150:PUT #1,RE:CLOSE #2:GOTO 870
840 LINE INPUT #2,S$
850 IF LEN(S$)>63 THEN S$=LEFT$(S$,63)
860 PRINT S$:GOSUB 1150:PUT #1,RE:RE=RE+1:F=F+1:GOTO 830
870 RE=MX+1
880 S$=STR$(V+1):GOSUB 1150:PUT #1,RE
890 RE=RE+1:S$=D$:GOSUB 1150:PUT #1,RE
900 RE=RE+1:S$=N$+" "+O$:GOSUB 1150:PUT #1,RE
910 RE=RE+1:S$=T$:GOSUB 1150:PUT #1,RE
920 RE=RE+1:S$=K$:GOSUB 1150:PUT #1,RE:RE=RE+1:S$=STR$(F):GOSUB 1150:PUT #1,RE
930 CLOSE #1
940 IF PW$<>"" THEN PW$=";"+PW$
950 PRINT:PRINT "Updating summary file."
960 OPEN "R",1,"SUMMARY",30:RE=1:FIELD #1,30 AS RR$:RL=30
970 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 1150:PUT #1,RE
980 RE=RE+1:S$=D$:GOSUB 1150:PUT #1,RE
990 RE=RE+1:S$=N$+" "+O$:GOSUB 1150:PUT #1,RE
1000 RE=RE+1:S$=T$:GOSUB 1150:PUT #1,RE
1010 RE=RE+1:S$=K$:GOSUB 1150:PUT #1,RE
1020 RE=RE+1:S$=STR$(F):GOSUB 1150:PUT #1,RE
1030 RE=RE+1:S$=" 9999":GOSUB 1150:PUT #1,RE
1040 CLOSE #1
1050 MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F
1060 U=U+1
1070 RETURN
1080 ' 
1090 ' Convert the string B$ to upper case
1100 ' 
1110 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
1120 ' 
1130 ' Fill and store disk record
1140 ' 
1150 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
1160 RETURN
1170 ' 
1180 ' Purge killed MESSAGES from files
1190 ' 
1200 IF PURGED THEN PRINT "Files already purged.":RETURN
1210 INPUT "Create Archive File? (Y/N) ";CRF$
1220 IF CRF$="y" THEN CRF$="Y"
1230 IF CRF$<>"Y" THEN 1320
1240 PRINT
1250 INPUT "Todays date? (MM/DD/YY) ",DATE$
1260 IF LEN(DATE$)<>8 THEN PRINT "Must be 8 characters.":GOTO 1250
1270 IF DATE$="" THEN DATE$=DT$
1280 PRINT
1290 OPEN "R",1,DATE$+".ARC"
1300 IF LOF(1)>0 THEN PRINT "Archive file: ";DATE$+".ARC";" exists.":CLOSE:RETURN
1310 CLOSE
1320 MSGN=1:INPUT "Renumber messages? (Y/N) ",PK$:PK$=MID$(PK$,1,1)
1330 IF PK$="y" THEN PK$="Y"
1340 IF PK$<>"Y" THEN 1380
1350 PRINT
1360 INPUT "Message number to start (RETURN for 1)?",MSG$:IF MSG$="" THEN MSG$="1"
1370 MSGN=VAL(MSG$):IF MSGN=0 THEN PRINT "Invalid msg #.":RETURN
1380 PRINT:PRINT "Purging summary file...":OPEN "R",1,"SUMMARY",30
1390 FIELD #1,30 AS R1$
1400 R1=1
1410 OPEN "R",2,"$SUMMARY.$$$",30
1420 FIELD #2,30 AS R2$
1430 R2=1
1440 PRINT SEP$:GET #1,R1:IF EOF(1) THEN 1570
1450 IF VAL(R1$)=0 THEN R1=R1+6:PRINT "Deletion":GOTO 1440
1460 IF PK$="Y" AND VAL(R1$)<9999 THEN IF INSTR(R1$,";") THEN PASS$=MID$(R1$,INSTR(R1$,";"),27) ELSE PASS$=SPACE$(28)
1470 IF PK$="Y" AND VAL(R1$)<9999 THEN LSET R2$=LEFT$(STR$(MSGN)+PASS$,28)+CHR$(13)+CHR$(10):MSGN=MSGN+1:GOTO 1490
1480 LSET R2$=R1$
1490 PUT #2,R2
1500 PRINT LEFT$(R2$,28)
1510 IF VAL(R1$)>9998 THEN 1570
1520 FOR I=1 TO 5
1530 R1=R1+1:R2=R2+1:GET #1,R1:LSET R2$=R1$:PUT #2,R2
1540 PRINT LEFT$(R2$,28)
1550 NEXT I
1560 R1=R1+1:R2=R2+1:GOTO 1440
1570 CLOSE:OPEN "O",1,"SUMMARY.BAK":CLOSE:KILL "SUMMARY.BAK":NAME "SUMMARY" AS "SUMMARY.BAK":NAME "$SUMMARY.$$$" AS "SUMMARY"
1580 PRINT:PRINT "Purging message file...":MSGN=VAL(MSG$)
1590 OPEN "R",1,"MESSAGES",65:FIELD #1,65 AS R1$
1600 OPEN "R",2,"$MESSAGS.$$$",65:FIELD #2,65 AS R2$
1610 R1=1:KIL=0:IF CRF$="Y" THEN OPEN "O",3,DATE$+".ARC"
1620 R1=1:R2=1
1630 PRINT SEP$:GET #1,R1:IF EOF(1) THEN 1830
1640 IF VAL(R1$)=0 THEN KIL=-1:PRINT "Archiving msg.":GOTO 1700
1650 KIL=0
1660 IF PK$="Y" AND VAL(R1$)<9999 THEN IF INSTR(R1$,";") THEN PASS$=MID$(R1$,INSTR(R1$,";"),62) ELSE PASS$=SPACE$(62)
1670 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 1690
1680 LSET R2$=R1$:PRINT LEFT$(R2$,6)
1690 PUT #2,R2
1700 IF KIL THEN GOSUB 2310:IF CRF$="Y" THEN GOSUB 2560
1710 IF VAL(R1$)>9998 THEN 1830
1720 FOR I=1 TO 5
1730 R1=R1+1:IF NOT KIL THEN R2=R2+1
1740 GET #1,R1:IF KIL THEN GOSUB 2310:IF CRF$="Y" THEN GOSUB 2560 ELSE 1760:GOTO 1760
1750 LSET R2$=R1$:PUT #2,R2:PRINT LEFT$(R2$,63)
1760 NEXT I
1770 FOR I=1 TO VAL(R1$):R1=R1+1:IF NOT KIL THEN R2=R2+1
1780 GET #1,R1:IF KIL THEN GOSUB 2310:IF CRF$="Y" THEN GOSUB 2560 ELSE 1800:GOTO 1800
1790 LSET R2$=R1$:PUT #2,R2:PRINT LEFT$(R2$,63)
1800 NEXT I:R1=R1+1:IF NOT KIL THEN R2=R2+1
1810 GOTO 1630
1820 ' 
1830 CLOSE:OPEN "O",1,"MESSAGES.BAK":CLOSE:KILL "MESSAGES.BAK":NAME "MESSAGES" AS "MESSAGES.BAK":NAME "$MESSAGS.$$$" AS "MESSAGES"
1840 PRINT:PRINT "Updating counters..."
1850 OPEN "O",1,"COUNTERS.BAK":CLOSE:KILL "COUNTERS.BAK"
1860 OPEN "R",1,"COUNTERS",15:FIELD #1,10 AS C1$,5 AS C2$
1870 OPEN "R",2,"COUNTERS.BAK",15:FIELD #2,15 AS R2$
1880 GET #1,1:LSET R2$=C1$+C2$:PUT #2,1
1890 IF PK$="Y" THEN LSET C2$=STR$(MSGN-1):PUT #1,1
1900 CLOSE
1910 PURGED=-1:GOSUB 2210:RETURN
1920 ' 
1930 ' Build SUMMARY file from MESSAGE file
1940 ' 
1950 PRINT "Building summary file..."
1960 OPEN "O",1,"SUMMARY.BAK":CLOSE:KILL "SUMMARY.BAK"
1970 OPEN "R",1,"MESSAGES",65:FIELD #1,65 AS R1$:R1=1
1980 OPEN "R",2,"SUMMARY.$$$",30:FIELD #2,30 AS R2$:R2=1
1990 PRINT SEP$
2000 FOR I=1 TO 6
2010 GET #1,R1:IF EOF(1) THEN 2060
2020 LSET R2$=LEFT$(R1$,28)+CRLF$:PUT #2,R2
2030 R1=R1+1:R2=R2+1:PRINT LEFT$(R2$,28):IF EOF(1) THEN 2060
2040 IF I=1 THEN IF VAL(R1$)>9998 THEN 2060
2050 NEXT I:R1=R1+VAL(R1$):GOTO 1990
2060 CLOSE:NAME "SUMMARY" AS "SUMMARY.BAK":NAME "SUMMARY.$$$" AS "SUMMARY"
2070 PRINT:PRINT "Summary file built.":RETURN
2080 ' 
2090 ' Error handlers
2100 ' 
2110 IF (ERL=550) AND (ERR=53) THEN PRINT "File not found.":RESUME 170
2120 IF (ERL=440) AND (ERR=53) THEN PRINT "File not found.":CLOSE:RESUME 500
2130 IF (ERL=2620) AND (ERR=53) THEN PRINT "File not found.":CLOSE:RESUME 2680
2140 IF (ERL=2530) AND (ERR=53) THEN PRINT "File does not exist.":RESUME 170
2150 IF (ERL=2430) AND (ERR=53) THEN PRINT "File does not exist.":RESUME 170
2160 PRINT "Error number ";ERR;" in line number ";ERL
2170 RESUME 170
2180 ' 
2190 ' Build message index
2200 ' 
2210 MX=0:MZ=0
2220 OPEN "R",1,"SUMMARY",30:RE=1:FIELD #1,28 AS RR$
2230 GET #1,RE:IF EOF(1) THEN 2270
2240 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 2260
2250 IF G>9998 THEN MZ=MZ-1:GOTO 2270
2260 GET #1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 2230
2270 CLOSE:RETURN
2280 ' 
2290 ' Unpack record
2300 ' 
2310 IF CRF$="Y" THEN 2320 ELSE RETURN
2320 ZZ=LEN(R1$)-2
2330 WHILE MID$(R1$,ZZ,1)=" "
2340 ZZ=ZZ-1:IF ZZ=1 THEN 2360
2350 WEND
2360 KL$=LEFT$(R1$,ZZ)
2370 RETURN
2380 ' 
2390 ' Kill (erase) a file
2400 ' 
2410 B$=MID$(PROMPT$,3):IF B$ = "" THEN INPUT "Filename? ",B$:PRINT
2420 IF B$="" THEN RETURN ELSE GOSUB 1110:FILN$ = B$
2430 KILL FILN$
2440 PRINT
2450 RETURN
2460 ' 
2470 ' Rename a file
2480 ' 
2490 INPUT "Existing Filename? ",B$:PRINT
2500 IF B$="" THEN RETURN ELSE GOSUB 1110:EFILN$ = B$
2510 PRINT:INPUT "New Filename? ",B$:PRINT
2520 IF B$="" THEN RETURN ELSE GOSUB 1110:NFILN$ = B$
2530 NAME EFILN$ AS NFILN$
2540 PRINT:RETURN
2550 ' 
2560 PRINT #3,KL$:RETURN                                                ' write message archive file
2570 ' 
2580 ' Print an ASCII file
2590 ' 
2600 B$=MID$(PROMPT$,2):IF B$="" THEN INPUT "Filename? ",B$:PRINT
2610 IF B$="" THEN RETURN ELSE GOSUB 1110:FILN$=B$
2620 OPEN "I",1,FILN$
2630 IF EOF(1) THEN 2670
2640 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
2650 IF BI=11 THEN PRINT:PRINT "++ Aborted ++":PRINT:CLOSE:RETURN
2660 LINE INPUT #1,LIN$:LPRINT LIN$:GOTO 2630
2670 CLOSE:PRINT:PRINT:PRINT "++ End Of File ++":PRINT
2680 RETURN