UnZip.src

10 REM > UnZip/src v1.12

20 REM Unzip a ZIP file

30 REM v1.00 06-Jun-1999 JGH: Initial version, ignores CRCs

40 REM v1.01 16-Jun-1999 JGH: Reads command line

50 REM v1.02 22-Jun-1999 JGH: Undosifies filenames

60 REM v1.03 17-Jul-1999 JGH: Fuller implementation, -a now -X

70 REM v1.04 20-Nov-2000 JGH: -q quiet mode

80 REM v1.05 28-Dec-2000 JGH: Minor tweeks

90 REM v1.06 15-Jan-2001 JGH: Inflate on RISC OS

100 REM v1.07 22-Mar-2001 JGH: Sets mdate/time, cdate/time on SJ and HADFS

110 REM v1.08 17-Jun-2001 JGH: Split into modules

120 REM v1.09 12-Jan-2002 JGH: Tweeked attribute setting

130 REM v1.10 22-Jun-2011 JGH: Fuller filename translation

140 REM v1.11 30-Sep-2017 JGH: Bugfix ensuring output file writeable on ADFS

150 REM v1.12 15-Oct-2017 JGH: fsname: -> -fsname-, optimised FNfn_zip()

160 :

170 DIMctrl%255,name%128,extra%128,zp%6:A$=FNOS_GetEnv:in%=0:out%=0

180 quit$=FNcl(" -qu",1):debug%=FNcl("-de",0):hlp%=FNcl("-?",0):ON ERROR REPORT:PROCexit(ERR)

190 dst$=FNcl("-d",1):vb%=NOTFNcl("-q",0):sfe%=FNcl("-s",0):xtr%=FNcl("-X",0):inf%=FNcl("-255",0):in$=FNcl("",0)

200 IFin$="-help":PRINT"BBC"FNs($(PAGE+7))" (C)J.G.Harston 1999-2017":hlp%=TRUE

210 REM IFdebug%:PRINT" run$='"run$"'"TAB(39)" quit$='"quit$"'"'" in$='"in$"'"TAB(39)" dst$='"dst$"'"

220 REM IFdebug%:PRINT"verbose=";vb%;" extra info=";xtr%;" info=";inf%

230 IFhlp%:PRINT"Syntax: *UnZip infile -d path -q -X -255 -quit command":PROCexit(0)

240 :

250 ON ERROR REPORT:PROCClose_All:PRINT:PROCexit(ERR)

260 X%=ctrl%:Y%=X%DIV256:DIM A%-1:max%=HIMEM-A%-2000+4000*(HIMEM>&FFFF):DIM mem% max%:wr%=2:rd%=4

270 IFin$="":INPUT"File to unzip: "in$:IFdst$="":INPUT"Destination path: "dst$

280 IFASCin$<>45:A%=INSTR(in$,":",3):IFA%:in$="-"+LEFT$(in$,A%-1)+"-"+MID$(in$,A%+1)

290 in%=OPENIN(in$):IFin%=0:PRINT"File '"in$"' not found":PROCexit(214)

300 PROCgbpb(rd%,in%,zp%,4,0):IF!zp%<>&04034B50:PRINT"Not a ZIP file":CLOSE#in%:in%=0:PROCexit(127)

310 fln%=10:A%=FNfs:sj%=((A%=5)AND2)+((A%=16)AND1)+((A%=8)AND8):IFA%=4:fln%=7

320 IFLENdst$:dst$=dst$+"."

330 FORdirs%=1 AND inf% TO 1 AND (sj%<>0):IFdirs%:vb%=FALSE:IFinf%=0:PRINT"Finishing... ";

340 PTR#in%=0:REPEAT:PROCgbpb(rd%,in%,zp%,4,0):id%=!zp%:done%=FALSE

