1000 ! * CP.BAC 1005 INTEGER : EXTEND 1020 ; '** Copy file utility **' 1040 ; ' Ver X.01, 1985-04-10' 1060 ; ' Copyright 1985 Dataindustrier AB' 1080 ; 1100 ! * Written by G|ran Nordenborg 1120 ! ** ** ** ** ** ** ** ** ** ** ** 1140 ! * 1160 ! * Ver date / Ver nb / Sign / Note 1180 ! * 85-02-01 / X.00 / GN / Main 1181 ! * 85-04-10 / X.01 / GN / Copy filelength+1 bug 1200 ! * 1220 ! ** ** ** ** ** ** ** ** ** ** ** 1240 ! * 1260 ! EJECT 1280 ! ******************************** 1300 ! * 1320 ! * Main routine 1340 ! * 1360 IF FNCp THEN ; 'CP abort' 1380 END 1400 ! EJECT 1420 ! ******************************** 1440 ! * 1460 ! * Copy files 1480 ! * 1500 DEF FNCp 1520 IF FNInitialize THEN RETURN T 1540 ; 'Source directory, file select: '; 1560 INPUT LINE S$ 1580 ; 1582 INPUT 'Destination directory: 'D$ 1585 S$=FNCapstr$(LEFT$(S$,LEN(S$)-2)) 1600 IF INSTR(1,S$,',') THEN LET Fs$=RIGHT$(S$,INSTR(1,S$,',')+1) : S$=LEFT$(S$,INSTR(1,S$,',')-1) 1660 IF LEN(S$)=0 THEN Sufd$='' : S$='HD0:' ELSE IF RIGHT$(S$,LEN(S$))<>':' THEN Sufd$=S$ : S$='UFD:' 1700 IF INSTR(1,Fs$,'.') THEN Efs$=RIGHT$(Fs$,INSTR(1,Fs$,'.')+1) : LET Fs$=LEFT$(Fs$,INSTR(1,Fs$,'.')-1) 1720 IF LEN(D$)=0 THEN Dufd$='' ELSE IF RIGHT$(D$,LEN(D$))<>':' THEN Dufd$=D$ : D$='UFD:' 1740 CD Sufd$ 1760 OPEN S$ AS FILE Lus 1780 IF S$='UFD:' OR S$='LFD:' OR S$='PFD:' THEN POSIT #Lus,253 ELSE POSIT #Lus,16*253 1800 FOR Dirsec=0 TO 15 1820 GET #Lus Dirsec$ COUNT 253 1840 FOR Dirent=0 TO 15 1860 Namesp=INSTR(2+16*Dirent,Dirsec$,' ') 1880 IF Namesp=0 OR Namesp-(2+16*Dirent)>8 THEN Namesp=8 ELSE Namesp=Namesp-(2+16*Dirent) 1900 Extsp=INSTR(10+16*Dirent,Dirsec$,' ') 1920 IF Extsp=0 OR Extsp-(10+16*Dirent)>3 THEN Extsp=3 ELSE Extsp=Extsp-(10+16*Dirent) 1940 Dirname$=MID$(Dirsec$,2+16*Dirent,Namesp) 1960 Extname$=MID$(Dirsec$,10+16*Dirent,Extsp) 1980 IF ASCII(Dirname$)=255 OR ASCII(Dirname$)=0 OR MID$(Dirsec$,10+16*Dirent,3)='Ufd' THEN 2160 2000 IF LEFT$(Dirname$+' ',LEN(Fs$))<>Fs$ OR LEFT$(Extname$+' ',LEN(Efs$))<>Efs$ OR Dirname$='SYSDIR' THEN 2160 2020 ; 'Copy '''; 2040 IF LEN(Sufd$) THEN ; Sufd$ '/'; ELSE ; S$; 2060 ; Dirname$ '.' Extname$ ''' '; 2080 IF Reply$<>'A' THEN INPUT Reply$ ELSE ; '? Yes' 2100 Reply$=FNCapstr$(LEFT$(Reply$+'n',1)) 2120 IF INSTR(1,'YJA',LEFT$(Reply$,1)) THEN Copyname$(Copyind)=Dirname$+'.'+Extname$ : Copyind=Copyind+1 2140 IF Reply$='I' THEN 2200 2160 NEXT Dirent 2180 NEXT Dirsec 2200 CLOSE Lus 2220 ; 2240 FOR Copyfile=0 TO Copyind-1 2260 IF FNCopy(Copyname$(Copyfile)) THEN RETURN T 2280 NEXT Copyfile 2290 IF Totcopy.<>0. THEN ; 'Total' Totcopy. 'bytes copied' 2300 CLOSE 2320 RETURN F 2340 FNEND 2360 ! ******************************** 2380 ! * 2400 ! * All initialisations 2420 ! * 2440 DEF FNInitialize 2460 F=0 2480 T=NOT F 2500 Lus=1 2520 Lud=Lus+11 2540 DIM Copyname$(256)=8+1+3 2560 Bufsize=(SYS(4)-2048)/253*253 2580 DIM Buffer$=Bufsize 2600 POKE VAROOT(Buffer$)+4,Bufsize,SWAP%(Bufsize) 2620 RETURN F 2640 FNEND 2660 ! ******************************** 2680 ! * 2700 ! * Copy one file 2720 ! * 2740 DEF FNCopy(Copyname$) 2760 IF LEN(Sufd$) THEN ; Sufd$ '/'; ELSE ; S$; 2780 ; Copyname$ ' - '; 2800 CD Sufd$ 2820 OPEN S$+Copyname$ AS FILE Lus 2840 CD Dufd$ 2860 PREPARE D$+Copyname$ AS FILE Lud 2880 ON ERROR GOTO 3200 2900 Eof=F 2920 WHILE Eof=F 2940 FOR Readl=0 TO Bufsize/253-1 2960 GET #Lus Tempbuffer$ COUNT 253 2980 MID$(Buffer$,Readl*253+1,253)=Tempbuffer$ 3000 NEXT Readl 3020 Readl=Bufsize/253-1 3040 Eof=F 3060 FOR Writel=0 TO Readl 3080 PUT #Lud MID$(Buffer$,Writel*253+1,253) 3100 NEXT Writel 3120 WEND 3140 ; POSIT(Lus) 'bytes copied' 3150 Totcopy.=Totcopy.+POSIT(Lus) 3160 CLOSE Lus,Lud 3180 RETURN F 3200 ! * 3220 ! * Read error 3240 ! * 3260 IF ERRCODE=38 THEN Eof=T : Readl=Readl-1 : RESUME 3060 3280 RESUME 3300 3300 ; 'Unexpected error' ERRCODE 3320 CLOSE Lus,Lud 3340 RETURN F 3360 FNEND 3380 ! ************************************** 3400 ! * 3420 ! * Make string block letters 3440 ! * 3460 DEF FNCapstr$(Str$) 3480 FOR Strpnt=1 TO LEN(Str$) 3500 IF MID$(Str$,Strpnt,1)>=CHR$(97) THEN MID$(Str$,Strpnt,1)=CHR$(ASCII(MID$(Str$,Strpnt,1)) AND 223) 3520 NEXT Strpnt 3540 RETURN Str$ 3560 FNEND