TrCopy63.src

10 REM > TreeCopy 1.63a 20-Oct-2018

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 REM v1.63 18-Jan-2018: Added experimental Update option.

230 REM v1.63a 20-Oct-2018: GBPB uses faster OPENUP if dest file suitable size.

240 :

250 MODE&87:HIMEM=FNhimem0:VDU23;2,53;0;0;0:A$=FNOS_GetEnv+" ":PRINT SPC13"TreeCopy 1.63a"'SPC13STRING$(14,"="):*FX1

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

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

280 REM Syntax: (fs:)src (fs:)dest ACEFPRSU (-dest) (-debug) (-quit (*)name)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

450 IF LENS$:IF LEND$:IF LEFT$(A$,1)="U":upd%=NOTI%

460 IF LENS$:IF LEND$:IF LEFT$(A$,1)="V":vb%=NOTI%

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

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

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

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

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

520 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."

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

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

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

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

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

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

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

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

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

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

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

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

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

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

670 IF FS2$="":FS2$=FS1$

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

690 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

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

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

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

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

740 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$

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

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

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

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

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

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

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

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

830 ::REM Remove use of FNpath/FNlibpath

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

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

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

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

880 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

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

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

910 REM Cur.Dir=D1$, src

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

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

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

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

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

970 :

980 DEFPROCq:IF dst%:PROCDest

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

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

1010 CHAIN Q$

1020 :

1030 ::REM DEFPROCend

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

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

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

1070 ::REM ENDPROC

1080 :

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

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

1110 :

1120 DEFFNerr

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

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

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

1160 IF ERR=198:IFNOTdst%:PROCSrc

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

1180 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

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

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

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

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

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

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

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

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

1270 :

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

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

1300 DEFPROCErrGBPB

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

1320 Z%=0:ENDPROC

1330 :

1340 REM Z% holds:

1350 REM 0 - reading files

1360 REM 1 - source file too big for buffer

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

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

1390 REM 3 - single file in buffer with upd% set

1400 REM 4 - writing files

1410 REM 8

1420 REM &00C - source selected in GBPB

1430 REM &10C - destination selected in GBPB

1440 :

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

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

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

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

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

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

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

1520 ENDPROC

1530 :

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

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

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

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

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

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

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

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

1620 ENDPROC

1630 :

1640 DEFPROCDoFile1

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

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

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

1680 PRINTD1$;:IFLEND1$:VDU46

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

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

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

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

1730 :

1740 DEFPROCDoFile2:type%=A%

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

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

1770 IF FNdiff:ENDPROC

1780 IF length%+2+LENfile$>maxlength%-48:F$=file$:T%=type%:Z%=1:ENDPROC

1790 :

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

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

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

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

1840 REM Should check no 'R'

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

1860 IF type%<>3:PROCpr ELSE length%=0

1870 IF type%=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

1880 REM Reset no 'R'

1890 ?Ptr%=type%:Ptr%=P%+length%:?Ptr%=0:IFupd%:Z%=3

1900 ENDPROC

1910 :

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

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

1940 :

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

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

1970 ENDPROC

1980 :

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

2000 IF LENFS2$:OSCLI FS2$

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

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

2030 ENDPROC

2040 :

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

2060 IF LENFS1$:OSCLI FS1$

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

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

2090 ENDPROC

2100 :

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

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

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

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

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

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

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

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

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

2200 :

2210 DEFPROCReadAttr:REM OSFILE 5 already called

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

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

2240 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

2250 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

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

2270 :

2280 DEFPROCSetAttr:IF fs2%<4:ENDPROC

2290 IF fs2%=8:OSCLI mnt2$

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

2310 A$=d2$+file$:IF file$="@":A$=LEFT$(A$,LENA$-2):REM Stamping dest dir before *DIR ^

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

2330 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

2340 IF fs2%<>5:ENDPROC

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

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

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

2380 :

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

2400 REM 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

2410 :

2420 REM Needs restructuring of main code to cope with dest name being changed

2430 REM Convert to dest name before storing in buffer?

2440 REM Dest dir will not always be at same point as source

2450 REM Doing one object at a time keeps directories synchronised

2460 :

2470 REM Info on source in load%/exec%/etc.

2480 DEFFNdiff:IF upd%=0 OR type%=2 OR file$="":=FALSE

2490 PROCDest:A%=FNinfo(d2$+file$):PROCSrc

2500 IF A%=type%:IF X%!2=load%:IF X%!6=exec%:IF X%!10=length%:=TRUE

2510 =FALSE

2520 REM PRINT'"Compare ";file$;" with ";d2$;file$

2530 REM PRINT;type%;" ";~load%;" ";~exec%;" ";~length%

2540 REM PRINT;A%;" ";~X%!2;" ";~X%!6;" ";~X%!10

2550 REM IF A%=type%:IF X%!2=load%:IF X%!6=exec%:IF X%!10=length%:PRINT"SAME":=TRUE

2560 REM PRINT"DIFF":=FALSE

2570 :

2580 DEFPROCCheck

2590 IF ex%ANDMID$(file$,2,1)="/":file$=LEFT$(file$,1)+"."+MID$(file$,3)

2600 IF fs1%=4:attr%=(attr%OR3)EOR(attr%DIV4)AND15:attr%=attr%OR((attr%AND7)*16)

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

2620 IF fs2%<>16:IF(attr%AND5)=5:attr%=attr%AND-5

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

2640 ENDPROC

2650 :

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

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

2680 ENDPROC

2690 :

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

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

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

2730 :

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

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

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

2770 IFFNdiff:ENDPROC

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

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

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

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

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

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

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

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

2860 IF(X%!10>length%)ORX%!10=0:c2%=OPENOUT(d$) ELSE c2%=OPENUP(d$):REM OPENUP faster if existing not too long

2870 IFc2%=0:PRINT'"No output available.":PROCSrc:ENDPROC

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

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

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

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

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

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

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

2950 :

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

2970 :

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

2990 ENDPROC

3000 :

3010 DEFFNinfo(F$):?X%=name%:X%?1=name%DIV256:$name%=F$:A%=5:=(USR&FFDD)AND&FF

3020 :

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

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

3050 DEFPROCpr:IF POS:PRINT

3060 ENDPROC

3070 :

3080 DEFFNyn:LOCAL A%

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

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

3110 :

3120 DEFFNyna(B%):LOCAL A%

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

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

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

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

3170 =TRUE

3180 :

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

3200 :

3210 REM REM Corrupt data area:

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

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

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

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

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

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

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

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

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

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

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

3330 REM DEFFNlibpath

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

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

3360 :

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

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

3390 :

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

3410 :

3420 DEFFNOS_GetEnv

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

3440 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$

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

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

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

3480 NEXT:=A$

3490 :

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

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

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

3530 REM ENDPROC

3540 :

3550 DEFFNhimem0:IFHIMEM=&B800 OR HIMEM>&FFFF:=HIMEM

3560 A%=130:IF((USR&FFF4)AND&FFFF00)=&FFFF00 OR ?&FFF7<>&6C:=HIMEM

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

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

3590 DEFFNhimem1:IFHIMEM<PAGE:=&F800 ELSE =HIMEM

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

3610 :