100 DEFINT A-Z
120 REM
140 VERS$="vers 2.2"
160 REM RBBSUTIL.BAS ==> UTILITY PROGRAM FOR THE RBBS REMOTE BULLETIN BOARD SYS
180 REM BY RON FOWLER, WESTLAND, MICH RBBS (313)-729-1905 (RINGBACK)
200 REM Please report any problems, bugs, fixes, etc. to the above RBBS.
220 REM
240 PRINT:PRINT "            RBBS  Utility ";VERS$
260 ON ERROR GOTO 3620
280 DIM M(200,2)
300 SEP$="==============================================="
320 CRLF$=CHR$(13)+CHR$(10)
340 PRINT SEP$
360 PURGED=0:BACKUP=0
380 GOSUB 3700'REM BUILD MSG INDEX
400 N$="SYSOP":O$=""
420 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
440 PRINT:INPUT "Command? ",PROMPT$
460 PRINT:PRINT:IF PROMPT$="" THEN 540
480 B$=MID$(PROMPT$,1,1):GOSUB 1920:SM$=B$:

    SM=INSTR ("TFDPEB",SM$):GOSUB 500::GOTO 440
500 IF SM=0 THEN 540
520 ON SM GOTO 980,920,760,2040,700,3320
540 PRINT:PRINT "Commands allowed are:"
560 PRINT "B   ==> build summary file from message file."
580 PRINT "D   ==> display an ascii file"
600 PRINT "E   ==> end the utility program."
620 PRINT "F   ==> prints the disk directory."
640 PRINT "P   ==> purge the message files"
660 PRINT "T   ==> transfers a disk file to the message file."
680 RETURN
700 REM END OF PROGRAM
720 PRINT:PRINT:END
740 REM DISPLAY A FILE
760 FILN$=MID$(PROMPT$,2):

    PRINT:IF FILN$="" THEN INPUT "Filename? ",FILN$:PRINT
780 OPEN "I",1,FILN$
800 IF EOF(1) THEN 860
820 IF INKEY$<>"" THEN CLOSE:PRINT:PRINT "++ Aborted ++":PRINT:RETURN
840 LINE INPUT #1,LIN$:PRINT LIN$:GOTO 800
860 CLOSE:PRINT:PRINT:PRINT "++ END OF FILE ++":PRINT
880 RETURN
900 REM DISPLAY DIRECTORY
920 IF LEN(PROMPT$)>1 THEN SPEC$=MID$(PROMPT$,2) ELSE SPEC$="*.*"
940 FILES SPEC$:PRINT:RETURN
960 REM TRANSFER A DISK FILE
980 PRINT "Active # of msg's ";:

    OPEN "R",1,"COUNTERS",5:FIELD#1,5 AS RR$:GET#1,MSGS:M=VAL(RR$)
1000 PRINT STR$(M)+"."
1020 PRINT "Last caller was # ";:GET#1,CALLS:PRINT STR$(VAL(RR$))
1040 PRINT "This msg # will be ";:GET#1,MNUM:U=VAL(RR$):PRINT STR$(U+1):CLOSE
1060 REM
1080 REM ***ENTER A NEW MESSAGE***
1100 REM
1120 IF NOT PURGED THEN PRINT 

     "Files must be purged before messages can be added":RETURN
1140 OPEN "R",1,"COUNTERS",5:PRINT "Msg # will be ";:

     FIELD#1,5 AS RR$:GET#1,MNUM:V=VAL(RR$)
1160 PRINT STR$(V+1):CLOSE
1180 INPUT "Message file name? ",B$:GOSUB 1920:FIL$=B$
1200 INPUT "Todays date (MM/DD/YY)?",B$:GOSUB 1920:D$=B$
1220 INPUT "Who to (C/R for ALL)?";B$:GOSUB 1920:

     IF B$="" THEN T$="ALL" ELSE T$=B$
1240 INPUT "Subject?",B$:GOSUB 1920:K$=B$:

     INPUT "Password?",B$:GOSUB 1920:PW$=B$
1260 F=0'F IS MESSAGE LENGTH
1280 PRINT "Updating counters":

     OPEN "R",1,"COUNTERS",5:FIELD#1,5 AS RR$
