TrCopy62.src

10 REM > TreeCopy 1.62 08-Feb-2017

20 REM v1.52 23-May-2005: Does multiple files, reads params, memory bugfix

30 REM v1.55 15-Aug-2006: Added -?, fx1

40 REM v1.56 19-Nov-2006: *MOUNT on ADFS leaves files open

50 REM v1.57 15-Jan-2007: GetEnv works on ARM CoPro

60 REM v1.58 29-Jun-2009: Patched for DFS-like non-DFS systems

70 REM v1.59 25-Jan-2012: Full dates copied, relocates above BASIC on 65-Tube

80 REM prepends "@." on reading, dest set to WR/wr before openout

90 REM metadata set on directory after *dir ^ if "@" exists

100 REM v1.59a 02-Mar-2014: Creating dir displays "CDir ..."

110 REM v1.59b 09-Mar-2015: Writing to NetFS: directories only have attrs set

120 REM v1.59c 20-Jun-2015: Fixed reading SJ dates and checking for non-SJ

130 REM v1.59d 05-Feb-2016: X%/Y% restored after error handler

140 REM v1.60 05-Feb-2016: (F)orce option, Overwrite Y/N/A, -debug option

150 REM GBPB unlocks destination file

160 REM v1.60a 10-Feb-2016: Disk full aborts, all,sub,ex options work.

170 REM Bug: PROCGBPB Skip/Abort doesn't work. CLOSE# tried to close closed file.

180 REM v1.60b 12-Feb-2016: PROCGBPB unlocks DFS files. GBPB Skip/Abort CLOSE only closes dest file.

190 REM v1.61 12-Feb-2016: Remove FNpath/FNlibpath usage. Experiment: single-file copying.

200 REM v1.61a 22-Jun-2016: Fix reading access from DFS, writing to non-HADFS

210 REM v1.62 08-Feb-2017: Bugfix for running on ARM BASIC 1.00 with no SYS command.

220 :

230 MODE&87:HIMEM=FNhimem0:VDU23;2,53;0;0;0:A$=FNOS_GetEnv+" ":PRINT SPC13"TreeCopy 1.62"'SPC13STRING$(13,"="):*FX1

240 REM P."PAGE=&";~PAGE;" LOMEM=&";~LOMEM;" HIMEM=&";~HIMEM

250 DIM ctrl% 31,name% 127:X%=ctrl%:Y%=X%DIV256:ON ERROR REPORT:PRINT:Q$=CHR$13:HIMEM=FNhimem2:END

260 REM Syntax: (fs:)src (fs:)dest ACEFPRS (-dest) (-debug) (-quit (*)name)

270 Q$="":S$="":D$="":pa%=1:cf%=1:rc%=1:ex%=1:fc%=1:all%=1:sub%=1:dst%=FALSE:dbg%=FALSE

280 REM P.">"A$"<"

290 IFLENA$>1:pa%=FALSE:cf%=FALSE:rc%=TRUE:fc%=FALSE:ex%=FALSE:all%=FALSE:sub%=TRUE

300 REPEAT I%=0:IF LEFT$(A$,6)="-quit ":Q$=MID$(A$,7,LEN A$-7):A$=""

310 IF LEFT$(A$,2)="-d":dst%=TRUE:A$=MID$(A$,INSTR(A$," ")+1)

320 IF LEFT$(A$,4)="-deb":dbg%=TRUE:A$=MID$(A$,INSTR(A$," ")+1)

330 IF LENA$:IF S$="" AND LEFT$(A$,1)<>"-":I%=INSTR(A$+" "," "):S$=LEFT$(A$,I%-1):A$=MID$(A$,I%)

340 IF LENA$:IF D$="" AND LEFT$(A$,1)<>"-":I%=INSTR(A$+" "," "):D$=LEFT$(A$,I%-1):A$=MID$(A$,I%)

350 IF LENS$:IF LEND$:I%=LEFT$(A$,1)="~":IF I%:A$=MID$(A$,2)

360 IF LENS$:IF LEND$:IF LEFT$(A$,1)="A":all%=NOTI%

370 IF LENS$:IF LEND$:IF LEFT$(A$,1)="C":cf%=NOTI%

380 IF LENS$:IF LEND$:IF LEFT$(A$,1)="E":ex%=NOTI%

