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 ransferred message 217 REM 2. Password syntax check (no "*" in msg to "ALL") 218 REM 3. Program will no longer abort if empty ransfer file 219 REM 4. Program will inform user if line in ransfer was truncated 220 REM 5. When run under MBASIC, no more error will be reported 221 REM when 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