1300 GET#1,MNUM:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MNUM
1320 GET#1,MSGS:LSET RR$=STR$(VAL(RR$)+1):PUT#1,MSGS:CLOSE#1
1340 PRINT "Updating msg file":OPEN "R",1,"MESSAGES",65:RL=65
1360 FIELD#1,65 AS RR$
1380 RE=MX+7:F=0
1400 OPEN "I",2,FIL$:IF EOF(2) THEN PRINT "File empty.":CLOSE#1:CLOSE#2:END
1420 IF EOF(2) THEN S$="9999":GOSUB 1940:PUT #1,RE:CLOSE #2:GOTO 1500
1440 LINE INPUT #2,S$
1460 IF LEN(S$)>63 THEN S$=LEFT$(S$,63)
1480 PRINT S$:GOSUB 1940:PUT #1,RE:RE=RE+1:F=F+1:GOTO 1420
1500 RE=MX+1
1520 S$=STR$(V+1):GOSUB 1940:PUT#1,RE
1540 RE=RE+1:S$=D$:GOSUB 1940:PUT#1,RE
1560 RE=RE+1:S$=N$+" "+O$:GOSUB 1940:PUT#1,RE
1580 RE=RE+1:S$=T$:GOSUB 1940:PUT#1,RE
1600 RE=RE+1:S$=K$:GOSUB 1940:PUT#1,RE:RE=RE+1:S$=STR$(F):GOSUB 1940:PUT#1,RE
1620 CLOSE #1
1640 IF PW$<>"" THEN PW$=";"+PW$
1660 PRINT "Updating summary file."
1680 OPEN "R",1,"SUMMARY",30:RE=1:FIELD#1,30 AS RR$:RL=30
1700 RE=MZ*6+1:S$=STR$(V+1)+PW$:GOSUB 1940:PUT#1,RE
1720 RE=RE+1:S$=D$:GOSUB 1940:PUT#1,RE
1740 RE=RE+1:S$=N$+" "+O$:GOSUB 1940:PUT#1,RE
1760 RE=RE+1:S$=T$:GOSUB 1940:PUT#1,RE
1780 RE=RE+1:S$=K$:GOSUB 1940:PUT#1,RE
1800 RE=RE+1:S$=STR$(F):GOSUB 1940:PUT#1,RE
1820 RE=RE+1:S$=" 9999":GOSUB 1940:PUT#1,RE
1840 CLOSE#1
1860 MX=MX+F+6:MZ=MZ+1:M(MZ,1)=V+1:M(MZ,2)=F
1880 U=U+1
1900 RETURN
1920 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
1940 REM
1960 REM FILL AND STORE DISK RECORD
1980 REM
2000 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
2020 RETURN
2040 REM
2060 REM PURGE KILLED MESSAGES FROM FILES
2080 REM
2100 IF PURGED THEN PRINT "Files already purged.":RETURN
2120 INPUT "Today's date (MM/DD/YY) ?",DATE$
2140 IF LEN(DATE$)>8 THEN PRINT "Must be less then 8 characters.":GOTO 2120
2160 OPEN "R",1,DATE$+".ARC"
2180 IF LOF(1)>0 THEN PRINT "Archive file: ";

      DATE$+".ARC";" exists.":CLOSE:RETURN
2200 CLOSE
2220 MSGN=1:INPUT "Renumber messages?",PK$:PK$=MID$(PK$,1,1)
2240 IF PK$="y" THEN PK$="Y"
2260 IF PK$<>"Y" THEN 2320
2280 INPUT "Message number to start (CR=1)?",MSG$:IF MSG$="" THEN MSG$="1"
2300 MSGN=VAL(MSG$):IF MSGN=0 THEN PRINT "Invalid msg #.":RETURN
2320 PRINT "Purging summary file...":OPEN "R",1,"SUMMARY",30
2340 FIELD#1,30 AS R1$
2360 R1=1
2380 OPEN "R",2,"$SUMMARY.$$$",30
2400 FIELD#2,30 AS R2$
2420 R2=1
2440 PRINT SEP$:GET#1,R1:IF EOF(1) THEN 2680
2460 IF VAL(R1$)=0 THEN R1=R1+6:PRINT "Deletion":GOTO 2440
2480 IF PK$="Y" AND VAL(R1$)<9999 THEN 

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

      MSGN=MSGN+1:GOTO 2520
2500 LSET R2$=R1$
2520 PUT #2,R2
2540 PRINT LEFT$(R2$,28)
2560 IF VAL(R1$)>9998 THEN 2680
2580 FOR I=1 TO 5
2600 R1=R1+1:R2=R2+1:GET#1,R1:LSET R2$=R1$:PUT#2,R2
2620 PRINT LEFT$(R2$,28)
2640 NEXT I
2660 R1=R1+1:R2=R2+1:GOTO 2440
2680 CLOSE:OPEN "O",1,"SUMMARY.BAK":CLOSE:KILL "SUMMARY.BAK":

      NAME "SUMMARY" AS "SUMMARY.BAK":NAME "$SUMMARY.$$$" AS "SUMMARY"