390 IF LENS$:IF LEND$:IF LEFT$(A$,1)="F":fc%=NOTI%

400 IF LENS$:IF LEND$:IF LEFT$(A$,1)="P":pa%=NOTI%

410 IF LENS$:IF LEND$:IF LEFT$(A$,1)="R":rc%=NOTI%

420 IF LENS$:IF LEND$:IF LEFT$(A$,1)="S":sub%=NOTI%

430 IF A$="-? ":UNTILTRUE:PRINT"Syntax: TreeCopy (fs:)src (fs:)dest"'" ACEFPRS (-dest) (-quit (*)name)":PROCq

440 A$=MID$(A$,2):REM IF INSTR(" ACDEFPRSU",LEFT$(A$,1)):A$=MID$(A$,2)

450 UNTIL A$="":maxlength%=((HIMEM-LOMEM-2200)AND-256)+2560*(dbg%ORHIMEM>&FFFF):DIM data% maxlength%

460 REM maxlength%=maxlength%-256:REM Bugfix

470 end%=data%+maxlength%:PRINTSPC10"Buffer length: &";~maxlength%

480 IFLENS$=0:PRINT'"Caution - This program does not check"'"for circular pathnames - Eg Copying"'"$.FRED into $.FRED.JIM will repeatedly"'"create $.FRED.JIM.JIM...etc."

490 IF LENS$:I%=INSTR(S$,":"):IF I%>1:FS1$=LEFT$(S$,I%-1):D1$=MID$(S$,I%+1)

500 ON ERROR REPORT:PRINT:IF INKEY-1:Q$=CHR$13:HIMEM=FNhimem2:END ELSE OSCLI"FX1,"+STR$ERR:PROCq

510 IF LENS$:IF I%<2:FS1$="":D1$=S$

520 IF S$="":PRINT:FS1$=FNinp("Source filing system: "):OSCLI FS1$:D1$=FNinp("Source dir: ") ELSE OSCLI FS1$

530 fs1%=FNfs:at$=LEFT$("@.",FNinfo("@")=2):up%=FNinfo("^")=2:IF FNinfo("$")<>2:fs1%=4

540 REM IF fs1%=4:type%=(FNinfo(D1$+".$")):type%=2 ELSE type%=FNinfo(D1$)

550 IF fs1%=4:IFASCD1$=58:IFLEND1$=2:type%=(FNinfo(D1$+".$")) ELSE type%=FNinfo(D1$)

560 one%=type%=1:IF type%=0:IFfs1%>4:PRINT D1$" does not exist.":PROCq

570 REM IF type%=0:PRINT D1$" does not exist.":PROCq

580 REM IF type%<>2:PRINT D1$" is not a directory.":PROCq

590 IF pa%>0:PRINT'"Pause to change disks";:pa%=FNyn

600 IF LEND$:I%=INSTR(D$,":"):IF I%>1:FS2$=LEFT$(D$,I%-1):d$=MID$(D$,I%+1)

610 IF LEND$:IF I%<2:FS2$="":d$=D$

620 IF D$="":PRINT':FS2$=FNinp("Dest. filing system: "):d$=FNinp("Dest. dir: ")

630 IF FS2$="":FS2$=FS1$

640 mnt1$="":mnt2$="":d2$="":PROCDest:fs2%=FNfs:d2$=d$

650 IF fs2%>4 AND INSTR(d2$,"$")+INSTR(d2$,"%")+INSTR(d2$,"&")+INSTR(d2$,":")+INSTR(d2$,"@")=0:PRINT"Dest. dir must be an absolute pathname, must contain one of $,%,&,@ or :":PROCq

660 IF fs1%<>fs2%:IFASCD1$=58:IFASCMID$(D1$,3)=46:IFLEFT$(D1$,3)=LEFT$(d2$,3):pa%=TRUE

670 IF fs1%=fs2%:FS1$="":FS2$=""

680 IF fs1%<>fs2% AND fs1%=8:mnt1$="Mount"

690 IF fs1%<>fs2% AND fs2%=8:mnt2$="Mount"

700 IF fs1%=fs2% AND pa% AND (fs1%=8 OR fs1%=16):mnt1$="Mount "+FNdrv:mnt2$=mnt1$:OSCLI mnt2$:IF LEFT$(D1$,1)<>"$" ANDLEFT$(D1$,1)<>":":D1$="$."+D1$

