10REM ><BasicSave$Dir>.MsgSize
20REM by Steven Flintham
30REM
40REM Version 0.10
50REM based on SendMes 2.11
60REM
70REM Saturday 1st November 1997
80REM Tuesday 4th November 1997
90REM Thursday 6th November 1997
100:
110MODE 7
120PROCinit
130:
140REM Get the submission disc - this
involves unpleasant code because of
150REM the error trapping required
160ON ERROR VDU 3:PROCoscli("FX3"):CLO
SE #0:MODE 7:IF ERR=17 THEN PROCenable:E
ND ELSE REPORT:PRINT " at line ";ERL:PRO
Cenable:END
170*FX229
180fs$=FNprompt`sub`disc
190*FX229,1
200ON ERROR PROCbeep:fs$=" ":GOTO 210
210IF fs$=" " AND FNfs=4 THEN fs$="D"
220IF fs$=" " AND FNfs=8 THEN fs$="A"
230IF fs$="A" THEN PROCinit`adfs
240IF fs$="D" THEN PROCinit`dfs
250ON ERROR VDU 3:PROCoscli("FX3"):CLO
SE #0:MODE 7:IF ERR=17 THEN PROCenable:E
ND ELSE REPORT:PRINT " at line ";ERL:PRO
Cenable:END
260*FX229
270:
280IF NOT FNexist("!Mesg") THEN PROCfa
tal("There is no message file on this di
sc to resize.")
290IF FNexist("!MesgX") THEN PROCfatal
("There is already a !MesgX file on this
disc.")
300PROCvalidate`and`read`mesg`file
310DIM to`list$(max`mesg%-1), deleted%
(max`mesg%-1)
320PROCcache`message`data
330new`max`mesg%=FNget`new`size
340*FX229,1
350ON ERROR CLOSE #0:PROCproblem("An e
rror has occurred while changing the siz
e of the message file."):MODE 7:REPORT:P
RINT " at line ";ERL:PROCenable:END
360PROCresize`message`file(new`max`mes
g%)
370*Delete !Mesg
380*Rename !MesgX !Mesg
390:
400MODE 7
410PROCenable
420END
430:
440DEF PROCdisable
450*FX229,1
460*FX4,1
470ENDPROC
480:
490DEF PROCenable
500*FX118
510*FX229
520*FX4
530ENDPROC
540:
550DEF PROCinit
560ON ERROR MODE 7:REPORT:PRINT " at l
ine ";ERL:PROCenable:END
570CLOSE #0
580PROCdisable
590PROCcursor`off
600PROCinit`colours
610PROCinit`screen
620DIM block% 32, message% 4096
630ENDPROC
640:
650DEF FNS="MsgSize"
660:
670DEF PROCinit`adfs
680*ADFS
690*MOUNT 0
700*DIR $
710ENDPROC
720:
730DEF PROCinit`dfs
740*DISC
750*DRIVE 0
760*DIR $
770ENDPROC
780:
790DEF PROCcursor`off
800VDU 23,1,0;0;0;0;
810ENDPROC
820:
830DEF PROCcursor`on
840VDU 23,1,1;0;0;0;
850ENDPROC
860:
870DEF PROCoscli($block%)
880LOCAL X%,Y%
890X%=block% MOD 256
900Y%=block% DIV 256
910CALL &FFF7
920ENDPROC
930:
940DEF PROCinit`colours
950border%=150
960heading%=147
970text%=135
980input%=131
990ENDPROC
1000:
1010DEF PROCinit`screen
1020LOCAL repeat%
1030VDU 26,12
1040PRINTTAB(0,23);CHR$(border%);"¶||||
|||||||||||||||||||||||||||||||||¶";
1050VDU 30,11,30
1060PRINT " ";CHR$(border%);"
¶///////%¶/////////////////¶";
1070PRINT CHR$(border%);"¶///////////*/
/////// ";CHR$(border%);"
¶";
1080PRINT CHR$(border%);"¶";CHR$(headin
g%);"6£4 7i(h0 6) 0`$t` ` 0 0`
";CHR$(border%);"¶";
1090PRINT CHR$(border%);"¶";CHR$(headin
g%);"6£4!7ijj 2ijjj!5jhj`nj =!
";CHR$(border%);"¶";
1100PRINT CHR$(border%);"g%);""£ £!" ! "! !" " !! £" "!
"
1110FOR repeat%=1 TO 19
1120PRINT CHR$(border%);"¶";SPC(36);CHR
$(border%);"¶";
1130NEXT
1140PRINTTAB(5,5);CHR$(heading%-16);"8B
S message file resizer 0.10"
1150VDU 28,2,23,37,7
1160ENDPROC
1170:
1180DEF PROCprint(T$)
1190PROCpretty`print(T$,text%,TRUE)
1200ENDPROC
1210:
1220REM N%=TRUE means go onto a new lin
e afterwards
1230DEF PROCpretty`print(T$,C%,N%)
1240REPEAT
1250IF LEN(T$)<36 THEN PRINT CHR$(C%);T
$;SPC((35-LEN(T$))*-N%);:T$="" ELSE A%=I
NSTR(T$," ",37):A%=A%+(A%=0)*-36:REPEAT:
A%=A%-1:UNTIL MID$(T$,A%,1)=" ":PRINT CH
R$(C%);LEFT$(T$,A%-1);SPC(36-A%);:T$=MID
$(T$,A%+1)
1260UNTIL T$=""
1270ENDPROC
1280:
1290DEF PROCproblem(error$)
1300CLS
1310PROCprint(error$)
1320PRINT'CHR$(text%);"Press SPACE to c
ontinue..."
1330*FX21
1340REPEAT UNTIL GET=32
1350ENDPROC
1360:
1370DEF PROCfatal(error$)
1380CLS
1390PROCprint(error$)
1400PRINT'CHR$(text%);"Press SPACE to r
eturn to BASIC"
1410*FX21
1420REPEAT UNTIL GET=32
1430VDU 26,12
1440PROCcursor`on
1450PROCenable
1460END
1470:
1480DEF FNprompt`sub`disc
1490LOCAL key%,key$
1500CLS
1510PROCprint("Please insert your submi
ssion disc in drive 0. This disc should
remain in the drive at all times when yo
u are using this program.")
1520PRINT
1530PROCprint("When you have done this,
press A if it is an ADFS disc, D if it
is a DFS disc or SPACE to use the curren
t filing system.")
1540PRINT
1550PROCprint("If in doubt, just press
SPACE.")
1560REPEAT
1570*FX21
1580key%=GET
1590key$=CHR$((key% AND &DF)-32*(key%=3
2))
1600UNTIL INSTR(" AD",key$)<>0
1610=key$
1620:
1630DEF FNfs
1640LOCAL A%,Y%
1650A%=0
1660Y%=0
1670=(USR(&FFDA) AND &FF)
1680:
1690DEF PROCbeep
1700SOUND 1,-10,52,5
1710ENDPROC
1720:
1730DEF FNexist(fname$)
1740LOCAL chan%
1750chan%=OPENIN(fname$)
1760IF chan%<>0 THEN CLOSE #chan%
1770=(chan%<>0)
1780:
1790DEF PROCvalidate`and`read`mesg`file
1800LOCAL chan%,version%,discard$
1810CLS
1820PRINT CHR$(text%);"Please wait, sca
nning messages..."
1830chan%=OPENIN("!Mesg")
1840version%=BGET #chan%
1850IF version%<>1 THEN PROCfatal("The
!Mesg file on this disc is a version "+S
TR$(version%)+" file. This program can o
nly handle version 1 files.")
1860INPUT #chan%,discard$
1870INPUT #chan%,discard$
1880max`mesg%=(EXT #chan%-256)/4096
1890IF ((EXT #chan%-256) MOD 4096)<>0 O
R max`mesg%<5 OR max`mesg%>25 THEN PROCf
atal("The !Mesg file is an unacceptable
size.")
1900CLOSE #chan%
1910ENDPROC
1920:
1930DEF FNget`new`size
1940LOCAL s$,min%,new`max`mesg%
1950CLS
1960IF num`mesg%=1 THEN s$="" ELSE s$="
s"
1970PROCprint("This message file has ro
om for "+STR$(max`mesg%)+" messages and
contains "+STR$(num`mesg%)+" message"+s$
+" at present.")
1980IF num`mesg%<5 THEN min%=5 ELSE min
%=num`mesg%
1990REPEAT
2000PRINT'
2010PROCprint("How many messages do you
wish to have room for in the message fi
le?")
2020PRINT'CHR$(text%);"Messages (";min%
;"-25):";CHR$(input%);
2030new`max`mesg%=VAL(FNinput(1,2,""))
2040UNTIL new`max`mesg%>=min% AND new`m
ax`mesg%<=25
2050=new`max`mesg%
2060:
2070DEF FNinput(min%,max%,text$)
2080LOCAL xpos%,ypos%,key%
2090xpos%=POS
2100ypos%=VPOS
2110PRINT LEFT$(text$+STRING$(max%,".")
,max%);TAB(xpos%+LEN(text$),ypos%);
2120REPEAT
2130REPEAT
2140*FX21
2150key%=GET
2160UNTIL key%=13 OR (key%>=32 AND key%
<=127)
2170IF key%=127 AND LEN(text$)>0 THEN V
DU 8,46,8:text$=LEFT$(text$,LEN(text$)-1
)
2180IF key%<>127 AND key%<>13 AND LEN(t
ext$)<max% THEN VDU key%:text$=text$+CHR
$(key%)
2190UNTIL (key%=13 AND LEN(text$)>=min%
)
2200=text$
2210:
2220DEF PROCresize`message`file(new`max
`mesg%)
2230LOCAL in%,out%,string$,create%,to%,
from%
2240CLS:PRINT CHR$(text%);"Please wait,
resizing file..."
2250in%=OPENIN("!Mesg")
2260out%=OPENOUT("!MesgX")
2270BPUT #out%,BGET #in%:REM version by
te
2280INPUT #in%,string$:PRINT #out%,stri
ng$:REM sender ID
2290INPUT #in%,string$:PRINT #out%,stri
ng$:REM sender name
2300FOR create%=0 TO new`max`mesg%-1
2310PTR #out%=256+create%*4096
2320PRINT #out%,"XXX"
2330BPUT #out%,1
2340NEXT
2350PTR #out%=256+new`max`mesg%*4096
2360to%=0
2370FOR from%=0 TO max`mesg%-1
2380IF deleted%(from%)=0 THEN PROCcopy`
message(in%,from%,out%,to%):to%=to%+1
2390NEXT
2400CLOSE #in%
2410CLOSE #out%
2420ENDPROC
2430:
2440DEF PROCcopy`message(in%,from%,out%
,to%)
2450LOCAL A%,X%,Y%
2460block%?0=in%
2470block%!1=message%
2480block%!5=4096
2490block%!9=256+from%*4096
2500A%=3:X%=block% MOD 256:Y%=block% DI
V 256:CALL &FFD1
2510block%?0=out%
2520block%!1=message%
2530block%!5=4096
2540block%!9=256+to%*4096
2550A%=1:X%=block% MOD 256:Y%=block% DI
V 256:CALL &FFD1
2560ENDPROC
2570:
2580DEF PROCcache`message`data
2590LOCAL chan%,read%,to$,discard%
2600chan%=OPENIN("!Mesg")
2610FOR read%=0 TO max`mesg%-1
2620PTR #chan%=256+read%*4096
2630INPUT #chan%,to$
2640deleted%(read%)=BGET #chan%
2650IF deleted%(read%)<>1 THEN to`list$
(read%)=to$
2660NEXT
2670CLOSE #chan%
2680num`mesg%=FNnum`messages
2690ENDPROC
2700:
2710DEF FNnum`messages
2720LOCAL num`mesg%,read%
2730num`mesg%=0
2740FOR read%=0 TO max`mesg%-1
2750IF deleted%(read%)=0 THEN num`mesg%
=num`mesg%+1
2760NEXT
2770=num`mesg%