5
6 maintain%=FALSE
10
20 PROCinitialize:
25 PROCinitmc
27 PROCoscli("OPT 1")
40 ON ERROR:ONERROR OFF:PROCfs(dfile%):CLOSE#0:PROCfs(net%):CLOSE#0:IF ERR=17 ELSE REPORT:PRINT" at ";ERL:END
50 $title%="File Server Archiver Retrieval Utility":PRINTCHR$12'''$title%'STRING$(LEN$title%,"*")'
60 :
70 tab%=6:tab1%=2
80 PRINT'TAB(tab1%)"C"TAB(tab%)"Catalogue Archive disc"
90 PRINTTAB(tab1%)"B"TAB(tab%)"Retrieve both files and"'" sub-directories"
100 PRINTTAB(tab1%)"F"TAB(tab%)"Retrieve files only"
110 PRINTTAB(tab1%)"Q"TAB(tab%)"Quit"
120 REPEATPRINT'"Your choice"'" :";:t$=GET$:PRINT t$;
130 IFt$="*" THEN INPUT""t$:PROCoscli(t$):UNTIL0:PRINT'
140 command%=(INSTR("CBFQ*cbfq",t$))MOD5:UNTILcommand%
150 IF command%=4 THEN PRINT''" ** Finished **"':END
160 IF command%=2 OR command%=3 ELSE 230
165 PROCfs(net%):X%=&70:A%=0:Y%=0:R%=USR osargs% AND &FF:IF R%<>net% THEN PRINT'"Net filing system must be present":END
170 IF command%=2 THEN PRINT''"Retrieving both files and"'"sub-directories"
180 IF command%=3 THEN PRINT''"Retrieving files only"
190 X%=FNcommand("Pathname of directory to retrieve from"):$opath%=$var%
195 X%=FNcommand("Pathname of directory to retrieve to"):$topath%=$var%
196 PROCfs(net%):IF $topath%<>"":IF FNexamine(topath%)<>directory:PRINT" directory not found":GOTO195
200 REPEAT:INPUT"Object specifier"'" :"$oname%:UNTILLEN $oname%<10
210 IF LEN $oname%=0:$oname%="*"
220 :
230 REPEAT:PRINT''"Select filing system used for archive (A=Adfs, D=Disc)"'" :";:dfile%=GET:PRINTCHR$(dfile%);:f%=INSTR("ADad",CHR$dfile%):UNTIL f%
240 IF f% MOD 2 THEN dfile%=adfs%:PRINT"dfs" ELSE dfile%=disc%:PRINT"isc"
250 REPEAT
260 $prompt%="ADFS drive":IF dfile%=disc% THEN $prompt%=MID$($prompt%,2)
270 REPEATUNTILFNcommand($prompt%)
280 $ok%="0123":IF dfile%=adfs% THEN $ok%="0145aAbBeEfF"
290 UNTIL INSTR($ok%,$var%)
300 IF INSTR("AaBbEeFf",$var%) THEN T%=(ASC$var% AND &5F)-&11:$var%=CHR$(T%)
310 PROCfs(dfile%):IF dfile%=disc% THEN PROCoscli("Dr. :"+$var%) ELSE PROCoscli("Dir :"+$var%)
320 X%=&70:A%=0:Y%=0:R%=USR osargs% AND &FF:IF R%<>dfile% THEN PRINT"Filing system must be present":END
330 REPEATUNTILFNcommand("Name of archive file")
340 h%=FNopen($var%,&40):IF h% ELSE 330
350 PRINT':$sfile%=$var%:r%=FNexamine(var%):mlen%=cb%!&A
360 start%=0:PROCRetrieve
370 GOTO 70:
380 :
390 DEFPROCRetrieve
400 LOCAL X%
410 REPEAT
420 IF command%<>1: PROCfs(dfile%)
430 X%=0:REPEAT:path%?X%=BGET#h%:X%=X%+1:UNTIL(path%?(X%-1)=&0D) OR X%>&100
435 IF X%>&100:PRINT"File fault, retreive aborted":CAUSE ERROR
440 Y%=X%:flag%=TRUE:mlen%=mlen%-(X%)
450 X%=FNtail(path%)
490 s%=0
500 REPEAT
510 name%?s%=path%?(X%+s%):s%=s%+1
520 UNTIL s%=Y%-X%-1:path%?X%=&0D:name%?s%=&0D:IF INSTR($name%,".")=1 THEN $name%=RIGHT$($name%,(LEN $name%-1))
530 stype%=BGET#h%:seq%=BGET#h%
540 IF stype%=1 OR stype%=2 ELSE PRINTnot$:GOTO600
550 FORX%=2 TO 18:cb1%?X%=BGET#h%:NEXT:slen%=cb1%!&A:mlen%=mlen%-19
560 IF start% ELSE IF seq%<>1 PRINT"This is not the first disc in the sequence":CLOSE#h%:ENDPROC
570 PROCname(name%,stype%,cb1%)
580 IF stype%=directory THEN PROCsortdirectory(path%,name%,command%,cb1%) ELSE PROCcopydata(path%,name%,slen%,command%)
590 UNTILmlen%=0
600 PROCfs(dfile%):CLOSE#h%
610 ENDPROC
620 :
630 DEFPROCsortdirectory(path%,name%,command%,cb1%)
650 IF command%=1 OR command%=3 THEN ENDPROC
660 PROCfs(net%)
680 IF $path%<>"":$buffer%=$path%+"."+$name%:ELSE:$buffer%=$name%
690 tail%=FNeq(buffer%,opath%):IF tail%=0:ENDPROC
694 IF $tail%="":ENDPROC
695 IF LEN$opath%<>0:tail%=tail%+1
700 IF LEN$topath%:$tail%="."+$tail%
704 $buffer3%=$topath%+$tail%
705 IF LEN$buffer3%:ELSE:ENDPROC
710 REPEAT
720 r%=FNexamine(buffer3%)
730 IF r%=0 PRINT'"Creating "+$buffer3%':PROCoscli("CDIR "+$buffer3%)
740 IF r%=0 PROCoscli("Access "+$buffer3%):cb2%!0=&13004000:cb2%!4=&05000000:cb2%?&8=cb1%?&F:cb2%?9=cb1%?&10:$(cb2%+&A)=$buffer3%:X%=cb2%:Y%=X% DIV &100:A%=&14:CALL osword%:PROCoscli("Access "+$buffer3%+" L")
750 IF r%=file :ELSE:UNTILTRUE:ENDPROC
760 PRINT'$buffer3%;
762 $path%=FNtails(buffer3%)
765 IF NOT FNcommand("exists as a file - Please rename the file as "+$path%) THEN 765
770 PROCoscli("ACC. "+$buffer3%+" wr"):PROCoscli("REN. "+$buffer3%+" "+$path%+$var%):?cb%=var%:cb%?1=var% DIV &100:X%=cb%:Y%=X% DIV &100:A%=4:CALL osfile%
800 UNTIL FALSE
810 ENDPROC
820 :
830 DEFFNexamine(n%)
840 !cb%=n%
850 X%=cb% MOD 256:Y%=cb% DIV 256
860 A%=5
870 R%=USR(osfile%) AND &FF
875 acc%=cb%?&E
880 =R%
890 :
900 DEFFNopen($n%,a%)
910 X%=n% MOD 256:Y%=n% DIV 256
920 A%=a%
930 IF FNcall(osfind%) THEN PROCerror(0):=FALSE
940 =?tempa
950 :
960 DEFPROCclose(h%)
970 Y%=h%:A%=0:IF FNcall(osfind%) THEN PROCerror(0)
980 ENDPROC
990 :
1000 DEFPROCname(name%,stype%,block%)
1010 IF $path%="" THEN $buffer%=$name% ELSE $buffer%=$path%+"."+$name%
1020 IF stype%=directory THEN PRINT"Dir. "$buffer%" "; ELSE PRINT"File "$buffer%" ";
1030 PROCsize(block%,block%?&E,stype%)
1040 ENDPROC
1050 :
1060 DEFPROCsize(A%,E%,stype%)
1070 @%=&A0A:pos%=80
1080 $attstr%=FNaccess(E%,stype%)
1090 $dat%=FNdates(A%)
1100 $load1%=FNdisplay(A%!2,8):$exec1%=FNdisplay(A%!6,8):$length1%=FNdisplay(A%!&A,8)
1110 PRINT TAB(pos%)+$load1%;TAB(pos%+10)+$exec1%;TAB(pos%+20)+$length1%;TAB(pos%+30)+$attstr%;TAB(pos%+40)+$dat%
1120 ENDPROC
1130 :
1140 DEFPROCinitmc
1150 FOR pass%=0 TO 2 STEP 2
1160 P%=space%
1170 [ OPT pass%
1180 .trap sta tempa:stx tempx:sty tempy
1190 lda brkvec:sta copy:lda brkvec+1:sta copy+1
1200 tsx:stx sp:lda #0:sta error_flag
1210 lda# (brkcode AND &FF):sta brkvec
1220 lda# (brkcode /&100):sta brkvec+1
1230 lda tempa:ldx tempx:ldy tempy:jsr indirect
1240 sta tempa:\ return A
1250 .restore lda copy:sta brkvec:lda copy+1:sta brkvec+1:rts
1260 \
1270 .brkcode ldy#0:lda (&FD),Y:sta error_flag
1280 ldx sp:txs:iny
1290 .loop lda (&FD),Y:beq exit:sta errmsg,Y:iny:bne loop
1300 .exit lda #13:sta errmsg,Y:jmp restore
1310 .indirect jmp (go)
1320 ]
1330 NEXT
1340 ENDPROC
1350 :
1360 DEFPROCinitialize
1370 osfind%=&FFCE:osgbpb%=&FFD1:osargs%=&FFDA:osfile%=&FFDD:osword%=&FFF1:osbyte%=&FFF4:oscli%=&FFF7
1372 DIM cb% 30,cb1% 30,cb2% &130,name% 50,name1% 50,errmsg (30),path%&100,topath%&100,space% &100,var% &100,n% &100,buffer% &200,buffer2% &100,buffer3% &100
1376 DIM title% &40,opath% &80,oname% &10,ok% &20,sfile% &30,prompt% &80,attstr% &100,load1% &20,exec1% &20,length1% &20,dat% &20,string% &100
1380 file=1:directory=2
1390 @%=3:VDU15
1400 brkvec=&202:oldbrk=!brkvec
1420 sp=&70:copy=&71
1440 tempa=copy+2:tempx=tempa+1:tempy=tempx+1:go=tempy+1:error_flag=go+2
1450 adfs%=8:disc%=4:net%=5:seq%=1:seq1%=0:size_left%=0:to_write%=0:fsize%=0
1455 DIM ZZ% -1:size%=HIMEM-ZZ%-&1300:DIM buffer1% size%
1510 PROCfs(net%):dfile%=0
1515 not$="This is not an archive file"
1520 ENDPROC
1525 :
1530 DEFPROCoscli($buffer2%)
1550 X%=buffer2%:Y%=X% DIV &100
1560 IF FNcall(oscli%) THEN PROCerror(0)
1570 ENDPROC
1580 :
1590 DEFFNcall(addr)
1600 ?go=addr:go?1=(addr AND &FF00) DIV &100
1610 CALL trap
1620 =?error_flag<>0
1630 DEFPROCerror(trap%)
1640 IF ?error_flag=trap% ELSE PRINT$(errmsg+1)
1650 ENDPROC
1660 :
1670 DEFFNcommand($string%)
1680 $var%="":PRINT'$string%'" :";
1690 INPUTLINE""$var%
1700 IF RIGHT$($var%,1)=" " THEN $var%=LEFT$($var%,LEN$var%-1):GOTO 1700
1710 IF ASC$var%=&20 THEN $var%=MID$($var%,2):GOTO 1710
1720 IF ASC$var%=ASC"*" THEN PROCoscli($var%):GOTO 1680
1730 =(LEN$var%<>0)
1740 :
1750 DEFPROCfs(f%):A%=&8F:X%=&12:Y%=f%:CALLosbyte%:ENDPROC
1780 :
1790 DEFPROCcopydata(path%,name%,slen%,command%)
1800 LOCAL T%,tail%,match%:match%=FALSE
1830 IF $path%<>"":$buffer%=$path%+"."+$name%:ELSE:$buffer%=$name%
1840 IF command%=1 THEN 1870
1845 PROCfs(net%)
1850 tail%=FNeq(buffer%,opath%):IF tail%:match%=FNeq(name%,oname%)
1852 IF match% ELSE:GOTO1870
1853 IF LEN$opath%=0:T%=tail%:ELSE:T%=tail%+1
1854 IF command%=3 AND $T%<>$name%:match%=FALSE:GOTO1870
1861 IF LEN $topath%<>0:$buffer3%=$topath%+"."+$T%:ELSE:$buffer3%=$T%
1865 PRINT"Copying "$buffer%," as "$buffer3%
1870 REPEAT
1890 IF command%=1 OR match%=0 THEN ftype%=0:copyit%=0 ELSE copyit%=1:ftype%=FNexamine(buffer3%)
1910 IF ftype%=0 OR ftype%=file:PROCcopynothing(buffer3%,copyit%,command%):UNTIL1:ENDPROC
1920 IF ftype%=directory THEN PROCrenamesave:UNTIL0
1950 ENDPROC
1960 :
1970 DEFPROCcopynothing(buffer3%,copyit%,command%)
1972 IF copyit%=0 THEN to%=0:GOTO 2010
1974 IF ftype%=0:GOTO1990
1975 IF (acc% AND &88) AND (NOT maintain%):PRINT" Locked":copyit%=0:to%=0:GOTO2010
1976 IF (acc% AND &88):PROCoscli("ACCESS "+$buffer3%+" WR")
1990 to%=FNopen($buffer3%,&80)
2000 IF to% ELSE PRINT"Unable to copy "+$buffer3%:copyit%=0
2010 REPEAT
2012
2015 IF mlen%<>slen% ELSE REPEAT:IF size%<mlen% THEN PROCgetput(size%,h%,to%,copyit%):UNTILmlen%=0:ELSE PROCgetput(mlen%,h%,to%,copyit%):UNTILmlen%=0:GOTO2040:
2020 IF mlen%-2<=slen% ELSE IF size%<slen% THEN PROCgetput(size%,h%,to%,copyit%) ELSE PROCgetput(slen%,h%,to%,copyit%):GOTO 2040:
2030 IF mlen%-2>slen% ELSE REPEAT:IF size%<mlen%-2 THEN PROCgetput(size%,h%,to%,copyit%):UNTILmlen%=2:ELSE PROCgetput(mlen%-2,h%,to%,copyit%):UNTILmlen%=2:PROCsplit_it:
2040 UNTIL slen%=0
2050 IF copyit%=1 THEN CLOSE#to% ELSE ENDPROC
2070 ?cb1%=buffer3%:cb1%?1=buffer3% DIV &100:X%=cb1%:Y%=X% DIV &100:A%=1:CALLosfile%
2080 cb2%!0=&13004000:cb2%!4=&05000000:cb2%?&8=cb1%?&F:cb2%?9=cb1%?&10:$(cb2%+&A)=$buffer3%
2090 X%=cb2%:Y%=X% DIV &100:A%=&14:CALL osword%
2100 ENDPROC
2110 :
2120 DEFPROCgetput(amount%,dfshandle%,adfshandle%,copyit%)
2130 IF command%<>1:PROCfs(dfile%)
2140 IF copyit% ELSE:PTR#dfshandle%=PTR#dfshandle%+amount%:GOTO2200
2150 ?cb%=dfshandle%:cb%!1=buffer1%:cb%!5=amount%:cb%!9=0
2160 X%=cb%:Y%=X% DIV &100:A%=4:CALL osgbpb%
2170 PROCfs(net%)
2180 ?cb%=adfshandle%:cb%!1=buffer1%:cb%!5=amount%:cb%!9=0
2190 X%=cb%:Y%=X% DIV &100:A%=2:CALL osgbpb%
2200 mlen%=mlen%-amount%:slen%=slen%-amount%
2210 ENDPROC
2220 :
2230 DEFPROCsplit_it
2240 LOCALsperror%:sperror%=TRUE
2250 PROCfs(dfile%)
2260 stype1%=BGET#h%:seq1%=BGET#h%:CLOSE#h%
2270 IF LEN $path% THEN $buffer1%=$path%+"."+$name% ELSE $buffer1%=$name%
2280 REPEAT
2290 REPEAT:PRINT"Please insert next disc in sequence"'"and press RETURN":resp$=GET$:UNTILASCresp$=&0D:start%=-1
2300 REPEAT
2310 $prompt%="New DFS drive":IF dfile%=adfs% THEN $prompt%="New ADFS drive"
2320 REPEATUNTILFNcommand($prompt%)
2330 $ok%="0123":IF dfile%=adfs% THEN $ok%="0145AaBbEeFf"
2340 UNTILINSTR($ok%,$var%)
2350 IF INSTR("AaBbEeFf",$var%) THEN T%=(ASC$var% AND &5F)-&11:$var%=CHR$(T%)
2360 PROCfs(dfile%):IF dfile%=disc% THEN PROCoscli("Dr. :"+$var%) ELSE PROCoscli("Dir :"+$var%)
2370 h%=FNopen($sfile%,&40):IF h% THEN $buffer%=$sfile% ELSE GOTO 2420
2380 r%=FNexamine(buffer%):mlen%=cb%!&A:tempml%=mlen%
2390 X%=0:REPEAT:name1%?X%=BGET#h%:X%=X%+1:UNTILname1%?(X%-1)=&0D OR X%>254
2394 IF X%>254:PRINTnot$:GOTO2420
2395 mlen%=mlen%-X%:IF $name1%=$buffer1% OR slen%=0 ELSE GOTO 2420
2400 stype%=BGET#h%:IF stype%=stype1% OR slen%=0 ELSE GOTO 2420
2410 seq%=BGET#h%:mlen%=mlen%-2:IF seq%=seq1%+1 THEN sperror%=FALSE
2420 IF sperror% THEN PRINT'"That is not the next disc in the sequence"':CLOSE#h%
2430 UNTIL sperror%=FALSE
2440 IFslen%=0 THEN PTR#h%=0:mlen%=tempml% ELSE FORX%=2 TO 18:cb1%?X%=BGET#h%:NEXT:mlen%=mlen%-17
2450 ENDPROC
2460 :
2540 DEFPROCrenamesave
2550 $path%=FNtails(buffer3%)
2560 REPEATPRINT'$buffer3%;:UNTILFNcommand("exists as a directory - save this file as "+$path%)
2570 $buffer3%=$path%+$var%
2590 ENDPROC
2595
2600 DEFFNaccess(atts1%,x%)
2610 LOCAL sgg$:sgg$=""
2620 IF x%=directory THEN sgg$="D"
2630 IF atts1% AND 8 THEN sgg$=sgg$+"L"
2640 IF atts1% AND 2 THEN sgg$=sgg$+"W"
2650 IF atts1% AND 1 THEN sgg$=sgg$+"R"
2660 sgg$=sgg$+"/"
2670 IF atts1% AND &20 THEN sgg$=sgg$+"W"
2680 IF atts1% AND &10 THEN sgg$=sgg$+"R"
2690 =sgg$
2700 :
2710 DEFFNdates(A%)
2720 =FNd0(A%?15AND31,2)+"/"+FNd0(A%?16AND15,2)+"/"+FNd0(1981+(A%?16)DIV16+((A%?15)AND&E0)DIV2,4)
2730 :
2740 DEFFNeq(A%,B%)
2742 IF $B%="":=A%
2745 REPEAT
2760 IF (?A% AND &5F)=(?B% AND &5F) OR ?B%=ASC"#":A%=A%+1:B%=B%+1:GOTO2780
2770 IF ?B%=ASC"*":ELSE :UNTIL1:=FALSE
2775 REPEAT A%=A%+1:UNTIL ?A%=ASC"." OR ?A%=13
2776 REPEAT B%=B%+1:UNTIL ?B%=ASC"." OR ?B%=13
2780 UNTIL ?A%=13 OR ?B%=13
2785 IF ?B%<>13:=FALSE
2786 IF ?A%=13 OR ?A%=ASC".":=A%:ELSE=0
2790
2800 :
2910 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
2920 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
3000 DEF FNtail(N%)
3010 LOCAL L%:L%=LEN$N%
3020 REPEAT L%=L%-1
3030 UNTIL N%?L%=&2E OR L%=0
3050 =L%
3060
3070 DEF FNtails(N%)
3080 LOCAL L%,T%,path$
3090 L%=FNtail(N%):T%=N%?L%:N%?L%=13:path$=$N%:N%?L%=T%
3100 IF LEN path$:path$=path$+"."
3110 =path$