710 IF fs2%>4:IFNOTone%:PROCcd(d2$) ELSE IFfs2%=4:*DIR$

720 IF cf%>0:PROCpr:PRINT"Confirm";:cf%=FNyn:PRINT

730 IF rc%>0:rc%=FALSE:IF fs1%>4 PRINT"Recurse";:rc%=FNyn:PRINT

740 IF fc%>0:PRINT"Force overwriting";:fc%=FNyn:PRINT

750 IF fs1%=5:mask%=&FFFFFF3B ELSE mask%=TRUE

760 IF ex%>0:ex%=FALSE:IF fs2%=4 PRINT"Expand into DFS dirs";:ex%=FNyn:PRINT

770 IF ex%ANDRIGHT$(d2$,2)=".$":d2$=LEFT$(d2$,LEN d2$-2)

780 dcd%=FALSE:dest$=d2$+".":ddir$="":dpfx$=""

790 ::REM Remove use of FNpath/FNlibpath

800 ::REM IF fs1%<>fs2%:IF FNinfo("^")=2:ddir$="DIR ":dest$="":oldpath$=FNpath

810 ::REM IF fs1%=fs2% ANDfs1%>4 ANDup% AND NOTpa%:IF FNinfo("%")=2:ddir$="LIB ":dpfx$="%.":dest$="%.":oldpath$=FNlibpath

820 ::REM IF LENddir$:OSCLI ddir$+d2$

830 PROCSrc:olddir$="":::REM IF up%:olddir$=FNpath

840 IFall%>0:all%=FALSE:IF FNfs=4:PRINT"Do all DFS dirs";:all%=FNyn:PRINT:IF all%:IFsub%>1:PRINT"Put in subdirs";:sub%=FNyn:PRINT

850 IF sub%:sub$="." ELSE sub$="/"

860 IFNOTone%:PRINT'"Dir. ";D1$:OSCLI"DIR "+D1$:d2$=d2$+"."

870 REM Cur.Dir=D1$, src

880 out$="":Z%=0:Ptr%=data%:done%=FALSE:?Ptr%=0:F$="":index%=0:level%=0:dir%=33:IF all%:*DIR !

890 ON ERROR IF FNerr:OSCLI"FX1,"+STR$ERR:PROCq

900 X%=ctrl%:Y%=X%DIV256:IFone%:PROCrd:F$=D1$:out$=d2$:PROCGBPB:PROCq

910 ::REM REPEAT PROCDo:UNTIL done% AND Z%=0:PROCend:PRINT:PROCq

920 REPEAT PROCDo:UNTIL done% AND Z%=0:PRINT:PROCq

930 :

940 DEFPROCq:IF dst%:PROCDest

950 HIMEM=FNhimem2:IF Q$="":Q$=CHR$13:END

960 IF LEFT$(Q$,1)="*":OSCLI Q$:Q$=CHR$13:END

970 CHAIN Q$

980 :

990 ::REM DEFPROCend

1000 ::REM IF LENddir$:PROCDest:OSCLI ddir$+oldpath$

1010 ::REM IF FNfs<>fs1%:PROCSrc

1020 ::REM IF LENolddir$:OSCLI"DIR "+olddir$

1030 ::REM ENDPROC

1040 :

1050 DEFFNinp(A$):REPEAT PRINT A$;:INPUT LINE""B$:IF LEFT$(B$,1)="*":OSCLI B$

1060 UNTIL LEFT$(B$,1)<>"*":=B$

1070 :

1080 DEFFNerr

1090 IF ERR=195:IF(Z%AND&C)=4:IFfc%:OSCLI"ACCESS "+d$:=FALSE

1100 PROCpr:VDU11:REPORT:IF ERR<128:PRINT:=TRUE

1110 IF ERR=198:IF(Z%AND12)=12:CLOSE#c2%

1120 IF ERR=198:IFNOTdst%:PROCSrc

1130 IF ERR=198:PRINT:=TRUE:REM Disk full

1140 IF ERR=195 AND(Z%AND&C)=4:PRINT". Overwrite";:IFNOTFNyna(1):Ptr%=P%+length%:=FALSE ELSE IF ERR=195 AND(Z%AND&C)=4:OSCLI"ACCESS "+d$:PRINT:=FALSE

