5
10
20 PROCinitialize:
30 PROCfs(net%):X%=&70:Y%=0:A%=0:R%=USRosargs% AND &FF:IF R%<>net% THEN PRINT"Net filing system not present"'':END
40 spaces%=5
50 title$="File server directory archiver":PRINTCHR$12'''title$'STRING$(LENtitle$,"*")''
60 ON ERROR REPORT:PRINT" at ";ERL:END
70 PRINT"Archives currently selected directory"'"and sub-directories"'
90 PROCpreservecontext
100 PRINT'"Select filing System for archive"TAB(40)"(A=Adfs, D=Disc)"'" :";:REPEATdfile$=GET$:UNTILINSTR("AaDd",dfile$):f%=INSTR("Aa",dfile$)
110 IF f% THEN dfile%=adfs%:PRINT"Adfs" ELSE dfile%=disc%:PRINT"Disc"
120 ON ERROR REPORT:PRINT" at "ERL:ONERROR OFF:PROCfs(dfile%):PROCrestore_disc:CLOSE#0:PROCfs(net%):CLOSE#0:X%=FNhomecontext(csd%):END
130 REPEAT
140 PRINT'"Pathname of";
150 IF FNcommand("directory to archive.",TRUE) THEN UNTIL0
160 $top%=$var%+"."
170 IF FNunpriv($var%) THEN PRINT'"Insufficient access":UNTIL0
180 UNTILTRUE
190 $path%=$var%:length%=LEN$path%:PROCsortdates
200 IF $path%<>"":new%=FNopen(path%,&40):csd%=FNnewcontext(new%,csd%)
210 off%=FNoffset
220 $string%="DFS drive":IF dfile%=adfs% THEN $string%="A"+$string%
230 REPEAT
240 IF FNcommand($string%,FALSE) THEN UNTIL0
250 IF dfile%=disc% THEN UNTIL INSTR("0123",$var%)
260 IF dfile%=adfs% THEN UNTIL INSTR("0145AaBbEeFf",$var%)
270 IF INSTR("AaBbEeFf",$var%) THEN T%=(ASC$var% AND &5F)-&11:$var%=CHR$T%
280 d_drive%=VAL($var%)
290 PROCfs(dfile%):IF dfile%=adfs% THEN PROCoscli("DIR :"+$var%) ELSE PROCoscli("Dr. :"+$var%)
300 X%=&70:Y%=0:A%=0:R%=USRosargs% AND &FF:IF R%<>dfile% THEN PRINT"Filing sytem not present":GOTO 100
310 IF FNcompact ELSE PRINT'"Please use a compacted ADFS disc.":GOTO 220
320 IF FNcommand("Name of archive file ",FALSE) THEN 320 ELSE $init%=$var%
340 h%=FNgraber(init%):IF h% ELSE:sin%=0:GOTO220
345 TIME=0
350 PROCfs(net%):PRINT'"Beginning archive ..."':q%=FNarchive
360 PRINT'"Directory "$path%" archived."'
370 PROCfs(dfile%):X%=FNw_buffer(wbuff%):PROCrestore_disc:PROCfs(net%)
380 X%=FNhomecontext(csd%)
390 IF q% ELSE PRINT"Errors detected"'
400 A%=229:X%=0:Y%=0:CALLosbyte%
410 END
420 :
430 DEF FNarchive
440 LOCAL nodata%,complete%,index%,c%
450 complete%=TRUE:index%=0
460 IF FNreadname(index%) THEN PROCerror(0):=FALSE
470 nodata%=cb%!5:IF nodata% THEN 560
480 IF off%=FALSE ELSE $name%=FNlcase($name%):IF $name%>=$offname% THEN off%=FALSE ELSE 550
490 type%=FNexamine(name%,cb1%)
495 days%=cb1%?15AND31:months%=cb1%?16AND15:years%=1981+(cb1%?16DIV16)+((cb%?15AND&E0)DIV2)
496 PROCname
500 IF type%<>directory ELSE IF FNheader(path%,name%) ELSE nodata%=0:GOTO 550
510 IF type%=file THEN PROCcopydata(name%):GOTO 550
520 PROCdown_a_dir(name%):c%=FNarchive
530 PROCup_a_dir
540 IF c% ELSE complete%=FALSE
550 index%=index%+1
560 IF nodata% ELSE 460
570 =complete%
580 :
590 DEFPROCdown_a_dir(name%)
600 LOCALnew%
610 spaces%=spaces%+3
620 IF LEN $path% THEN path%?length%=ASC".":length%=length%+1
630 i%=0
640 REPEAT
650 path%?length%=name%?i%
660 i%=i%+1:length%=length%+1
670 UNTILname%?(i%-1)=&D:length%=length%-1
680 new%=FNopen(name%,&40):csd%=FNnewcontext(new%,csd%)
690 ENDPROC
700 :
710 DEFPROCup_a_dir
720 spaces%=spaces%-3
730 oldlength%=LEN$path%
740 REPEAT:length%=length%-1:UNTIL(length%?path%=ASC".") OR length%=0
750 path%?length%=&0D
760 newlength%=0:IF length% THEN blength%=length%+1 ELSE blength%=0
770 REPEAT
780 name%?newlength%=path%?blength%
790 newlength%=newlength%+1:blength%=blength%+1
800 UNTILblength%=oldlength%
810 name%?newlength%=&0D
820 csd%=FNhomecontext(csd%):IF $path%="" ELSE new%=FNopen(path%,&40):csd%=FNnewcontext(new%,csd%)
830 ENDPROC
840 :
850 DEFFNreadname(index%)
860 LOCAL i%,q%
870 cb%!1=name%
880 cb%!5=1:
890 cb%!9=index%
900 X%=cb%:Y%=X% DIV &100
910 A%=8
920 q%=FNcall(osgbpb%):
930 IF cb%!5 THEN 990
940 i%=1
950 REPEAT
960 IF (i%?name%=ASC" ") OR (i%=11) THEN i%?name%=&D
970 i%=i%+1
980 UNTILi%=12:$name%=$(name%+1)
990 =q%
1000 :
1010 DEFPROCpreservecontext
1020 ?buffer%=6:X%=buffer%:Y%=X% DIV &100:A%=&13:CALL osword%:urd%=buffer%?1:csd%=buffer%?2:lib%=buffer%?3:source%=csd%
1030 ENDPROC
1070 :
1080 DEFFNnewcontext(new%,csd%)
1090 ?buffer%=7:buffer%?1=urd%:buffer%?2=new%:buffer%?3=lib%
1100 X%=buffer%:Y%=X% DIV &100:A%=&13:CALL osword%
1110 IF csd%<>source% IF csd%<>lib% IFcsd%<>urd% CLOSE#csd%
1120 csd%=new%
1130 =csd%
1140 :
1150 DEFFNhomecontext(csd%)
1160 ?buffer%=7:buffer%?1=urd%:buffer%?2=source%:buffer%?3=lib%
1170 X%=buffer%:Y%=X% DIV &100:A%=&13:CALL osword%
1180 IF csd%<>source%:CLOSE#csd%:csd%=source%
1190 =csd%
1200 :
1210 DEFFNexamine(n%,block%)
1220 !block%=n%
1230 X%=block%:Y%=X% DIV &100:A%=5:r%=USR(osfile%) AND &FF
1270 =r%
1280 :
1290 DEFFNopen(n%,a%)
1300 X%=n%:Y%=X% DIV &100
1310 A%=a%
1320 IF FNcall(osfind%) THEN PROCerror(0):=FALSE
1330 =?tempa
1340 :
1350 DEFPROCclose(h%)
1360 Y%=h%:A%=0:IF FNcall(osfind%) THEN PROCerror(0)
1370 ENDPROC
1380 :
1390 DEFPROCname
1400 PRINTTAB(spaces%);
1410 IF r%=directory THEN PRINTTAB(spaces%-5)"Dir. "$name%:days%=std%:months%=stm%:years%=sty%
1420 IF r%<>file ELSE IF FNrange_dates ELSE PRINTTAB(spaces%)$name%;:PROCsize
1430 ENDPROC
1440 :
1450 DEFPROCsize
1460 A%=5:X%=cb%:Y%=X% DIV &100
1470 !cb%=name%
1480 q%=FNcall(osfile%)
1490 @%=&A0A
1500 IF POS<25 THEN PRINTTAB(30)FNh0(cb%!&A,6); ELSE PRINTTAB((POS+6)-(POS+6)MOD5)FNh0(cb%!&A,6)
1510 PRINT" "+FNd0(days%,2)+"/"+FNd0(months%,2)+"/"+FNd0(years%,4)
1520 ENDPROC
1522 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
1523 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
1530 :
1540 DEFFNunpriv($string%)
1550 !buffer%=&04003000:$(buffer%+7)=$string%
1560 X%=buffer%:Y%=X% DIV &100:A%=&14:CALL osword%
1570 =(buffer%?&F=ASC"P")
1580 :
1590 DEFFNdfs_size(d_drive%)
1610 IF dfile%<>adfs% ELSE X%=buffer%:Y%=X% DIV &100:A%=&71:CALL osword%:size_left%=!buffer%:IF size_left%>&10000 THEN size_left%=size_left%-&10000:=size_left% ELSE PRINT"Not enough room on ADFS disc.":=0
1620 IF NOT FNr_sector(d_drive%,1,1):=0
1630 dfs_start%=?(buffer%+&F):dfs_start%=(?(buffer%+&E) AND &3)*&100+dfs_start%:dfs_start%=dfs_start%*&100:IF dfs_start%=0 THEN dfs_start%=&200
1640 dfs_length%=?(buffer%+&C):dfs_length%=?(buffer%+&D)*&100+dfs_length%:dfs_length%=(?(buffer%+&E) AND &30)*&1000+dfs_length%
1650 d_sz%=buffer%?7:d_sz%=buffer%?6*&100+d_sz%
1660 size_left%=d_sz%*&100-(dfs_length%+dfs_start%):size_left%=(size_left% DIV &100*&100):IF size_left%<&480 THEN PRINT"Not enough room on DFS disc.":=0 ELSE size_left%=size_left%-&480
1670 sin%=(dfs_length%+dfs_start%) DIV &100
1680 IF ?(buffer%+&C)sin%=sin%+1
1690 =size_left%
1700 :
1710 DEFPROCsortdates
1720 error%=TRUE
1730 REPEAT
1740 PRINT'"Start date (dd/mm/yyyy)"'" :";:INPUT""start$
1750 IF ASCstart$=-1 THEN std$="01":stm$="01":sty$="1981":GOTO 1800
1760 std$=LEFT$(start$,INSTR(start$,"/")-1):IF LEN std$>2 THEN 1820
1770 start$=MID$(start$,INSTR(start$,"/")+1,LEN(start$))
1780 stm$=LEFT$(start$,INSTR(start$,"/")-1):IF LEN stm$>2 THEN 1820
1790 sty$=MID$(start$,INSTR(start$,"/")+1,LEN(start$)):IF LEN sty$>4 THEN 1820
1800 std%=VAL(std$):stm%=VAL(stm$):sty%=VAL(sty$)
1805 IF sty%<100 THEN sty%=1900+sty%:IF sty%<1980 THEN sty%=sty%+100
1810 IF std%<1 OR std%>31 OR stm%<1 OR stm%>12 OR sty%<1981 ELSE error%=FALSE
1820 UNTILerror%=FALSE
1830 :
1840 error%=TRUE
1850 REPEAT
1860 PRINT'"End date (dd/mm/yyyy)"'" :";:INPUT""end$
1870 IF ASCend$=-1 THEN edd$="31":edm$="12":edy$="2108":GOTO 1920
1880 edd$=LEFT$(end$,INSTR(end$,"/")-1):IF LEN edd$>2 THEN 1940
1890 end$=MID$(end$,INSTR(end$,"/")+1,LEN(end$))
1900 edm$=LEFT$(end$,INSTR(end$,"/")-1):IF LEN edm$>2 THEN 1940
1910 edy$=MID$(end$,INSTR(end$,"/")+1,LEN(end$)):IF LEN edy$>4 THEN 1940
1920 edd%=VAL(edd$):edm%=VAL(edm$):edy%=VAL(edy$)
1925 IF edy%<100 THEN edy%=1900+edy%:IF edy%<1980 THEN edy%=edy%+100
1930 IF edd%<1 OR edd%>31 OR edm%<1 OR edm%>12 OR edy%<1981 ELSE error%=FALSE
1940 UNTILerror%=FALSE
1950 :
1960 IF edy%<sty% THEN 1720
1970 IF edy%=sty% THEN IF edm%<stm% THEN 1720
1980 IF edy%=sty% AND edm%=stm% THEN IF edd%<std% THEN 1720
1990 ENDPROC
2000 :
2010 DEFPROCinitmc
2020 FOR pass%=0 TO 2 STEP 2
2030 P%=space%
2040 [ OPT pass%
2050 .trap sta tempa:stx tempx:sty tempy
2060 lda brkvec:sta copy:lda brkvec+1:sta copy+1
2070 tsx:stx sp:lda #0:sta error_flag
2080 lda# (brkcode AND &FF):sta brkvec
2090 lda# (brkcode /&100):sta brkvec+1
2100 lda tempa:ldx tempx:ldy tempy:jsr indirect
2110 sta tempa:\ return A
2120 .restore lda copy:sta brkvec:lda copy+1:sta brkvec+1:rts
2130 \
2140 .brkcode ldy#0:lda (&FD),Y:sta error_flag
2150 ldx sp:txs:iny
2160 .loop lda (&FD),Y:beq exit:sta errmsg,Y:iny:bne loop
2170 .exit lda #13:sta errmsg,Y:jmp restore
2180 .indirect jmp (go)
2190 ]
2200 NEXT
2210 ENDPROC
2220 :
2230 DEFPROCinitialize
2240 osfind%=&FFCE:osgbpb%=&FFD1:osargs%=&FFDA:osfile%=&FFDD:osword%=&FFF1:osbyte%=&FFF4:oscli%=&FFF7
2250 file=1:directory=2
2260 sin%=0
2270 @%=3:VDU15
2280 brkvec=&202:oldbrk=!brkvec
2300 sp=&70:go=&71:copy=&73
2320 tempa=copy+2:tempx=tempa+1:tempy=tempx+1:error_flag=tempy+1
2330 net%=5:adfs%=8:disc%=4:seq%=1:size_left%=0:to_write%=0:fsize%=0
2340
2350 DIM cb% 30,cb1% 30,name%50,errmsg 30,path% &100,space% &100,var% &100,top% &30,string% &100,n% &100,init% 50,offname% &80,buffer% 256
2360 DIM Z%-1:size%=HIMEM-Z%-&B00:size%=size% AND &FF00
2370 DIM wbuff% size%
2375 C%=cb%
2380 days%=0:months%=0:years%=0:split%=FALSE:source%=0
2390 PROCinitmc
2410 ENDPROC
2420 :
2430 DEFPROCoscli($string%)
2435 X%=string%:Y%=X%DIV &100
2450 IF FNcall(oscli%) THEN PROCerror(0)
2460 ENDPROC
2470 :
2480 DEFFNcall(addr)
2490 ?go=addr:go?1=(addr AND &FF00) DIV &100
2500 CALL trap
2510 =?error_flag<>0
2520 DEFPROCerror(trap%)
2530 IF ?error_flag=trap% ELSE PRINT$(errmsg+1)
2540 ENDPROC
2550 :
2560 DEFFNerror
2570 IF ?error_flag=0 THEN =FALSE
2580 IF ?error_flag>&A8 =?error_flag
2590 ?cb%=10:X%=cb%:Y%=X% DIV &100:A%=&13:CALL osword%:=cb%?1
2600 :
2610 DEFFNcommand(string$,atype%)
2620 LOCAL fflag%,A$:fflag%=TRUE
2630 $var%="":PRINT'string$'" :";:INPUTLINE""A$
2640 IF RIGHT$(A$,1)=" " THEN A$=LEFT$(A$,LENA$-1):GOTO 2640
2650 IF ASCA$=ASC" " THEN A$=MID$(A$,2):GOTO 2650
2660 $var%=A$
2670 IF LEFT$($var%,1)="*" THEN PROCoscli($var%):PROCpreservecontext:GOTO 2630
2680 IF LEN $var% THEN fflag%=FALSE ELSE IF atype% THEN fflag%=FALSE
2685 PROCfs(currentfs%)
2690 =fflag%
2700 :
2710 DEFFNheader(path%,name%)
2715 LOCAL lb%
2720 IF FNrange_dates THEN =TRUE
2730 LOCAL i%
2740 IF LEN $path%+LEN$name%>=200 THEN PRINT"String too long - Unable to copy.":=FALSE
2745 lb%=LEN$name%:IF LEN$path%:lb%=lb%+1+LEN$path%
2750 IF size_left%<(lb%+19) THEN PROCsplit_it(TRUE)
2770 IF LEN $path%:FORi%=0 TO LEN $path%-1:PROCbput(path%?i%):NEXT:PROCbput(ASC".")
2780 FORi%=0 TO LEN $name%:PROCbput(name%?i%):NEXT
2790 PROCbput(type%):PROCbput(seq%)
2800 FORi%=2 TO 18:PROCbput(cb1%?i%):NEXT
2810 size_left%=size_left%-(lb%+19)
2820 =TRUE
2830 :
2840 DEFPROCfs(f%)
2850 IF f%=4 THEN $string%="Disc"
2860 IF f%=5 THEN $string%="Net"
2870 IF f%=8 THEN $string%="Adfs"
2875 currentfs%=f%
2880 X%=string%:Y%=string%DIV&100:CALLoscli%
2890 ENDPROC
2900 :
2970 :
2980 DEFPROCcopydata(name%)
2990 IF FNrange_dates THEN PRINT"dates exit":ENDPROC
3000 from%=FNopen(name%,&40)
3010 IF from% ELSE PRINT"Unble to copy "$name%:ENDPROC
3020 fsize%=cb1%!10
3030 IF FNheader(path%,name%) ELSE GOTO 3090
3035 REPEAT
3040 IF size_left%-2<fsize%:PROCtranz(size_left%-2,from%):ELSE:PROCtranz(fsize%,from%)
3070 IF size_left%=2:PROCsplit_it(TRUE):X%=FNheader(path%,name%)
3080 UNTILfsize%=0
3090 PROCclose(from%)
3100 ENDPROC
3110 :
3120
3130 DEF PROCtranz(tamount%,from%)
3140 REPEAT
3150 IF size%-bp%>=tamount%:PROCgetput(tamount%,from%):UNTIL1:ENDPROC
3160 tamount%=tamount%-(size%-bp%):PROCgetput(size%-bp%,from%):IF FNw_buffer(wbuff%):ELSE:PRINT "Unable to ensure buffer, archive aborted":ERROR HERE
3165 IF tamount%<0:PRINT"overflow error ":END
3170 UNTIL tamount%=0
3175 ENDPROC
3180
3190 DEFPROCgetput(amount%,nethandle%)
3200 cb%?0=nethandle%:cb%!1=wbuff%+bp%:cb%!5=amount%:cb%!9=0
3205 IF bp%+amount%>size%:PRINT"aborting":END
3206 IF bp%+amount%<0:PRINT"aborting":END
3210 X%=cb%:Y%=X% DIV &100:A%=4:CALL osgbpb%
3220 bp%=bp%+amount%
3230
3240 size_left%=size_left%-amount%
3260 fsize%=fsize%-amount%
3270 ENDPROC
3280 :
3290 DEFPROCsplit_it(split1%)
3300 IF split1% THEN PROCbput(type%):PROCbput(seq%):split%=FALSE
3310 IF NOT FNw_buffer(wbuff%):PRINT"Unable to ensure buffer":ERROR HERE
3312 PROCfs(dfile%)
3315 PROCrestore_disc
3316 seq%=seq%+1
3320 $string%="DFS":IF dfile%=adfs% THEN $string%="ADFS"
3330 REPEAT
3340 IF FNcommand("New "+$string%+" drive",FALSE) THEN UNTIL0
3350 IF dfile%=disc% THEN UNTIL INSTR("0123",$var%)
3360 IF dfile%=adfs% THEN UNTIL INSTR("0145AaBbEeFf",$var%)
3370 IF INSTR("AaBbEeFf",$var%) THEN T%=(ASC$var% AND &5F)-&11:$var%=CHR$T%
3380 IF dfile%=disc% THEN PRINT''"Please insert disc and press RETURN";:REPEAT:resp$=GET$:UNTILASCresp$=&0D:PRINT''
3390 d_drive%=VAL($var%)
3400 IF dfile%=adfs% THEN PROCoscli("DIR :"+$var%) ELSE PROCoscli("Dr. "+$var%)
3410 r%=FNgraber(init%):IF r% ELSE 3330
3415 PROCfs(net%)
3440 ENDPROC
3450 :
3460 DEFFNrange_dates
3480 IF(years%<sty%) OR (years%>edy%) THEN =TRUE
3490 IF years%=sty% IF (months%<stm% OR (months%=stm% AND days%<std%)) THEN =TRUE
3500 IF years%=edy% IF (months%>edm% OR (months%=edm% AND days%>edd%)) THEN =TRUE
3510 =FALSE
3530 :
3620 :
3630 DEFFNoffset
3640 LOCAL off%
3650 PROCoscli(".")
3660 IF FNcommand("First object to archive",TRUE) THEN 3660 ELSE $offname%=$var%
3670 IF $offname%="" OR $offname%="." THEN off%=FALSE ELSE off%=TRUE
3680 IF off% THEN $offname%=FNlcase($offname%)
3690 =off%
3700 :
3710 DEFFNlcase($string%)
3720 LOCAL chr%,X%
3730 FORX%=0 TO LEN($string%)-1
3740 chr%=string%?X%
3750 IF (chr%<ASC"A") OR (chr%>ASC"z") OR ((chr%>ASC"Z")AND(chr%<ASC"a")) THEN NEXT ELSE string%?X%=(chr% AND &5F):NEXT
3760 =$string%
3770 :
3780 DEFFNcompact
3790 LOCAL compact%:compact%=TRUE
3800 IF dfile%=disc% THEN =compact%
3810 PROCfs(adfs%)
3820 ?cb%=0:cb%!1=buffer%:cb%!5=&1000008:cb%?9=1:cb%?&A=0
3830 X%=cb%:Y%=X% DIV &100:A%=&72:CALL osword%
3840 IF buffer%?&FE=3 ELSE compact%=FALSE
3850 =compact%
3860 DEF FNr_sector(D%,S%,N%)
3870 =FNsector(&53)
3880 DEF FNw_sector(D%,S%,N%)
3890 =FNsector(&4B)
3900 DEF FNsector(W%)
3910 ?C%=D%:C%!1=buffer%:C%?5=3:C%?7=S%DIV10:C%?8=S% MOD 10:C%?9=&20+N%
3920 C%?6=W%
3930 A%=&7F:X%=C%:Y%=X% DIV &100:CALLosword%:IF C%?10 PRINT "Disc error ";~C%?10" Writing "N%" at "S%:=0
3940 =TRUE
3950
3960 DEF FNgraber(n%)
3965 IF FNexamine(init%,cb1%) THEN PRINT'$init%+" already exists.":=0
3970 grab%=(FNdfs_size(d_drive%)) AND &FFFF00
3975 IF grab%=0:=0
3976 h%=FNopen(n%,&80)
3977 IF dfile%=adfs%:adfshandle%=h%:GOTO4080
3980 IF h%<>0:CLOSE#h%:ELSE=0
3990 IF NOT FNr_sector(d_drive%,1,1):=0
4000 new_sin%=buffer%?&F+(buffer%?&E AND 3)*&100
4010 IF sin%<>new_sin%:PRINT "Please use a blank or compacted DFS disc":=0
4030 E%=buffer%?&E:E%=(E% AND &CF) OR ((grab% DIV &1000) AND &30)
4040 buffer%?&E=E%
4050 buffer%?&D=(grab% DIV &100)
4060 buffer%?&C=(grab% AND &FF)
4070 IF NOT FNw_sector(d_drive%,1,1):=0
4080 saved_size%=0
4090 bp%=0:fsin%=sin%
4100 =size_left%
4110
4120 DEF PROCrestore_disc
4122 PROCfs(dfile%)
4125 IF dfile%=adfs%:CLOSE#adfshandle%:ENDPROC
4130 IF sin%=0:ENDPROC
4140 IF NOT FNr_sector(d_drive%,1,1):ENDPROC
4150 new_sin%=buffer%?&F+(buffer%?&E AND 3)*&100
4160 IF new_sin%<>sin%:ENDPROC
4170 E%=buffer%?&E:E%=(E% AND &CF) OR ((saved_size% DIV &1000) AND &30)
4180 buffer%?&E=E%
4190 buffer%?&D=(saved_size% DIV &100)
4200 buffer%?&C=(saved_size% AND &FF)
4210 IF NOT FNw_sector(d_drive%,1,1):=0
4220 ENDPROC
4230
4240 DEF PROCbput(TA%)
4245 IF size%-bp%<>0 ELSE:IF FNw_buffer(wbuff%) ELSE PRINT"Unable to ensure buffer":ERROR
4250 wbuff%?bp%=TA%:bp%=bp%+1:ENDPROC
4260
4270 DEF FNw_buffer(buffer%)
4271 PROCfs(dfile%):IF dfile%=adfs%:PROCadwrite(buffer%,bp%):GOTO4291
4272 Q%=((bp%-1) DIV 256)+1:F%=fsin%
4277 REPEAT
4278 T%=10-(F% MOD 10)
4280 IF T%>Q% UNTIL 1:ELSE IF FNw_sector(d_drive%,F%,T%):Q%=Q%-T%:F%=F%+T%:buffer%=buffer%+&100*T%:UNTIL0:ELSE:UNTIL1:=0
4290 IF Q%=0:ELSE IF NOT FNw_sector(d_drive%,F%,Q%):=0
4291 fsin%=F%+Q%
4295 saved_size%=saved_size%+bp%
4296 PROCfs(net%)
4300 bp%=0
4310 =TRUE
4315
5000 DEF PROCadwrite(from%,amount%)
5010 ?cb%=adfshandle%:cb%!1=from%:cb%!5=amount%:cb%!9=0
5020 X%=cb%:Y%=X%DIV256:A%=2
5030 CALL osgbpb%
5040 ENDPROC