2700 PRINT "Purging message file...":MSGN=VAL(MSG$)
2720 OPEN "R",1,"MESSAGES",65:FIELD #1,65 AS R1$
2740 OPEN "R",2,"$MESSAGS.$$$",65:FIELD #2,65 AS R2$
2760 OPEN "O",3,DATE$+".ARC":R1=1:KIL=0
2780 R1=1:R2=1
2800 PRINT SEP$:GET #1,R1:IF EOF(1) THEN 3140
2820 IF VAL(R1$)=0 THEN KIL=-1:PRINT "Archiving message":GOTO 2900
2840 KIL=0:IF PK$="Y" AND VAL(R1$)<9999 THEN

      LSET R2$=LEFT$(STR$(MSGN)+SPACE$(63),63)+CHR$(13)+CHR$(10):

      MSGN=MSGN+1:PRINT LEFT$(R2$,63):GOTO 2880
2860 LSET R2$=R1$:PRINT LEFT$(R2$,6)
2880 PUT #2,R2
2900 IF KIL THEN GOSUB 3860:PRINT #3,KL$
2920 IF VAL(R1$)>9998 THEN 3140
2940 FOR I=1 TO 5
2960 R1=R1+1:IF NOT KIL THEN R2=R2+1
2980 GET #1,R1:IF KIL THEN GOSUB 3860:PRINT #3,KL$:GOTO 3020
3000 LSET R2$=R1$:PUT #2,R2:PRINT LEFT$(R2$,63)
3020 NEXT I
3040 FOR I=1 TO VAL(R1$):R1=R1+1:IF NOT KIL THEN R2=R2+1
3060 GET #1,R1:IF KIL THEN GOSUB 3860:PRINT #3,KL$:GOTO 3100
3080 LSET R2$=R1$:PUT #2,R2:PRINT LEFT$(R2$,63)
3100 NEXT I:R1=R1+1:IF NOT KIL THEN R2=R2+1
3120 GOTO 2800
3140 CLOSE:OPEN "O",1,"MESSAGES.BAK":CLOSE:KILL "MESSAGES.BAK":

      NAME "MESSAGES" AS "MESSAGES.BAK":NAME "$MESSAGS.$$$" AS "MESSAGES"
3160 PRINT "Updating counters..."
3180 OPEN "O",1,"COUNTERS.BAK":CLOSE:KILL "COUNTERS.BAK"
3200 OPEN "R",1,"COUNTERS",15:FIELD #1,10 AS C1$,5 AS C2$
3220 OPEN "R",2,"COUNTERS.BAK",15:FIELD #2,15 AS R2$
3240 GET #1,1:LSET R2$=C1$+C2$:PUT #2,1
3260 IF PK$="Y" THEN LSET C2$=STR$(MSGN-1):PUT #1,1
3280 CLOSE
3300 PURGED=-1:GOSUB 3700:RETURN
3320 REM BUILD SUMMARY FILE FROM MESSAGE FILE
3340 PRINT "Building summary file..."
3360 OPEN "O",1,"SUMMARY.BAK":CLOSE:KILL "SUMMARY.BAK"
3380 OPEN "R",1,"MESSAGES",65:FIELD #1,65 AS R1$:R1=1
3400 OPEN "R",2,"SUMMARY.$$$",30:FIELD #2,30 AS R2$:R2=1
3420 PRINT SEP$
3440 FOR I=1 TO 6
3460 GET #1,R1:IF EOF(1) THEN 3560
3480 LSET R2$=LEFT$(R1$,28)+CRLF$:PUT #2,R2
3500 R1=R1+1:R2=R2+1:PRINT LEFT$(R2$,28):IF EOF(1) THEN 3560
3520 IF I=1 THEN IF VAL(R1$)>9998 THEN 3560
3540 NEXT I:R1=R1+VAL(R1$):GOTO 3420
3560 CLOSE:NAME "SUMMARY" AS "SUMMARY.BAK":NAME "SUMMARY.$$$" AS "SUMMARY"
3580 PRINT "Summary file built.":RETURN
3600 PRINT "Error number: ";ERR;" occurred at line number:";ERL
3620 IF ERL=940 AND ERR=53 THEN PRINT "File not found.":RETURN
3640 IF ERL=780 AND ERR=53 THEN PRINT "File not found.":CLOSE:RESUME 880
3660 PRINT "Error number ";ERR;" in line number ";ERL
3680 RESUME 440
3700 REM build message index
3720 MX=0:MZ=0
3740 OPEN "R",1,"SUMMARY",30:RE=1:FIELD#1,28 AS RR$
3760 GET#1,RE:IF EOF(1) THEN 3840
3780 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 3820
3800 IF G>9998 THEN MZ=MZ-1:GOTO 3840
3820 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 3760
3840 CLOSE:RETURN
3860 REM unpack record
3880 ZZ=LEN(R1$)-2
3900 WHILE MID$(R1$,ZZ,1)=" "
3920 ZZ=ZZ-1:IF ZZ=1 THEN 3960
3940 WEND
3960 KL$=LEFT$(R1$,ZZ)
3980 RETURN