1150 IF ERR<128:IFERR<>17:PRINT" at line ";ERL;

1160 PRINT". Skip";:sk%=FNyn:IF sk% AND Z%=0:PRINT

1170 IF Z%=0 AND NOTsk%:F$=file$:T%=A%:=FALSE

1180 IF(Z%AND&C)=4:PRINT:IF sk%:Ptr%=P%+length%:=FALSE

1190 IF(Z%AND&C)=12 ANDsk%:PRINT:Ptr%=data%:?Ptr%=0:F$="":PROCErrGBPB

1200 REM IF(Z%AND&C)=12:PRINT"d$:"d$'"in$:"in$'"file$:"file$

1210 REM PRINT"Type: ";T%;" File: ";file$'"Operation: ";Z%

1220 F$="":=ERR<128 OR INKEY-1

1230 :

1240 REM Note! Has to do different things if source or dest causes an error

1250 REM Handle will only be open on the selected filing system

1260 DEFPROCErrGBPB

1270 IF(Z%AND&100):CLOSE#c2%:PROCSrc ELSE CLOSE#c1%

1280 Z%=0:ENDPROC

1290 :

1300 REM Z% holds:

1310 REM 0 - reading files

1320 REM 1 - source file too big for buffer

1330 REM 2 - buffer full, adding source file will go past end of buffer

1340 REM 2 - buffer full, adding source file has filled buffer

1350 REM 4 - writing files

1360 REM 8

1370 REM &00C - source selected in GBPB

1380 REM &10C - destination selected in GBPB

1390 :

1400 DEFPROCDo:IF Z%=0:PROCRead:ENDPROC

1410 IF(Z%AND&C)=0 AND ?data%=0:Z%=Z%+12

1420 IF(Z%AND&C)=0:PRINT:PROCwr:Z%=Z%+4:Ptr%=data%:PRINT

1430 IF(Z%AND&C)=4:PROCWrite:IF Z%<8:ENDPROC

1440 IF(Z%AND&C)=8:PROCrd:Z%=Z%+4:Ptr%=data%:IF NOTpa%:PRINT

1450 IF(Z%AND3)<>1:Z%=0:?Ptr%=0:ENDPROC

1460 IF(Z%AND&C)=12:PROCGBPB:Z%=0:F$="":Ptr%=data%:?Ptr%=0

1470 ENDPROC

1480 :

1490 DEFPROCRead:IF LENF$:file$=F$:A%=FNinfo(at$+file$):F$="":PROCDoFile2:ENDPROC

1500 REPEAT:X%!1=name%:X%!5=1:X%!9=index%:A%=8:CALL &FFD1

1510 ret%=X%!5:index%=X%!9:IF ret%=0:PROCDoFile1

1520 UNTIL ret%<>0 OR Z%<>0:IF ret%=0:ENDPROC

1530 IF NOTall%:A%=3:file$="":X%!10=0:PROCDoFile2:ENDPROC

1540 index%=0:dir%=dir%+1:IF dir%=34 OR dir%=ASC":" OR dir%=ASC"*" OR dir%=ASC"|":dir%=dir%+1

1550 IF dir%=ASC"a":dir%=ASC"{"

1560 IF dir%<127:OSCLI"DIR "+CHR$dir% ELSE A%=3:file$="":X%!10=0:PROCDoFile2:*DIR $

1570 ENDPROC

1580 :

1590 DEFPROCDoFile1

1600 ?(name%+?name%+1)=13:file$=$(name%+1)+" ":file$=LEFT$(file$,INSTR(file$," ")-1):IFASCfile$=46:ENDPROC

1610 A%=FNinfo(at$+file$):IF A%=2 ANDNOTrc%:ENDPROC

1620 PROCpr:IFA%=2:PRINT"Dir. "; ELSE PRINT"File ";

1630 PRINTD1$;:IFLEND1$:VDU46

1640 IF all% ANDdir%<>ASC"$":VDU dir%,46

1650 PRINT file$;:REM IF A%<1 OR A%>3:PRINT" not loadable":ENDPROC

1660 IF cf%:IF NOTFNyna(0):PRINT:ENDPROC

