100 DEFINT A-Z
120 REM
140 VERS$="vers 3.1"
160 REM RBBSUTIL.BAS ==> UTILITY PROGRAM FOR THE RBBS REMOTE BULLETIN BOARD SYS
180 REM BY RON FOWLER
200 REM Please report any problems, bugs, fixes, etc. to:
210 REM Ron Fowler, via "Fort Fone File Folder" (414) 563-7442
215 REM changed to ver 3.2 to correspond with RBBS and changed:
216 REM 1. Length check on date for <T>ransferred message
217 REM 2. Password syntax check (no "*" in msg to "ALL")
218 REM 3. Program will no longer abort if empty <T>ransfer file
219 REM 4. Program will inform user if line in <T>ransfer was truncated
220 REM 5. When run under MBASIC, no more error will be reported
221 REM    when <CR> is typed at the Command prompt.
222 REM 6. Message TO: will no longer offer "RETURN for "ALL"', since
223 REM    this is legal only in MBASIC and will produce an error
224 REM    message when run in compiled form.
226 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 490
480 B$=MID$(PROMPT$,1,1):GOSUB 1920:SM$=B$:

    SM=INSTR ("TFDPEB",SM$)
490 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:IF LEN(B$)<>8 THEN 1200

     ELSE D$=B$
1220 INPUT "Who to ?";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$:IF PW$="" THEN 1260
1250 IF T$="ALL" AND LEFT$(PW$,1)="*" THEN

     PRINT CHR$(7);"Personal password for ALL is NOT allowed!":GOTO 1240
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:RETURN
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):TRUNC=-1 ELSE TRUNC=0
1470 PRINT S$;:IF TRUNC THEN PRINT CHR$(7);"<== TRUNCATED!" ELSE PRINT
1480 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 ?",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
 ZZ=LEN(R1$)-2
3900 WHILE MID$(R1$,ZZ,1)=" "
39