350 IFdirs%:IFinf%=0:PRINTFNsofar(PTR#in%,EXT#in%);

360 IF(id%AND&FFFF)=&4B50 OR EOF#in%:done%=TRUE

370 IFid%=&04034B50:PROCfile

380 REM IFid%=&02014B50:PROCdir

390 REM IFid%=&06054B50:PROCeof

400 IFNOTdone%:PTR#in%=PTR#in%-3:PRINT"Damaged ZIP file?";CHR$13;

410 UNTILid%=&02014B50 OR id%=&06054B50 OR EOF#in%

420 NEXT:IFinf%=0:VDU8,8,8:PRINT"Done."

430 CLOSE#in%:in%=0:PROCexit(0):END

440 :

450 DEFPROCfile

460 PROCgbpb(rd%,in%,extra%,26,0):flags%=FNex16(2):REM vers%=FNex16(0)

470 method%=FNex16(4):mtime%=FNfstime(FNex16(6)):mdate%=FNfsdate(FNex16(8))

480 crc%=extra%!10:csize%=extra%!14:fsize%=extra%!18:nameln%=FNex16(22)

490 extln%=FNex16(24):IFnameln%:PROCgbpb(rd%,in%,mem%,nameln%,0)

500 :

510 REM vers%=FNget16:flags%=FNget16:method%=FNget16

520 REM mtime%=FNfstime(FNget16):mdate%=FNfsdate(FNget16):crc%=FNget32

530 REM csize%=FNget32:fsize%=FNget32:nameln%=FNget16:extln%=FNget16

540 REM IFnameln%:PROCgbpb(rd%,in%,mem%,nameln%,0)

550 :

560 mem%?nameln%=13:name$=$mem%:FORx%=0TO127STEP4:extra%!x%=0:NEXT

570 IFextln%:PROCgbpb(rd%,in%,extra%,extln%,0)

580 hdrid%=FNex16(0):dsz%=FNex16(2):sig%=extra%!4

590 load%=extra%!8:exec%=extra%!12:attr%=extra%!16

600 ctime%=FNfstime(FNex16(24)):cdate%=FNfsdate(FNex16(26))

610 acc%=FNex16(28):aux%=FNex16(30):IFhdrid%<>&4341:dsz%=0:load%=0

620 REM hdrid%=&4341 -> Created on Acorn computer

630 REM dsz% usually =&14, ie 20 bytes of extra data

640 REM sig%='ARC0' -> Archive

650 A$=FNfn_zip(name$):A%=0:REPEATB%=INSTR(A$+".",".",A%+1):IFB%-A%>fln%+1:A$=LEFT$(A$,A%+fln%)+MID$(A$,B%):B%=A%+fln%

660 A%=B%:UNTILB%>=LENA$:name$=A$:IFvb%:PRINTname$;" ";

670 PROCunzip:IFvb%:PRINT

680 ENDPROC

690 :

700 DEFFNex16(A%)=extra%!A% AND &FFFF

710 :

720 DEFPROCunzip

730 IFvb%:PRINT"Type ";method%;" - ";

740 IFmethod%=0 OR method%=8:PROCunzipobj:ENDPROC

750 PROCskip:IFvb%:PRINT"not supported";

760 ENDPROC

770 :

780 DEFPROCunzipobj

790 PROCensurepath(dst$+name$):IF((RIGHT$(name$,1)=".")EORdirs%)AND1:PROCskip:ENDPROC

800 IFdst$="":IFASCname$=45:name$="@."+name$:REM -name- -> @.-name-

810 IFRIGHT$(name$,1)=".":name$=LEFT$(name$,LENname$-1) ELSE PROCunzipfile

820 IFdsz%<24:cdate%=mdate%:IFdsz%<22:ctime%=mtime%:IFdsz%<13:attr%=&33:IFdsz%<12:exec%=load%

830 IF(sj%AND1)=0:attr%=attr%AND-129:IFsj%AND8:attr%=attr%AND(-69OR4*((attr%EOR17)AND17))

840 X%!14=attr%:X%!15=mdate%:IFdsz%:X%!2=load%:X%!6=exec%:A%=FNfile(dst$+name$,1) ELSE A%=FNfile(dst$+name$,4)

850 IFsj%AND1:IFdsz%>23:X%!2=acc%:X%!4=aux%:IFdsz%<26ORxtr%=0:A%=FNfile(dst$+name$,&FD)

860 IFsj%AND1:IFdsz%>23:X%!6=mtime%:X%!9=cdate%:X%!11=ctime%:A%=FNfile(dst$+name$,&FC)

870 IFxtr%:IFsj%AND1:IFdsz%>25:OSCLI"Account "+dst$+name$+" "+STR$~acc%+LEFT$(" ("+STR$~aux%+")",dsz%>27)

880 IF(sj%AND2)=0:ENDPROC

890 X%!8=mdate%:A%=FNNetFS_OpN(19,5,10,dst$+name$):IFFNNetFS_OpN(18,64,8,dst$+name$):ENDPROC

900 FORB%=1TO2:X%!8=cdate%:X%!10=ctime%:X%!13=mdate%:X%!15=mtime%:A%=FNNetFS_OpN(19,64,18,dst$+name$):NEXT

910 REM IFdsz%>23:X%!8=cdate%:X%!10=ctime%:X%!13=mdate%:X%!15=mtime%:A%=FNNetFS_OpN(19,64,18,dst$+name$)

920 IFxtr%:IFdsz%>25:A%=FNNetFS_OpN(0,0,7,"Account "+dst$+name$+" "+STR$~acc%+LEFT$(" ("+STR$~aux%+")",dsz%>27))

930 ENDPROC

940 :

950 DEFPROCunzipfile

960 IFmethod%=8:IFos%<>6:PRINT" unsupported";:PROCskip:ENDPROC

970 IFLENdst$+LENname$>63:PRINT'"Path may be too long for NetFS"

980 :

990 REM IFos%=6 AND HIMEM>&FFFF:SYS "XOS_File",1,dst$+name$,,,,&33 ELSE IFFNfile(dst$+name$,5):X%!2=0:X%!14=0:A%=FNfile(dst$+name$,1):REM Ensure writable

1000 REM OSCLI"Save "+dst$+name$+" "+STR$~PAGE+"+"+STR$~(FNmin(fsize%,&C000))+" 0 0":X%!14=&33:A%=FNfile(dst$+name$,1):REM Reserve disk space, ensure writable

1010 :

1020 REM ADFS falls over if dest in a subdir and doesn't exist yet

1030 REM A%=1:IFos%=6:A%=FNfile(dst$+name$,5) :REM RISC OS OS_File,1 errors if file not found

1040 REM IFA%:X%!14=&33:A%=FNfile(dst$+name$,1):REM Ensure writable

1050 :

1060 REM Extra OSFILE 5 to bypass ADFS and RISCOS bugs

1070 IFFNfile(dst$+name$,5):X%!14=&33:A%=FNfile(dst$+name$,1):REM Ensure writable

1080 X%!10=0:X%!14=fsize%:IFFNfile(dst$+name$,7)=7:X%!14=FNmin(fsize%,&B000):A%=FNfile(dst$+name$,0)

1090 :REM Reserve disk space, avoiding GoMMC/SDC I/O area

1100 IF(X%?14AND2)=0:X%!14=&33:A%=FNfile(dst$+name$,1)

1110 :REM Ensure overwritable again if default attrs are read-only

1120 :

1130 out%=0:PROCextract:IF(flags%AND8):PTR#in%=PTR#in%+12

1140 IFvb%:VDU8,8,8:PRINT"Done.";

1150 IFout%:CLOSE#out%:out%=0

1160 ENDPROC

1170 :

1180 DEFFNfstime(A%):=((A%AND&F800)DIV2048)+((A%AND&7E0)*8)+((A%AND31)*131072)

1190 DEFFNfsdate(A%):A%=A%-&200:=(A%AND31)+((A%AND&1E0)*8)+((A%AND&1E00)*8)+((A%AND&E000)DIV256)

1200 :

1210 DEFPROCextract:IFfsize%=0:PRINTSPC(vb%AND3);:ENDPROC

1220 IFmethod%=8:IFvb%:PRINT"Inflating ...";

1230 IFmethod%=0:out%=OPENOUT(dst$+name$):IFvb%:PRINT"Extracting ...";

1240 IFmethod%=8:PROCZipTest:out%=OPENOUT("<Wimp$Scrap>"):

1250 IFmethod%=8:PROCput32(&04088B1F):PROCput32(0):PROCput32(&00200000):PROCput32(&001C4341):PROCput32(load%):PROCput32(exec%):PROCput32(attr%):PROCput32(fsize%):PROCput32(0):PROCput32(0):PROCput32(0)

1260 PROCtrans:IFmethod%=8:PROCput32(crc%):PROCput32(fsize%)

1270 CLOSE#out%:out%=0:IFmethod%=0:ENDPROC

1280 OSCLI"ZipUnCompress <Wimp$Scrap> "+dst$+name$

1290 ENDPROC

1300 :

1310 DEFPROCskip:PTR#in%=PTR#in%+csize%+(12AND((flags%AND8)<>0)):ENDPROC

1320 :

1330 DEFPROCZipTest:zipok%=zipok%:IFzipok%:ENDPROC

1340 *RMEnsure SparkFS 0.00 Error SparkFS needs to be running

1350 *RMEnsure Zip 0.00 Error SparkFS needs to load Zip module

1360 zipok%=TRUE:ENDPROC

1370 :

1380 DEFFNfn_zip(A$):B$="_ #?./$<^>&+@=%;"

1390 FOR A%=1 TO LEN A$:B%=INSTR(B$,MID$(A$,A%,1),2)-1

1400 IF B%>-1:A$=LEFT$(A$,A%-1)+MID$(B$,(B%EOR1)+1,1)+MID$(A$,A%+1)

1410 NEXT A%:=A$

1420 :

1430 DEFPROCensurepath(A$):IFINSTR(A$,".")=0:ENDPROC

1440 A$=A$+".":REPEATA$=LEFT$(A$,LEN A$-1):UNTILRIGHT$(A$,1)=".":A$=LEFT$(A$,LEN A$-1):IFFNfile(A$,5)=2:ENDPROC

1450 B$=A$:A$="":REPEATIFLENB$:A%=INSTR(B$+".","."):A$=A$+LEFT$(".",A$<>"")+LEFT$(B$,A%-1):B$=MID$(B$,A%+1)

1460 IFFNfile(A$,5)<>2:OSCLI"CDir "+A$

1470 UNTILB$="":ENDPROC

1480 :

1490 REM DEFPROCdir:ENDPROC

1500 REM DEFPROCeof:ENDPROC

1510 :

1520 REM DEFPROCCheckFS:sj%=0:A%=FNfs:IFA%=16:sj%=1:ENDPROC

1530 REM IFA%=8:sj%=8:ENDPROC ELSE IFA%=4:fln%=7:ENDPROC ELSE IFA%<>5:ENDPROC

1540 REM sj%=2:A%=FNNetFS_Op(25,""):IFINSTR($(X%+4),"SJ"):sj%=6

1550 REM ENDPROC

1560 :

1570 REM DEFPROCCheckFS:sj%=0:A%=FNfs:sj%=((fs%=5)AND2)+((fs%=16)AND17)+((fs%=8)AND8):IFA%=4:fln%=7

1580 REM ENDPROC

1590 REM b0 1 HADFS

1600 REM b1 2 NET

1610 REM b3 8 ADFS

1620 :

1630 REM DEFFNget16:=BGET#in%+256*BGET#in%

1640 REM DEFFNget32:PROCgbpb(rd%,in%,zp%,4,0):=!zp%

1650 DEFPROCput32(A%):!zp%=A%:PROCgbpb(wr%,out%,zp%,4,0):ENDPROC

1660 :

1670 REM DEFPROCtrans:crc%=0:IFcsize%=0:ENDPROC

1680 REM crc%=-1:ptr%=0:REPEAT:IFvb%:PRINTFNsofar(ptr%,csize%);

1690 DEFPROCtrans:IFcsize%=0:ENDPROC

1700 ptr%=0:REPEAT:IFvb%:PRINTFNsofar(ptr%,csize%);

1710 len%=max%:IFptr%+len%>csize%:len%=csize%-ptr%

1720 PROCgbpb(rd%,in%,mem%,len%,0):PROCgbpb(wr%,out%,mem%,len%,0)

1730 ptr%=ptr%+len%:UNTILptr%>=csize%:REM crc%=FNrev32(crc%)EOR-1

1740 ENDPROC

1750 :

1760 DEFFNmin(A%,B%):IFA%<B%:=A% ELSE =B%

1770 DEFFNsofar(A%,B%):VDU8,8,8:PRINTFNd0(A%/B%*100,2);"%";:=""

1780 :