10
20
30
40
50
60
70
80
90
100
110
120
130
140
150 :
160 DIMctrl%255,name%128,zp%9:A$=FNOS_GetEnv:in%=0:out%=0:inc%=0
170 quit$=FNcl(" -qu",1):debug%=FNcl("-de",0):hlp%=FNcl("-?",0):ON ERROR REPORT:PRINT:PROCexit(ERR)
180 rst%=FNcl("-re",0):rc%=FNcl("-r",0):vb%=NOTFNcl("-q",0):pre$=FNcl("-pp",1):date$=FNcl("-t",1)
190 apd%=FNcl("-g",0):sfx$=FNcl("-S",1):di%=NOTFNcl("-D",0):
200 mem%=1024*VALFNcl("-M",1):xtr%=FNcl("-X",0):nodir%=FNcl("-no",0):v1%=FNcl("-v1",0):IFv1%:vb%=TRUE
210 inc$="":A%=INSTR(" "+A$," -i@"):
220 IFA%:inc$=MID$(A$,A%+3,INSTR(A$," ",A%)-A%-3):A%=FNcl("-i@"+inc$,0)
230 ct%=0:A%=INSTR(" "+A$," -")
240 IFA%:f$=MID$(A$,A%+1,INSTR(A$," ",A%)-A%-1):IFf$>="0" AND f$<="9":ct%=VAL f$:A%=FNcl("-"+f$,0)
250 out$=FNcl("",0):in$=FNcl("",0):IFpre$<>"":pre$=pre$+"."
260 IFout$="-help":PRINT"BBC"FNs($(PAGE+7))" (C)J.G.Harston 1999-2014":hlp%=TRUE
270
280
290
300
310 IFhlp%:PRINT"Syntax: *Zip outfile inpath -# -D -g -i@file -M size -nodir -pp path -q -r -resume -S suffix -t dd/mm/yyyy -X -quit command":PROCexit(0)
320 :
330 ON ERROR REPORT:PRINTLEFT$(" at line "+STR$ERL,ERR<128 AND ERR<>17):PROCClose_All:PROCexit(ERR)
340 X%=ctrl%:Y%=X%DIV256:PROCInitCRC:PROCInitZip:date%=0:start$="":sfx%=0
350 IFMID$(date$,5,1)="/":date$=MID$(date$,9,2)+MID$(date$,5,4)+LEFT$(date$,4)
360 IFdate$<>"":date%=VALLEFT$(date$,2)+32*VALMID$(date$,4,2)+512*(VALMID$(date$,7)-1980)
370 IFsfx$<>"":IFFNfile(sfx$,5)<>1:PRINT"Suffix file '"sfx$"' not found":PROCexit(214)
380 IFsfx$<>"":DIM sfx% X%!10:sfx%?(X%!10)=13:OSCLI"Load "+sfx$+" "+STR$~sfx%
390 DIM A%-1:max%=HIMEM-A%-2500+5000*(HIMEM>&FFFF):IFmem%:IFmax%>mem%:max%=mem%
400 DIM mem% max%:wr%=2:rd%=4
410 :
420 IFout$="":INPUT"Destination file: "out$
430 out$=FNfn(out$):in$=FNfn(in$):IFapd%+rst%=0:PROCOutput ELSE PROCAppend:IFNOTrst%:start$=""
440 ptr0%=PTR#out%:X%!2=&FFFDDC00:A%=FNfile(out$,2):A%=0:IFin$<>"":A%=FNfile(in$,5)
450 IFin$="" OR inc$<>"":PROCEnter:A%=2 ELSE IFA%AND2:OSCLI"Dir "+in$:PROCChkFS:PROCScan(""):A%=2
460 IFA%AND2:PROCzipcatandeof ELSE PRINT"Dir. '"in$"' not found"
470 IFEXT#out%:IFrst%:!mem%=&04034B50:mem%!4=0:PROCgbpb(wr%-1,out%,mem%,8,0)
480 CLOSE#out%:out%=0:PROCexit(0):END
490 :
500
510
520 :
530 DEFPROCAppend:out%=OPENUP(out$):IFout%=0:PROCOutput:ENDPROC
540 ptr%=0:PROCgbpb(rd%-1,out%,mem%,4,0):IF!mem%=&100F4B50:PROCgbpb(rd%-1,out%,mem%,4,4):ptr%=!mem%
550 IFptr%=0:IF!mem%<>&04034B50:PRINT"'"out$"' not a ZIP file":PROCClose_All:PROCexit(214)
560 ext%=EXT#out%:IFptr%>ext%:ptr%=0
570 ptr0%=ptr%:REPEAT:IFptr%+30>ext%:UNTILTRUE:PTR#out%=ptr0%:ENDPROC :
580 !mem%=0:PROCgbpb(rd%-1,out%,mem%,4,ptr%) :
590 IFptr%=0:IF!mem%=&100F4B50:!mem%=&04034B50 :
600 IF!mem%<>&04034B50:UNTILTRUE:PTR#out%=ptr0%:ENDPROC :
610 PROCgbpb(rd%-1,out%,mem%,12,ptr%+18) :
620 mem%!12=0:esz%=mem%!10:mem%!10=0:fsz%=mem%!8:csz%=!mem% :
630 IFfsz%>254OResz%>127:UNTILTRUE:PTR#out%=ptr0%:ENDPROC :
640 skip%=ptr%+csz%+fsz%+esz%+30 :
650 IFskip%>ext%:UNTILTRUE:PTR#out%=ptr0%:ENDPROC :
660
670 PROCgbpb(rd%-1,out%,name%,fsz%,ptr%+30):name%?fsz%=13 :
680 start$=FNfn_zip($name%):IFRIGHT$(start$,1)=".":start$=LEFT$(start$,LENstart$-1)
690 IFvb%:PRINT"Skipping dest ";start$:
700 IFskip%=ext%:UNTILTRUE:PTR#out%=ptr%:ENDPROC :
710 ptr0%=ptr%:ptr%=skip% :
720 UNTILFALSE:ENDPROC :
730 :
740 DEFPROCOutput:out%=OPENOUT(out$):IFout%=0:PRINT"Can't open '"out$"'":PROCexit(192)
750 BPUT#out%,0:CLOSE#out%:out%=OPENUP(out$):ENDPROC
760 :
770 DEFPROCEnter:p$=""
780 IFinc$="":PRINT"Enter files to include, end with RETURN" ELSE OSCLI"Exec "+inc$:inc%=FNbyte(198,0,255)
790 IFin$<>"":OSCLI"Dir "+in$
800 PROCChkFS:IFinc%:IFEXT#inc%=0:ENDPROC
810 REPEAT:IFinc%=0:PRINT"Enter filename: ";
820 INPUTLINE""in$:t%=0:IFin$<>"":fn$=LEFT$("@.",ASCin$=45)+in$:t%=FNf_info(fn$):name$=FNfn_sfx(in$,X%!3AND&FFF)::IFinc%:VDU11
830 IFt%:PROCzip(ct%) ELSE IFin$<>"":PRINT"File '"in$"' not found"
840 A%=0:IFinc%:A%=EOF#inc%
850 UNTILin$="" OR A%:IFinc$<>"":*Exec
860 ENDPROC
870 :
880 DEFPROCScan(p$):LOCAL p%,r%:REPEAT
890 IFfs%>127:SYS12,9,"",name%,1,p%,32TO,,,r%,p%:r%=1-r%:SYS70,name%TOin$ ELSE in$=FNgbpb8(p%):p%=X%!9:r%=X%!5
900 IFr%=0:PROCRdName
910 UNTILr%=1:ENDPROC
920 :
930 DEFPROCRdName:IFASCin$=46:ENDPROC
940 fn$=in$:IFASCfn$=45:fn$="@."+fn$:
950 t%=FNf_info(fn$):name$=FNfn_sfx(in$,X%!3AND&FFF):skip%=0
960 IFLENstart$:IFstart$=p$+name$:start$=""
970 IFLENstart$:IFLEFT$(start$,LENp$+LENname$+1)<>p$+name$+".":skip%=TRUE
980 IFskip%:IFvb%:PRINTCHR$13;"Skipping ";p$;in$:
990
1000 IFskip%:ENDPROC
1010 IFLENstart$=0:IFdi%OR(t%AND1)=1:PROCzip(ct%):IFt%<>2:ENDPROC
1020 IFrc%ANDt%=2:OSCLI"Dir "+fn$:PROCScan(p$+in$+"."):OSCLI"Dir ^":ENDPROC
1030 ENDPROC
1040 :
1050 DEFPROCzip(ct%):IFt%=2:IFNOTrc%:ENDPROC
1060
1070 PROCaddDate:IFdate%:IFFNzdate(X%!15)<date%:ENDPROC
1080 load%=X%!2:exec%=X%!6:filesize%=X%!10:attr%=X%!14:IF(sj%AND1)=0:attr%=attr%AND-129
1090 mdate%=X%!15:mtime%=X%!17:cdate%=mdate%:ctime%=mtime%:acc%=0
1100 IFxtr%:cdate%=X%!20:ctime%=X%!22:acc%=X%!25
1110 :
1120 IFt%<>2:IFct%<>255:IFfilesize%:in%=OPENIN(fn$):IFin%=0:PRINT"Can't open '"in$"'.":ENDPROC
1130 name$=FNfn_zip(pre$+p$+name$):IFt%=2:name$=name$+"/"
1140 IFvb%:PRINT"Adding ";pre$;p$;in$;"... ";
1150 :
1160
1170
1180
1190
1200
1210
1220
1230
1240
1250
1260
1270
1280
1290
1300 :
1310
1320 !mem%=&04034B50:mem%!4=0:mem%!8=ct%:mem%!10=FNztime(mtime%)
1330 mem%!12=FNzdate(mdate%):mdt%=mem%!10:mem%!14=0:mem%!18=filesize%
1340 mem%!22=filesize%AND(t%<>2):mem%!26=LENname$:mem%!28=24-8*xtr%
1350 esz%=30+LENname$+mem%!28:$(mem%+30)=name$:extra%=mem%+30+LENname$
1360 !extra%=&4341:extra%!2=20-8*xtr%:extra%!4=&30435241
1370 extra%!8=load%:extra%!12=exec%:extra%!16=attr%:extra%!20=0
1380 extra%!24=FNztime(ctime%):extra%!26=FNzdate(cdate%):extra%!28=acc%
1390 PROCgbpb(wr%-1,out%,mem%,esz%,ptr0%):PROCtrans:IFin%:CLOSE#in%:in%=0
1400 :
1410
1420 !mem%=ct%AND(t%<>2):mem%!2=mdt%:mem%!6=crc%
1430 mem%!10=compsize%AND(t%<>2)AND(ct%<>255):PROCgbpb(wr%-1,out%,mem%,14,ptr0%+8)
1440 :
1450
1460 IFrst%:IFptr0%:!mem%=&100F4B50:mem%!4=ptr0%:PROCgbpb(wr%-1,out%,mem%,8,0)
1470 :
1480 ptr0%=ptr0%+esz%+compsize%:IFvb%:VDU8,8,8:PRINT"Done.":
1490
1500 ENDPROC
1510 :
1520 DEFPROCzipcatandeof:IFEXT#out%=0 OR nodir%:ENDPROC
1530
1540 cp%=EXT#out%:ep%=cp%:fp%=0:n%=0:IFvb%:PRINT"Finishing... ";
1550 REPEAT:lp%=fp%:IFvb%:PRINTFNsofar(lp%,ep%);
1560 :
1570
1580
1590
1600
1610
1620
1630
1640
1650
1660
1670
1680
1690
1700
1710
1720
1730
1740
1750
1760
1770 :
1780 PROCgbpb(rd%-1,out%,mem%+10,22,fp%+8) :
1790 PROCgbpb(rd%-1,out%,mem%+46,mem%?28+mem%?30,fp%+30) :
1800 fp%=fp%+30+mem%?28+mem%?30+mem%!20:!mem%=&02014B50:mem%!4=0:mem%!6=0
1810 mem%!32=0:mem%!36=0:mem%!38=&20:mem%!42=lp% :
1820 PROCgbpb(wr%-1,out%,mem%,46+mem%?28+mem%?30,ep%)
1830 n%=n%+1:ep%=ep%+46+mem%?28+mem%?30:UNTILfp%>=cp%
1840 :
1850
1860
1870
1880
1890
1900
1910
1920
1930
1940
1950
1960
1970
1980
1990 :
2000 !mem%=&06054B50:mem%!4=0:mem%!8=n%:mem%!10=n%:mem%!12=ep%-cp%
2010 mem%!16=cp%:mem%!20=0:PROCgbpb(wr%,out%,mem%,22,0)
2020 IFvb%:VDU8,8,8:PRINT"Done.":
2030 ENDPROC
2040 :
2050 DEFPROCaddDate:IFX%!15:ENDPROC:
2060 !zp%=X%!6:zp%!4=X%!2:PROCDate_ToOrd(zp%):IFyear%>1980:year%=(year%-1981)AND127 ELSE year%=0
2070 X%?15=day%+32*(year%DIV16):X%?16=month%+16*(year%AND15)
2080 X%?17=hour%:X%?18=minute%:X%?19=second%:X%!20=X%!15:X%?24=X%?19:ENDPROC
2090 :
2100 DEFPROCtrans:crc%=0:compsize%=0:IFfilesize%=0 OR t%=2 OR ct%=255:ENDPROC
2110 compsize%=filesize%:IFfilesize%<128:ct%=0
2120 copyend%=filesize%:crc%=-1:docrc%=TRUE:ptr%=0:IFos%=6:IFct%:PROCArcTrans
2130 REPEAT:IFvb%:PRINTFNsofar(ptr%,copyend%);
2140 len%=max%:IFptr%+len%>copyend%:len%=copyend%-ptr%
2150 PROCgbpb(rd%-1,in%,mem%,len%,ptr%):IFdocrc%:PROCCalcCRC
2160 PROCgbpb(wr%,out%,mem%,len%,0):ptr%=ptr%+len%:UNTILptr%>=copyend%
2170 crc%=NOTcrc%:ENDPROC
2180 :
2190 DEFPROCArcTrans:IFnoZip%:ENDPROC
2200 IFFNfile("<Wimp$Scrap>",5):OSCLI"Access <Wimp$Scrap>":OSCLI"Wipe <Wimp$Scrap> ~CFR~V"
2210 OSCLI"ZipCompress "+in$+" <Wimp$Scrap>":*SetType <Wimp$Scrap> Data
2220 CLOSE#in%:in%=0:in%=OPENIN("<Wimp$Scrap>")
2230 PROCgbpb(rd%-1,in%,zp%,4,EXT#in%-8):crc%=NOT!zp%:docrc%=FALSE:ptr%=44
2240 compsize%=EXT#in%-52:copyend%=compsize%+44:ct%=8:ENDPROC
2250 :
2260 DEFPROCChkFS:fs%=FNfs:sj%=((fs%=5)AND2)+((fs%=16)AND1):ENDPROC
2270 :
2280 DEFFNget16(A%):=BGET#A%+256*BGET#A%
2290 DEFFNget32(A%):zp%?0=BGET#A%:zp%?1=BGET#A%:zp%?2=BGET#A%:zp%?3=BGET#A%:=!zp%
2300 DEFPROCput32(A%):!zp%=A%:BPUT#out%,zp%?0:BPUT#out%,zp%?1:BPUT#out%,zp%?2:BPUT#out%,zp%?3:ENDPROC
2310 DEFPROCput16(A%):!zp%=A%:BPUT#out%,zp%?0:BPUT#out%,zp%?1:ENDPROC
2320 :
2330 DEFFNsofar(A%,B%):VDU8,8,8:PRINT FNd0(A%/(B%+1)*100,2);"%";:="":
2340 :
2350 DEFPROCInitZip:noZip%=TRUE:IFct%=0:ENDPROC
2360 IFos%<>6:ct%=0:ENDPROC:
2370 IFFNfile("<SparkFS$Dir>*.Resources.SparkFS",5)<>1:ct%=0:ENDPROC
2380 *RMEnsure SparkFS 0.00 Error SparkFS needs to be running
2390 *RMEnsure Zip 0.00 Error SparkFS needs to load Zip module
2400 noZip%=FALSE:ENDPROC
2410 :
2420 DEFPROCInitCRC:CRC%=CRC%:IFCRC%:ENDPROC
2430 IFHIMEM>&FFFF:PROCcrcARM:ENDPROC
2440 IF?&FFF7=&6C:PROCcrc65:ENDPROC
2450
2460 ENDPROC
2470 :
2480 DEFPROCCalcCRC:IFCRC%:!ad=mem%:!nm=len%:!cc=crc%:CALL CRC%:crc%=!cc:ENDPROC
2490
2500 S%=crc%:FORA%=mem%TOmem%+len%-1:S%=S%EOR?A%:FORZ%=1TO8:B%=S%:S%=(((S%+(S%<0))DIV2)AND&7FFFFFFF):IFB%AND1:S%=S%EOR&EDB88320
2510 IFvb%:IF(A%AND1023)=0:PRINTFNsofar(ptr%+A%-mem%,copyend%);
2520 NEXT:NEXT:crc%=S%:ENDPROC
2530 :
2540 DEFPROCcrc65:DIM CRC%63:ad=&70:nm=&72:cc=&74:FORP=0TO1
2550 P%=CRC%:[OPT P*2:.bl:LDX#8:LDA(ad-8,X):EORcc
2560 .rl:LSRcc+3:RORcc+2:RORcc+1:RORA:BCCcl
2570 TAY:LDAcc+3:EOR#&ED:STAcc+3:LDAcc+2:EOR#&B8:STAcc+2
2580 LDAcc+1:EOR#&83:STAcc+1:TYA:EOR#&20:.cl
2590 DEX:BNErl:INCad:BNEnx:INCad+1:.nx:STAcc
2600 LDAnm:BNEsk:DECnm+1:.sk:DECnm:BNEbl
2610 LDAnm+1:BNEbl:RTS:]:NEXT:ENDPROC
2620 :
2630
2640
2650
2660
2670
2680
2690
2700
2710
2720
2730 :
2740 DEFPROCcrcARM:DIM CRC%79:FORP=0TO1:P%=CRC%
2750 [OPT P*2:LDR R0,ad:LDR R1,nm:LDR R2,cc:LDR R3,xor
2760 .btlp:LDRB R4,[R0],#1:EOR R2,R2,R4:MOV R4,#8
2770 .rtlp:MOVS R2,R2,LSR #1:EORCS R2,R2,R3:SUBS R4,R4,#1:BNE rtlp
2780 SUBS R1,R1,#1:BNE btlp:STR R2,cc:MOV R15,R14
2790 .xor:EQUD&EDB88320:.ad:EQUD0:.nm:EQUD0:.cc:EQUD0:]:NEXT:ENDPROC
2800 :
2810
2820
2830
2840 :
2850
2860 :
2870
2880 DEFFNztime(A%):=(A%AND&1F)*&800+(A%AND&3F00)DIV8+(A%AND&3F0000)DIV&10000
2890 DEFFNzdate(A%):=(A%AND31)+(A%AND&F00)DIV8+((A%AND&F000)DIV8+(A%AND&E0)*256)+&200
2900 :
2910
2920 :
2930 DEFFNfn(A$):IFASCA$<>45:A%=INSTR(A$,":",3):IFA%:="-"+LEFT$(A$,A%-1)+"-"+MID$(A$,A%+1)
2940 =A$