8-Bit Software Online Conversion

8BS Message Check - Listing

10REM ><BasicSave$Dir>.ChckMes 20REM by Steven Flintham 30REM 40REM Version 0.10 (based on SendMes 2.00) 50REM 60REM Wednesday 12th July 1995 70: 80MODE 7 90PROCinit 100: 110REM Get the submission disc - this involves unpleasant code because of 120REM the error trapping required 130fs$=FNprompt`sub`disc 140ON ERROR PROCbeep:fs$=" ":GOTO 150 150IF fs$=" " AND FNfs=4 THEN fs$="D" 160IF fs$=" " AND FNfs=8 THEN fs$="A" 170IF fs$="A" THEN PROCinit`adfs 180IF fs$="D" THEN PROCinit`dfs 190ON ERROR PROCerror 200: 210IF FNexist("!Mesg") THEN PROCvalida te`and`read`mesg`file ELSE PROCcreate`me sg`file 220: 230PROCcheck`mesg`file 240: 250MODE 7 260PROCenable 270END 280: 290DEF PROCdisable 300*FX229,1 310*FX4,1 320ENDPROC 330: 340DEF PROCenable 350*FX229 360*FX4 370ENDPROC 380: 390DEF PROCinit 400ON ERROR PROCerror 410CLOSE #0 420PROCdisable 430PROCcursor`off 440PROCinit`colours 450PROCinit`screen 460max`mesg%=25 470ENDPROC 480: 490DEF PROCerror 500VDU 3 510CLOSE #0 520VDU 26,12 530REPORT:PRINT " at line ";ERL 540PROCenable 550END 560: 570DEF FNS="ChckMes" 580: 590DEF PROCinit`adfs 600*ADFS 610*MOUNT 0 620*DIR $ 630ENDPROC 640: 650DEF PROCinit`dfs 660*DISC 670*DRIVE 0 680*DIR $ 690ENDPROC 700: 710DEF PROCcursor`off 720VDU 23,1,0;0;0;0; 730ENDPROC 740: 750DEF PROCcursor`on 760VDU 23,1,1;0;0;0; 770ENDPROC 780: 790DEF PROCinit`colours 800border%=6 810heading%=3 820text%=7 830input%=3 840ENDPROC 850: 860DEF PROCinit`screen 870LOCAL repeat% 880VDU 26,12 890PRINTTAB(0,23);CHR$(144+border%);"¶ |||||||||||||||||||||||||||||||||||||¶"; 900VDU 30,11,30 910PRINT " ";CHR$(144+border %);"¶///////%¶/////////////////¶"; 920PRINT CHR$(144+border%);"¶///////// //*//////// ";CHR$(144+bo rder%);"¶"; 930PRINT CHR$(144+border%);"¶";CHR$(14 4+heading%);"jk 74$5 j£`p`pj 0 0p0p`p ";CHR$(144+border%);"¶"; 940PRINT CHR$(144+border%);"¶";CHR$(14 4+heading%);"jk"!7457 "kjjj$j!545=55j. ";CHR$(144+border%);"¶"; 950PRINT CHR$(144+border%);" 4+heading%);""£ £ !£! "£"£" "!££!!!!"£ "; 960FOR repeat%=1 TO 19 970PRINT CHR$(144+border%);"¶";SPC(36) ;CHR$(144+border%);"¶"; 980NEXT 990PRINTTAB(7,5);CHR$(128+heading%);"8 BS message checker 0.10" 1000VDU 28,2,23,37,7 1010ENDPROC 1020: 1030DEF PROCprint(T$) 1040PROCpretty`print(T$,text%,TRUE) 1050ENDPROC 1060: 1070REM N%=TRUE means go onto a new lin e afterwards 1080DEF PROCpretty`print(T$,C%,N%) 1090REPEAT 1100IF 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:REP EAT:A%=A%-1:UNTIL MID$(T$,A%,1)=" ":PRIN T CHR$(128+C%);LEFT$(T$,A%-1);SPC(36-A%) ;:T$=MID$(T$,A%+1) 1110UNTIL T$="" 1120ENDPROC 1130: 1140DEF PROCfatal(error$) 1150CLS 1160PROCprint(error$) 1170PRINT'CHR$(128+text%);"Press SPACE to return to BASIC" 1180*FX21 1190REPEAT UNTIL GET=32 1200VDU 26,12 1210PROCcursor`on 1220PROCenable 1230END 1240: 1250DEF FNprompt`sub`disc 1260LOCAL key%,key$ 1270CLS 1280PROCprint("Please insert your submi ssion disc in drive 0.") 1290PRINT 1300PROCprint("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 f iling system.") 1310PRINT 1320PROCprint("If in doubt, just press SPACE.") 1330REPEAT 1340*FX21 1350key%=GET 1360key$=CHR$((key% AND &DF)-32*(key%=3 2)) 1370UNTIL INSTR(" AD",key$)<>0 1380=key$ 1390: 1400DEF FNfs 1410LOCAL A%,Y% 1420A%=0 1430Y%=0 1440=(USR(&FFDA) AND &FF) 1450: 1460DEF PROCbeep 1470SOUND 1,-10,52,5 1480ENDPROC 1490: 1500DEF FNexist(fname$) 1510LOCAL chan% 1520chan%=OPENIN(fname$) 1530IF chan%<>0 THEN CLOSE #chan% 1540=(chan%<>0) 1550: 1560DEF PROCvalidate`and`read`mesg`file 1570LOCAL chan%,version%,num`mesg% 1580CLS 1590PRINT CHR$(128+text%);"Please wait. .." 1600chan%=OPENIN("!Mesg") 1610version%=BGET #chan% 1620IF version%<>0 THEN PROCfatal("The !Mesg file on this disc is a version "+S TR$(version%)+" file. This program can o nly handle version 0 files.") 1630INPUT #chan%,sender`id$ 1640INPUT #chan%,sender`name$ 1650sender`name$=FNstrip`trailing`space s(sender`name$) 1660mesg`num`offset%=PTR #chan% 1670INPUT #chan%,num`mesg% 1680mesg`mesg`offset%=PTR #chan% 1690CLOSE #chan% 1700ENDPROC 1710: 1720DEF FNstrip`trailing`spaces(line$) 1730REPEAT 1740IF RIGHT$(line$,1)=" " THEN line$=L EFT$(line$,LEN(line$)-1) 1750UNTIL RIGHT$(line$,1)<>" " 1760=line$ 1770: 1780DEF FNyes 1790LOCAL key% 1800REPEAT 1810*FX21 1820key%=GET AND &DF 1830UNTIL key%=ASC("Y") OR key%=ASC("N" ) 1840IF key%=ASC("Y") THEN PRINT "Yes";: =TRUE 1850PRINT "No"; 1860=FALSE 1870: 1880DEF PROCcheck`mesg`file 1890LOCAL actual`num`mesg%,mesg`size%,e dit`del`mesg%,edit`del`size%,user`del`me sg%,user`del`size%,chan%,size%,deleted%, byte% 1900CLS 1910PRINT CHR$(128+text%);"Please wait, counting messages..." 1920actual`num`mesg%=0:mesg`size%=0 1930edit`del`mesg%=0:edit`del`size%=0 1940user`del`mesg%=0:user`del`size%=0 1950chan%=OPENIN("!Mesg") 1960PTR #chan%=mesg`num`offset% 1970INPUT #chan%,num`mesg% 1980PTR #chan%=mesg`mesg`offset% 1990REPEAT 2000REM The size includes the header fo r each message 2010size%=PTR #chan% 2020INPUT #chan%,to$ 2030deleted%=BGET #chan% 2040REPEAT 2050byte%=BGET #chan% 2060UNTIL byte%=152 2070size%=PTR #chan%-size% 2080IF deleted%=0 THEN actual`num`mesg% =actual`num`mesg%+1:mesg`size%=mesg`size %+size% 2090IF deleted%=128 THEN edit`del`mesg% =edit`del`mesg%+1:edit`del`size%=edit`de l`size%+size% 2100IF deleted%=255 THEN user`del`mesg% =user`del`mesg%+1:user`del`size%=user`de l`size%+size% 2110UNTIL EOF #chan% 2120CLOSE #chan% 2130CLS 2140IF actual`num`mesg%=num`mesg% THEN PROCprint("The message file contains "+S TR$(num`mesg%)+" messages, which agrees with the count stored in the file. They occupy "+STR$(mesg`size%)+" bytes.") 2150REM If the message count stored in the file is wrong, deal with it 2160REM immediately as giving all the o ther statistics (only shown for 2170REM interest) may be misleading. 2180IF actual`num`mesg%<>num`mesg% THEN PROCprint("The message file contains "+ STR$(actual`num`mesg%)+" messages but th e count stored in the file says there ar e "+STR$(num`mesg%)+"."):PROCcount`wrong (actual`num`mesg%) 2190PRINT 2200REM PROCprint("The file also contai ns "+STR$(edit`del`mesg%)+" old messages left over from editing messages and "+S TR$(user`del`mesg%)+" messages which hav e been deleted explicitly.") 2210PROCprint("The file also contains " +STR$(edit`del`mesg%)+" old messages lef t over from editing messages. They occup y "+STR$(edit`del`size%)+" bytes.") 2220PRINT 2230PROCprint("It also contains "+STR$( user`del`mesg%)+" messages which have be en deleted explicitly. They occupy "+STR $(user`del`size%)+" bytes.") 2240PRINT 2250PRINT CHR$(128+text%);"Press SPACE to continue..." 2260*FX21 2270REPEAT UNTIL GET=32 2280ENDPROC 2290: 2300DEF PROCcount`wrong(actual`num`mesg %) 2310LOCAL chan% 2320IF 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 pr oblems.") 2330IF actual`num`mesg%>max`mesg% THEN PRINT:PROCprint("If you reset it, it wil l be reset to "+STR$(max`mesg%)+" messag es. I advise tidying the message file im mediately afterwards and then re-checkin g it."):actual`num`mesg%=max`mesg% 2340PRINT'CHR$(128+text%);"Do you want to correct the count"'CHR$(128+text%);"s tored in the file?";CHR$(128+input%); 2350IF NOT FNyes THEN PRINT:ENDPROC 2360chan%=OPENUP("!Mesg") 2370PTR #chan%=mesg`num`offset% 2380PRINT #chan%,actual`num`mesg% 2390CLOSE #chan% 2400PRINT 2410ENDPROC