1670 A%=((A%-1)AND1)+1:PROCDoFile2:ENDPROC

1680 :

1690 DEFPROCDoFile2:type%=A%

1700 IF X%!10+2+LENfile$>maxlength%-48:F$=file$:T%=A%:Z%=1:ENDPROC

1710 REM P.">DoFile2:";file$;":";type%

1720 IFtype%<>3:PROCReadAttr ELSE IF LENat$:A%=FNinfo("@"):PROCReadAttr:length%=0 ELSE length%=0

1730 REM PROCpr:P.~!0 AND &FFFF;" ";~!2 AND &FFFF;" ";~!4 AND &FFFF;" ";~!6 AND &FFFF

1740 $(Ptr%+1)=FNin(file$):P%=Ptr%+2+LEN$(Ptr%+1):IF P%+length%+48>end%:F$=file$:T%=type%:Z%=2:ENDPROC

1750 IF type%=3 AND end%=data%+maxlength%:done%=TRUE:Z%=2:VDU11:ENDPROC

1760 IF type%=3:PROCDirUp:index%=!end%:end%=end%+4:level%=level%-1

1770 REM Should check no 'R'

1780 !P%=load%:P%!4=exec%:P%!8=length%:P%!12=attr%:P%!15=mtime%:P%!18=cdate%:P%!20=ctime%:P%=P%+24

1790 IFtype%<>3:PROCpr ELSE length%=0

1800 IFtype%=1:OSCLI"LOAD "+at$+file$+" "+STR$~P% ELSE IF type%=2:OSCLI"DIR "+file$:end%=end%-4:!end%=index%:index%=0:D1$=D1$+"."+file$:level%=level%+1

1810 REM Reset no 'R'

1820 ?Ptr%=type%:Ptr%=P%+length%:?Ptr%=0:ENDPROC

1830 :

1840 DEFFNin(F$):IF fs1%>4:=F$

1850 IF all% ANDdir%<>ASC"$":=CHR$dir%+sub$+F$ ELSE:=F$

1860 :

1870 DEFPROCDirUp:REPEAT:D1$=LEFT$(D1$,LEN D1$-1):UNTIL RIGHT$(D1$,1)=".":D1$=LEFT$(D1$,LEN D1$-1)

1880 IF up%:OSCLI"DIR ^" ELSE OSCLI"DIR "+D1$

1890 ENDPROC

1900 :

1910 DEFPROCDest:IF pa% PROCpr:PRINT"Insert dest. and press SPACE";:REPEAT UNTIL GET<65:PRINT

1920 IF LENFS2$:OSCLI FS2$

1930 IF LENmnt2$:OSCLI mnt2$:IF LENd2$:IFNOTone%:OSCLI"DIR "+LEFT$(d2$,LEN d2$-1)

1940 IF(mnt2$<>"" AND d2$<>"")OR(FS1$+FS2$="" AND NOTup%):IFNOTone%:OSCLI"DIR "+LEFT$(d2$,LEN d2$-1)

1950 ENDPROC

1960 :

1970 DEFPROCSrc:IF pa%:PROCpr:PRINT"Insert source and press SPACE";:REPEAT UNTIL GET<65:PRINT

1980 IF LENFS1$:OSCLI FS1$

1990 IF LENmnt1$:OSCLI mnt1$:IFNOTone%:OSCLI"DIR "+D1$

2000 IF mnt1$<>"" OR (FS1$+FS2$="" AND NOTup%):IFNOTone%:OSCLI"DIR "+D1$

2010 ENDPROC

2020 :

2030 DEFPROCWrite:IF?Ptr%=0:Z%=Z%+4:ENDPROC

2040 REM P.">Write:";?Ptr%;" ";~!Ptr%;"<"

2050 A%=?Ptr%:file$=$(Ptr%+1):P%=Ptr%+2+LENfile$

2060 REM P.;~P%!0;" ";~P%!4;" ";~P%!8;" ";~P%!12;" ";~P%!15;" ";~P%!18;" ";~P%!20

2070 load%=!P%:exec%=P%!4:length%=P%!8:attr%=P%!12:mtime%=P%!15:cdate%=P%!18:ctime%=P%!20:P%=P%+24

