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%);"6£4 7i(h0 6) 0`$t` ` 0 0`
";CHR$(144+border%);"¶";
940PRINT CHR$(144+border%);"¶";CHR$(14
4+heading%);"6£4!7ijj 2ijjj!5jhj`nj =!
";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