10 REM >.ChckMes 20 REM by Steven Flintham 30 REM 40 REM Version 0.10 (based on SendMes 2.00) 50 REM 60 REM Wednesday 12th July 1995 70 : 80 MODE 7 90 PROCinit 100 : 110 REM Get the submission disc - this involves unpleasant code because of 120 REM the error trapping required 130 fs$=FNprompt_sub_disc 140 ON ERROR PROCbeep:fs$=" ":GOTO 150 150 IF fs$=" " AND FNfs=4 THEN fs$="D" 160 IF fs$=" " AND FNfs=8 THEN fs$="A" 170 IF fs$="A" THEN PROCinit_adfs 180 IF fs$="D" THEN PROCinit_dfs 190 ON ERROR PROCerror 200 : 210 IF FNexist("!Mesg") THEN PROCvalidate_and_read_mesg_file ELSE PROCcreate_mesg_file 220 : 230 PROCcheck_mesg_file 240 : 250 MODE 7 260 PROCenable 270 END 280 : 290 DEF PROCdisable 300 *FX229,1 310 *FX4,1 320 ENDPROC 330 : 340 DEF PROCenable 350 *FX229 360 *FX4 370 ENDPROC 380 : 390 DEF PROCinit 400 ON ERROR PROCerror 410 CLOSE #0 420 PROCdisable 430 PROCcursor_off 440 PROCinit_colours 450 PROCinit_screen 460 max_mesg%=25 470 ENDPROC 480 : 490 DEF PROCerror 500 VDU 3 510 CLOSE #0 520 VDU 26,12 530 REPORT:PRINT " at line ";ERL 540 PROCenable 550 END 560 : 570 DEF FNS="ChckMes" 580 : 590 DEF PROCinit_adfs 600 *ADFS 610 *MOUNT 0 620 *DIR $ 630 ENDPROC 640 : 650 DEF PROCinit_dfs 660 *DISC 670 *DRIVE 0 680 *DIR $ 690 ENDPROC 700 : 710 DEF PROCcursor_off 720 VDU 23,1,0;0;0;0; 730 ENDPROC 740 : 750 DEF PROCcursor_on 760 VDU 23,1,1;0;0;0; 770 ENDPROC 780 : 790 DEF PROCinit_colours 800 border%=6 810 heading%=3 820 text%=7 830 input%=3 840 ENDPROC 850 : 860 DEF PROCinit_screen 870 LOCAL repeat% 880 VDU 26,12 890 PRINTTAB(0,23);CHR$(144+border%);"ÿüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüÿ"; 900 VDU 30,11,30 910 PRINT " ";CHR$(144+border%);"ÿ¯¯¯¯¯¯¯¥ÿ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ÿ"; 920 PRINT CHR$(144+border%);"ÿ¯¯¯¯¯¯¯¯¯¯¯ª¯¯¯¯¯¯¯¯ ";CHR$(144+border%);"ÿ"; 930 PRINT CHR$(144+border%);"ÿ";CHR$(144+heading%);"êë ·Ž€µ ê£àðàðê ° °ð°ðàð   ";CHR$(144+border%);"ÿ"; 940 PRINT CHR$(144+border%);"ÿ";CHR$(144+heading%);"ê뢡·Žµ· ¢ëêêê€ê¡µŽµœµµê® ";CHR$(144+border%);"ÿ"; 950 PRINT CHR$(144+border%);"";CHR$(144+heading%);"¢£ £ ¡£¡ ¢£¢£¢ ¢¡££¡¡¡¡¢£   "; 960 FOR repeat%=1 TO 19 970 PRINT CHR$(144+border%);"ÿ";SPC(36);CHR$(144+border%);"ÿ"; 980 NEXT 990 PRINTTAB(7,5);CHR$(128+heading%);"8BS message checker 0.10" 1000 VDU 28,2,23,37,7 1010 ENDPROC 1020 : 1030 DEF PROCprint(T$) 1040 PROCpretty_print(T$,text%,TRUE) 1050 ENDPROC 1060 : 1070 REM N%=TRUE means go onto a new line afterwards 1080 DEF PROCpretty_print(T$,C%,N%) 1090 REPEAT 1100 IF LEN(T$)<36 THEN PRINT CHR$(128+C%);T$;SPC((35-LEN(T$))*-N%);:T$="" ELSE A%=INSTR(T$," ",37):A%=A%+(A%=0)*-36:REPEAT:A%=A%-1:UNTIL MID$(T$,A%,1)=" ":PRINT CHR$(128+C%);LEFT$(T$,A%-1);SPC(36-A%);:T$=MID$(T$,A%+1) 1110 UNTIL T$="" 1120 ENDPROC 1130 : 1140 DEF PROCfatal(error$) 1150 CLS 1160 PROCprint(error$) 1170 PRINT'CHR$(128+text%);"Press SPACE to return to BASIC" 1180 *FX21 1190 REPEAT UNTIL GET=32 1200 VDU 26,12 1210 PROCcursor_on 1220 PROCenable 1230 END 1240 : 1250 DEF FNprompt_sub_disc 1260 LOCAL key%,key$ 1270 CLS 1280 PROCprint("Please insert your submission disc in drive 0.") 1290 PRINT 1300 PROCprint("When you have done this, press A if it an ADFS disc, D if it is a DFS disc or SPACE to use the current filing system.") 1310 PRINT 1320 PROCprint("If in doubt, just press SPACE.") 1330 REPEAT 1340 *FX21 1350 key%=GET 1360 key$=CHR$((key% AND &DF)-32*(key%=32)) 1370 UNTIL INSTR(" AD",key$)<>0 1380 =key$ 1390 : 1400 DEF FNfs 1410 LOCAL A%,Y% 1420 A%=0 1430 Y%=0 1440 =(USR(&FFDA) AND &FF) 1450 : 1460 DEF PROCbeep 1470 SOUND 1,-10,52,5 1480 ENDPROC 1490 : 1500 DEF FNexist(fname$) 1510 LOCAL chan% 1520 chan%=OPENIN(fname$) 1530 IF chan%<>0 THEN CLOSE #chan% 1540 =(chan%<>0) 1550 : 1560 DEF PROCvalidate_and_read_mesg_file 1570 LOCAL chan%,version%,num_mesg% 1580 CLS 1590 PRINT CHR$(128+text%);"Please wait..." 1600 chan%=OPENIN("!Mesg") 1610 version%=BGET #chan% 1620 IF version%<>0 THEN PROCfatal("The !Mesg file on this disc is a version "+STR$(version%)+" file. This program can only handle version 0 files.") 1630 INPUT #chan%,sender_id$ 1640 INPUT #chan%,sender_name$ 1650 sender_name$=FNstrip_trailing_spaces(sender_name$) 1660 mesg_num_offset%=PTR #chan% 1670 INPUT #chan%,num_mesg% 1680 mesg_mesg_offset%=PTR #chan% 1690 CLOSE #chan% 1700 ENDPROC 1710 : 1720 DEF FNstrip_trailing_spaces(line$) 1730 REPEAT 1740 IF RIGHT$(line$,1)=" " THEN line$=LEFT$(line$,LEN(line$)-1) 1750 UNTIL RIGHT$(line$,1)<>" " 1760 =line$ 1770 : 1780 DEF FNyes 1790 LOCAL key% 1800 REPEAT 1810 *FX21 1820 key%=GET AND &DF 1830 UNTIL key%=ASC("Y") OR key%=ASC("N") 1840 IF key%=ASC("Y") THEN PRINT "Yes";:=TRUE 1850 PRINT "No"; 1860 =FALSE 1870 : 1880 DEF PROCcheck_mesg_file 1890 LOCAL actual_num_mesg%,mesg_size%,edit_del_mesg%,edit_del_size%,user_del_mesg%,user_del_size%,chan%,size%,deleted%,byte% 1900 CLS 1910 PRINT CHR$(128+text%);"Please wait, counting messages..." 1920 actual_num_mesg%=0:mesg_size%=0 1930 edit_del_mesg%=0:edit_del_size%=0 1940 user_del_mesg%=0:user_del_size%=0 1950 chan%=OPENIN("!Mesg") 1960 PTR #chan%=mesg_num_offset% 1970 INPUT #chan%,num_mesg% 1980 PTR #chan%=mesg_mesg_offset% 1990 REPEAT 2000 REM The size includes the header for each message 2010 size%=PTR #chan% 2020 INPUT #chan%,to$ 2030 deleted%=BGET #chan% 2040 REPEAT 2050 byte%=BGET #chan% 2060 UNTIL byte%=152 2070 size%=PTR #chan%-size% 2080 IF deleted%=0 THEN actual_num_mesg%=actual_num_mesg%+1:mesg_size%=mesg_size%+size% 2090 IF deleted%=128 THEN edit_del_mesg%=edit_del_mesg%+1:edit_del_size%=edit_del_size%+size% 2100 IF deleted%=255 THEN user_del_mesg%=user_del_mesg%+1:user_del_size%=user_del_size%+size% 2110 UNTIL EOF #chan% 2120 CLOSE #chan% 2130 CLS 2140 IF actual_num_mesg%=num_mesg% THEN PROCprint("The message file contains "+STR$(num_mesg%)+" messages, which agrees with the count stored in the file. They occupy "+STR$(mesg_size%)+" bytes.") 2150 REM If the message count stored in the file is wrong, deal with it 2160 REM immediately as giving all the other statistics (only shown for 2170 REM interest) may be misleading. 2180 IF actual_num_mesg%<>num_mesg% THEN PROCprint("The message file contains "+STR$(actual_num_mesg%)+" messages but the count stored in the file says there are "+STR$(num_mesg%)+"."):PROCcount_wrong(actual_num_mesg%) 2190 PRINT 2200 REM PROCprint("The file also contains "+STR$(edit_del_mesg%)+" old messages left over from editing messages and "+STR$(user_del_mesg%)+" messages which have been deleted explicitly.") 2210 PROCprint("The file also contains "+STR$(edit_del_mesg%)+" old messages left over from editing messages. They occupy "+STR$(edit_del_size%)+" bytes.") 2220 PRINT 2230 PROCprint("It also contains "+STR$(user_del_mesg%)+" messages which have been deleted explicitly. They occupy "+STR$(user_del_size%)+" bytes.") 2240 PRINT 2250 PRINT CHR$(128+text%);"Press SPACE to continue..." 2260 *FX21 2270 REPEAT UNTIL GET=32 2280 ENDPROC 2290 : 2300 DEF PROCcount_wrong(actual_num_mesg%) 2310 LOCAL chan% 2320 IF actual_num_mesg%>max_mesg% THEN PRINT:PROCprint("There is a maximum of "+STR$(max_mesg%)+" messages, so even if the count is reset there may still be problems.") 2330 IF actual_num_mesg%>max_mesg% THEN PRINT:PROCprint("If you reset it, it will be reset to "+STR$(max_mesg%)+" messages. I advise tidying the message file immediately afterwards and then re-checking it."):actual_num_mesg%=max_mesg% 2340 PRINT'CHR$(128+text%);"Do you want to correct the count"'CHR$(128+text%);"stored in the file?";CHR$(128+input%); 2350 IF NOT FNyes THEN PRINT:ENDPROC 2360 chan%=OPENUP("!Mesg") 2370 PTR #chan%=mesg_num_offset% 2380 PRINT #chan%,actual_num_mesg% 2390 CLOSE #chan% 2400 PRINT 2410 ENDPROC