2080 IF A%=3:file$="@":PROCSetAttr:PROCDUp:Ptr%=P%:ENDPROC

2090 IF A%=2:PROCDDir:Ptr%=P%:ENDPROC

2100 PROCCheck:PRINT "Save ";d2$;file$;:IF dpfx$="":d$=d2$+file$ ELSE d$=dpfx$+file$

2110 OSCLI"SAVE "+d$+" "+STR$~P%+"+"+STR$~length%+" "+STR$~exec%+" "+STR$~load%:A%=1:PROCSetAttr:Ptr%=P%+length%:PRINT:ENDPROC

2120 :

2130 DEFPROCReadAttr:REM OSFILE 5 already called

2140 REM PRINT"file$=>"file$"<"

2150 load%=X%!2:exec%=X%!6:length%=X%!10 AND (A%=1):X%!17=0:X%!20=X%!15

2160 IF fs1%=5:$(name%+8)=file$:PROCoswD(&14,&12000A00+256*LENfile$,&40000000):IF name%?3=0:X%!15=name%!10:X%!17=name%!12:X%!20=name%!5:X%!22=name%!7:REM SJ dates

2170 attr%=X%!14:IF fs1%=16:!X%=name%:$name%=LEFT$(at$,2+(file$=""))+file$:A%=&FD:CALL &FFDD:X%!17=X%!6:X%!21=X%!10:REM HADFS dates

2180 mtime%=X%!17:cdate%=X%!20:ctime%=X%!22:ENDPROC

2190 :

2200 DEFPROCSetAttr:IF fs2%<4:ENDPROC

2210 IF fs2%=8:OSCLI mnt2$

2220 REM IF ddir$="":A$=d2$+file$ ELSE IF LENdpfx$:A$=dpfx$+file$ ELSE A$=at$+file$

2230 A$=d2$+file$

2240 $name%=A$:!X%=name%:X%!2=load%:X%!6=exec%:X%!14=attr%ANDmask%:A%=1+3*(A%<>1)*(fs2%=5):CALL &FFDD

2250 IF fs2%=16:A%=&FD:CALL &FFDD:X%!6=mtime%:X%!9=cdate%:X%!11=ctime%:A%=&FC:CALL &FFDD:ENDPROC:REM HADFS dates, keeping account numbers

2260 IF fs2%<>5:ENDPROC

2270 IF fs1%<>16 AND fs1%<>5:ENDPROC

2280 $(name%+10)=A$:name%!7=attr%:name%?10=?name%:PROCoswD(&14,&13000C00+256*LEN$(name%+10),&05000000):REM Write Acorn mdate/SJ cdate

2290 attr%=(attr%AND&FFFF00)DIV256:$(name%+18)=A$:name%!8=cdate%:name%!10=ctime%:name%!14=(mtime%AND&FFFFFF)*256:name%?13=attr%:name%?14=attr%DIV256:PROCoswD(&14,&13001400+256*LEN$(name%+18),&40000000):ENDPROC:REM Write SJ full dates

2300 :

2310 DEFPROCCheck

2320 IFex%ANDMID$(file$,2,1)="/":file$=LEFT$(file$,1)+"."+MID$(file$,3)

2330 IFfs1%=4:attr%=(attr%OR3)EOR(attr%DIV4)AND15:attr%=attr%OR((attr%AND7)*16)

2340 IFfs2%=4:file$=LEFT$(file$,7-2*(MID$(file$,2,1)=".")):attr%=attr%AND8

2350 IFfs2%<>16:IF(attr%AND5)=5:attr%=attr%AND-5

2360 IF all%ANDsub%ANDdcd%<>ASCfile$ANDMID$(file$,2,1)=".":PROCcd(d2$+LEFT$(file$,1)):dcd%=ASCfile$

2370 ENDPROC

2380 :

2390 DEFPROCDUp:REPEAT d2$=LEFT$(d2$,LEN d2$-1):UNTIL RIGHT$(d2$,1)="."

2400 REM IF LENddir$:OSCLI ddir$+dpfx$+"^":REM ELSE OSCLI"DIR "+LEFT$(d2$,LENd2$-1)

2410 ENDPROC

2420 :

2430 DEFPROCDDir:PRINT"CDir ";:IF dpfx$="":PRINTd2$;file$;:PROCcd(d2$+file$) ELSE PRINTdpfx$;file$;:PROCcd(dpfx$+file$)

