TrCopy61.src

10 REM > TrCopy61/s 1.61b 22-Mar-2016

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# doesn't do ch%=0.

180 REM v1.60b 12-Feb-2016: PROCGBPB unlocks DFS files. Error 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 :

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

620 IF FS2$="":FS2$=FS1$

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

640 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

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

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

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

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

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

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

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

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

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

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

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

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

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

780 ::REM Remove use of FNpath/FNlibpath

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

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

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

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

830 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

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

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

860 REM Cur.Dir=D1$, src

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

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

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

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

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

920 :

930 DEFPROCq:IF dst%:PROCDest

940 HIMEM=FNhimem1:IF Q$="":Q$=CHR$13:END

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

960 CHAIN Q$

970 :

980 ::REM DEFPROCend

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

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

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

1020 ::REM ENDPROC

1030 :

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

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

1060 :

1070 DEFFNerr

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

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

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

1110 IF ERR=198:IFNOTdst%:PROCSrc

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

1130 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

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

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

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

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

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

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

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

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

1220 :

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

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

1250 DEFPROCErrGBPB

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

1270 Z%=0:ENDPROC

1280 :

1290 REM Z% holds:

1300 REM 0 - reading files

1310 REM 1 - source file too big for buffer

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

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

1340 REM 4 - writing files

1350 REM 8

1360 REM &00C - source selected in GBPB

1370 REM &10C - destination selected in GBPB

1380 :

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

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

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

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

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

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

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

1460 ENDPROC

1470 :

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

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

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

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

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

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

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

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

1560 ENDPROC

1570 :

1580 DEFPROCDoFile1

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

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

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

1620 PRINTD1$;:IFLEND1$:VDU46

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

1640 PRINT file$;:IF cf%:IF NOTFNyna(0):PRINT:ENDPROC

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

1660 :

1670 DEFPROCDoFile2:type%=A%

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

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

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

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

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

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

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

1750 REM Should check no 'R'

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

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

1780 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

1790 REM Reset no 'R'

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

1810 :

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

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

1840 :

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

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

1870 ENDPROC

1880 :

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

1900 IF LENFS2$:OSCLI FS2$

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

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

1930 ENDPROC

1940 :

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

1960 IF LENFS1$:OSCLI FS1$

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

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

1990 ENDPROC

2000 :

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

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

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

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

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

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

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

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

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

2100 :

2110 DEFPROCReadAttr:REM OSFILE 5 already called

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

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

2140 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

2150 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

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

2170 :

2180 DEFPROCSetAttr:IF fs2%<4:ENDPROC

2190 IF fs2%=8:OSCLI mnt2$

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

2210 IF file$<>"@":A$=d2$+file$ ELSE A$=LEFT$(d2$,LENd2$-1):IF d2$="":ENDPROC

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

2230 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

2240 IF fs2%<>5:ENDPROC

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

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

2270 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

2280 :

2290 DEFPROCCheck

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

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

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

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

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

2350 ENDPROC

2360 :

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

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

2390 ENDPROC

2400 :

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

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

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

2440 :

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

2640 :

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

2660 :

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

2680 ENDPROC

2690 :

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

2710 :

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

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

2740 DEFPROCpr:IF POS>0:PRINT

2750 ENDPROC

2760 :

2770 DEFFNyn:LOCAL A%

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

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

2800 :

2810 DEFFNyna(B%):LOCAL A%

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

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

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

2850 =TRUE

2860 :

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

2880 :

2890 REM REM Corrupt data area:

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

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

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

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

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

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

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

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

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

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

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

3010 REM DEFFNlibpath

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

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

3040 :

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

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

3070 :

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

3090 :

3100 DEFFNOS_GetEnv:IFHIMEM>&FFFF:run$=$&8100:SYS16TOA$,,A%:SYS72,"",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):IFLENA$=0:A$=run$

3110 IFLENA$=0:IF?(TOP-3):A$=$&600 ELSE IFLENA$=0:A$=$(PAGE-&300)

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

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

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

3150 NEXT:=A$

3160 :

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

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

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

3200 REM ENDPROC

3210 :

3220 DEFFNhimem0:IFHIMEM>&B7FF:=HIMEM

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

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

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

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

3270 REM DEFFNhimem2:IFHIMEM<PAGE:PAGE=&800:=HIMEM ELSE =HIMEM

3280 :