2440 A%=2:PROCSetAttr:d2$=d2$+file$:REM IF LENddir$:OSCLI ddir$+dpfx$+file$:REM ELSE OSCLI"DIR "+d2$

2450 d2$=d2$+".":PRINT:ENDPROC

2460 :

2470 DEFPROCGBPB:file$=FNin(F$):in$=F$:REM IFdbg%:PRINT">GBPB";

2480 A%=FNinfo(at$+in$):max%=(end%-data%-48)AND&FFFF00:IFmax%>X%!10:max%=X%!10DIV2

2490 PROCReadAttr:IFLENout$:d2$=out$:file$="":dpfx$=""

2500 c2%=0:c1%=OPENIN(at$+in$):IF c1%=0:PRINT"No input available.":ENDPROC

2510 PROCgbpb(4,c1%,max%):CLOSE#c1%:PROCwr:Z%=Z%OR&100:PROCCheck:IF dpfx$="":d$=d2$ ELSE d$=dpfx$

2520 PRINT'"Copy ";d2$;file$;:d$=d$+file$:$name%=d$:!X%=name%

2530 A%=5:A%=(USR&FFDD)AND&FF:IFfc%=0:IFA%:IF(X%?14)AND8:PRINT'"Entry locked. Overwrite";:IFNOTFNyna(1):ENDPROC

2540 IFA%:X%!14=(fs2%>4)AND&33:A%=4:CALL&FFDD :REM Unlock destination file

2550 X%!2=load%:X%!6=exec%:X%!10=0:X%!14=length%:IFX%?17:X%!14=&400000

2560 A%=7:CALL&FFDD :REM Create empty destination file

2570 X%?14=(fs2%>4)AND&33:A%=4:CALL&FFDD :REM Ensure access is WR/wr

2580 c2%=OPENOUT(d$):IF c2%=0:PRINT'"No output available.":PROCSrc:ENDPROC

2590 PROCgbpb(2,c2%,max%):ptr%=max%:b%=max%:PRINT:CLOSE#c2%

2600 REPEAT:PROCrd:Z%=Z%AND&FF:c1%=OPENIN(in$):PTR#c1%=ptr%

2610 IF ptr%+max%>length%:b%=length%-ptr%

2620 PROCgbpb(4,c1%,b%):CLOSE#c1%:PRINT:PROCwr:Z%=Z%OR&100:c2%=OPENUP(d$):PTR#c2%=ptr%

2630 PROCgbpb(2,c2%,b%):PRINT:ptr%=PTR#c2%:CLOSE#c2%

2640 UNTIL ptr%>=length%:A%=1:PROCSetAttr

2650 PROCrd:Z%=Z%AND&FF:PRINT:ENDPROC

2660 :

2670 DEFPROCgbpb(A%,c%,b%):?X%=c%:X%!1=data%:X%!5=b%:CALL &FFD1:ENDPROC

2680 :

2690 DEFPROCcd(F$):IF FNfs>4:IF FNinfo("$")=2:IF FNinfo(F$)<>2:OSCLI"CDIR "+F$:REM +LEFT$(" 255",fs2%=5)

2700 ENDPROC

2710 :

2720 DEFFNinfo(F$):!X%=name%:$name%=F$:A%=5:=(USR&FFDD)AND&FF

2730 :

2740 DEFPROCrd:PROCSrc:PROCpr:PRINT"Reading...";:ENDPROC

2750 DEFPROCwr:PROCDest:PROCpr:PRINT"Writing...";:ENDPROC

2760 DEFPROCpr:IF POS:PRINT

2770 ENDPROC

2780 :

2790 DEFFNyn:LOCAL A%

2800 PRINT"? (Y/N)";:REPEAT:A%=GET AND&DF:UNTIL A%=89 ORA%=78

2810 PRINT STRING$(5,CHR$8);:IF A%=89:PRINT"Yes ";:=TRUE ELSE PRINT"No ";:=FALSE

2820 :

2830 DEFFNyna(B%):LOCAL A%

2840 REM IFB%=1:IFfc%=0:=0 ELSE IFB%=3:IFsk%=0:=0

2850 PRINT"? (Y/N/A)";:REPEAT:A%=GET AND&DF:UNTIL A%=89 ORA%=78 ORA%=65

2860 PRINT STRING$(7,CHR$127);:IF A%=89:PRINT"Yes ";:=TRUE ELSE IF A%=78:PRINT"No ";:=FALSE

2870 PRINT"All ";:IF B%=0:cf%=FALSE ELSE IF B%=1:fc%=TRUE ELSE IF B%=3:sk%=TRUE

2880 =TRUE

2890 :

2900 DEFFNfs:LOCAL A%,E%,Y%:=(USR&FFDA)AND&FF

2910 :

2920 REM REM Corrupt data area:

2930 REM DEFFNpath:LOCAL A%,n$,p$:A%=FNinfo("@"):REM Bugfix

2940 REM A%=6:REPEAT:X%!1=data%:CALL &FFD1

2950 REM ?(data%+2+?data%+?(data%+?data%+1))=13

2960 REM n$=$(data%+2+?data%):OSCLI"DIR ^"

2970 REM n$=LEFT$(n$,INSTR(n$+" "," ")-1)

2980 REM p$=n$+"."+p$:UNTIL n$="$"ORn$="&"

2990 REM p$=LEFT$(p$,LEN p$-1)

3000 REM OSCLI"DIR "+p$:X%!1=data%:CALL &FFD1

3010 REM ?(data%+1+?data%)=13:n$=$(data%+1)

3020 REM IF LENn$:=":"+n$+"."+p$

3030 REM X%!1=data%:A%=5:CALL &FFD1:?(data%+1+?data%)=13:n$=$(data%+1):n$=LEFT$(n$,INSTR(n$+" "," ")-1):=":"+n$+"."+p$

3040 REM DEFFNlibpath

3050 REM LOCAL a$,b$:a$=FNpath:OSCLI"DIR %"

3060 REM b$=FNpath:OSCLI"DIR "+a$:=b$

3070 :

3080 DEFFNdrv:A%=6:X%!1=data%:CALL &FFD1

3090 ?(data%+1+?data%)=13:=$(data%+1)

3100 :

3110 DEFPROCoswD(A%,D%,E%):LOCAL X%,Y%:X%=name%:Y%=X%DIV256:!X%=D%:X%!4=E%:CALL&FFF1:ENDPROC

3120 :

3130 DEFFNOS_GetEnv

3140 A%=(HIMEM>&FFFF)AND&900:A%=((PAGE>&9FFF)ANDA%)OR((&1400-PAGE)AND(A%=0)):IF?(TOP-3)ELSEA%=&B00

3150 A$=$(PAGE-&E00+A%):IFA%=0:run$=A$:SYS16TOA$,,A%:SYS72,"",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):IFLENA$=0:A$=run$

3160 FORY%=-1TO0:A$=" "+A$:REPEATA$=MID$(A$,2):UNTILASCA$<>32

3170 IFY%:IFASCA$=34:A%=INSTR(A$,"""",2)+1 ELSE IFY%:A%=INSTR(A$+" "," ")

3180 IFY%:run$=MID$(A$,1-(ASCA$=34),A%-1+2*(ASCA$=34)):IFrun$<>"":A$=MID$(A$,A%+1)

3190 NEXT:=A$

3200 :

3210 REM DEFPROCadfs:B$="":IFA$="":ENDPROC

3220 REM FORA%=1TOLENA$:B%=ASCMID$(A$,A%,1):B$=B$+CHR$(B%AND((B%<64)OR&DF)):NEXT

3230 REM IFB$="A."ORB$="AD."ORB$="ADF."ORB$="ADFS":A$="FADFS"

3240 REM ENDPROC

3250 :

3260 DEFFNhimem0:A%=130:IF((USR&FFF4)AND&FFFF00)=&FFFF00:=HIMEM

3270 IF?&FFF7<>&6C:=HIMEM

3280 IFPAGE=&C000:LOMEM=&800:=&8000

3290 FORA%=0TOTOP-PAGE+3STEP4:A%!&C000=A%!PAGE:NEXT:PAGE=&C000:HIMEM=&F800:RUN

3300 DEFFNhimem2:IFHIMEM<PAGE:PAGE=&800:?&801=-1:=HIMEM ELSE =HIMEM