10 REM > ZipDiff 1.06
   20 REM Compare Zip archive with filing system
   30 REM v1.00 23-Jan-2002 JGH: Initial version
   40 REM v1.01 26-Mar-2002 JGH: Doesn't preserve zptr, adds if meta different
   50 REM v1.02 26-Mar-2002 JGH: Disabled since-date checking
   60 REM Needs flag to not output directories and granularity of time checking
   70 REM v1.03 24-Jul-2002 JGH: No output to delfile, doesn't scan for dels
   80 REM PROCadd doesn't use Spool, searches for zname>fname, /ZI matches /ZIP
   90 REM v1.04 17-Nov-2002 JGH: Try and get comparison working properly
  100 REM v1.05 25-Nov-2002 JGH: Doesn't compare ATTRs
  110 REM v1.06 20-Jan-2003 JGH: [Needs: Select what to compare]
  120 :
  130 DIM ctrl%30,data%80,extra%128,zp%6:A$=FNOS_GetEnv:in%=0:add%=0:del%=0
  140 quit$=FNcl(" -q",1):debug%=FNcl("-de",0):ON ERROR REPORT:PRINT:PROCend
  150 IF FNcl("-?",0):PRINT"Syntax: *ZipDiff zipfile inpath addlist dellist -debug -r -t dd/mm/yyyy -quit command":PROCend
  160 rc%=FNcl("-r",0):pre$=FNcl("-p",1):date$=FNcl("-t",1):xtr%=TRUE
  170 di%=NOTFNcl("-D",0):zip$=FNcl("",0):in$=FNcl("",0):list$=FNcl("",0):del$=FNcl("",0)
  180 IFpre$<>"":pre$=pre$+"."
  190 atm%=&FFFFFF00:REM attr% mask
  200 IFdebug%:PRINT" run$='"run$"'"'"quit$='"quit$"'"'" zip$='"zip$"'"'"  in$='"in$"'"'"list$='"list$"'"'"recurse=";rc%;"  date$='"date$"'"'" pre$='"pre$"'"
  210 :
  220 ON ERROR REPORT:PROCCloseAll:PRINT" at line ";ERL:PROCend
  230 X%=ctrl%:Y%=X%DIV256:sj%=FALSE:date%=0
  240 IF date$<>"":date%=VAL LEFT$(date$,2)+32*VAL MID$(date$,4,2)+512*(VAL MID$(date$,7)-1980)
  250 REM Only does dd/mm/yyyy; needs to allow mmddyyyy and yyyy/mm/dd
  260 REM In fact, is -t option needed at all?
  270 max%=HIMEM-LOMEM-8000:DIM mem% max%:wr%=2:rd%=4
  280 :
  290 A%=FNfile(zip$,5):IF(A%AND1)<>1:PRINT"Zipfile '"zip$"' not found":PROCend:END
  300 IFin$<>"":A%=FNfile(in$,5):IFA%<>2:PRINT"Dir. '"in$"' not found":PROCend:END
  310 in%=OPENIN(zip$):IFlist$<>"":add%=OPENOUT(list$)
  320 IFin$<>"":OSCLI"Dir "+in$
  330 sj%=FNfs=5:PROCScan("",0)
  340 PROCCloseAll:PROCend:END
  350 :
  360 DEFPROCCloseAll:*Exec
  370 IF in%:A%=in%:in%=0:CLOSE#A%
  380 IF add%:A%=add%:add%=0:CLOSE#A%
  390 IF del%:A%=del%:del%=0:CLOSE#A%
  400 ENDPROC
  410 :
  420 DEFPROCScan(p$,zptr%):LOCAL p%,r%
  430 PROCdebug("")
  440 PROCdebug("PROCScan "+pre$+p$)
  450 zt%=FNzfind(pre$+p$,PTR#in%)
  460 REM zptr%=PTR#in% - don't go back to dir start?
  470 REPEAT
  480   ?X%=0:X%!1=data%:X%!5=1:X%!9=p%:!data%=0:A%=8:CALL&FFD1
  490   r%=X%!5:p%=X%!9:IF r%=0:PROCRdName
  500 UNTIL r%=1
  510 REM Now scan zipdir
  520 ENDPROC
  530 :
  540 DEFPROCRdName:data%?(1+?data%)=13:in$=FNs($(data%+1)):IFASCin$=46:ENDPROC
  550 PROCdebug("")
  560 PROCdebug("PROCRdName "+in$)
  570 t%=0:t%=FNfile(in$,5):IFt%=3:t%=1
  580 PROCzipdiff:IFt%<>2:ENDPROC
  590 IFrc%:OSCLI"Dir "+in$:PROCScan(p$+in$+".",PTR#in%):OSCLI"Dir ^":ENDPROC
  600 ENDPROC
  610 :
  620 DEFPROCzipdiff:IFxtr%ORdate%ORsj%:PROCaddInfo
  630 REM if l&e date priority, check date, esp. for RO
  640 REM IFdate%:IFFNzdate(X%!15)<date%:ENDPROC
  650 :
  660 REM Now transfer info, as X%... may get overwritten:
  670 load%=X%!2:exec%=X%!6:filesize%=X%!10:compsize%=X%!10:attr%=X%!14
  680 mdate%=X%!15:mtime%=X%!17:cdate%=mdate%:ctime%=mtime%:acc%=0
  690 IFxtr%:cdate%=X%!20:ctime%=X%!22:acc%=X%!25
  700 :
  710 zt%=FNzfind(pre$+p$+in$+LEFT$(".",t%=2),PTR#in%)
  720 IFzt%=0:PROCdebug("NOT IN ZIP"):PROCadd(pre$+p$+in$):ENDPROC
  730 REM zptr%=PTR#in%:REM Update zptr, step through zipdir
  740 IFt%<>zt%:PROCdebug("TYPE:"+FNh0(t%,2)+":"+FNh0(zt%,2)+":"):PROCdel(pre$+p$+in$):PROCadd(pre$+p$+in$):ENDPROC
  750 :
  760 REM If metadata different, add
  770 REM zfile needs to note if metadata doen't exist
  780 IFt%=2:IFNOTdi%:ENDPROC
  790 IFFNdiff:PROCadd(pre$+p$+in$)
  800 ENDPROC
  810 :
  820 REM If time&date same, ignore
  830 IFFNzdate(mdate%)=zmdate% AND FNztime(mtime%)=zmtime%:ENDPROC
  840 REM If date is earlier, ignore
  850 IFFNzdate(mdate%)<zmdate%:ENDPROC
  860 REM If time earlier on same date, ignore
  870 IFFNzdate(mdate%)=zmdate% AND FNztime(mtime%)<zmtime%:ENDPROC
  880 REM File newer than zipfile entry
  890 PROCadd(pre$+p$+in$)
  900 ENDPROC
  910 :
  920 DEFFNdiff
  930 IFload%<>zload%:PROCdebug("LOAD:"+FNh0(load%,8)+":"+FNh0(zload%,8)+":"):=TRUE
  940 IFexec%<>zexec%:PROCdebug("EXEC:"+FNh0(exec%,8)+":"+FNh0(zexec%,8)+":"):=TRUE
  950 IFfilesize%<>zfilesize%:PROCdebug("SIZE:"+FNh0(filesize%,8)+":"+FNh0(zfilesize%,8)+":"):=TRUE
  960 REM IF(attr%ANDatm%)<>(zattr%ANDatm%):PROCdebug("ATTR:"+FNh0(attr%,8)+":"+FNh0(zattr%,8)+":"):=TRUE
  970 REM Ignore moddate:
  980 REM IFFNzdate(mdate%)<>zmdate%:PROCdebug("MDATE:"+FNh0(FNzdate(mdate%),4)+":"+FNh0(zmdate%,4)+":"):=TRUE
  990 REM Ignore modtime:
 1000 REM IFFNztime(mtime%)<>zmtime%:PROCdebug("MTIME:"+FNh0(FNztime(mtime%),4)+":"+FNh0(zmtime%,4)+":"):=TRUE
 1010 REM Ignore creation times/dates:
 1020 REM IFFNzdate(cdate%)<>zcdate%:PROCdebug("CDATE:"+FNh0(FNzdate(cdate%),4)+":"+FNh0(zcdate%,4)+":"):=TRUE
 1030 REM IFFNztime(ctime%)<>zctime%:PROCdebug("CTIME:"+FNh0(FNztime(ctime%),4)+":"+FNh0(zctime%,4)+":"):=TRUE
 1040 =FALSE
 1050 :
 1060 REM Metadata:
 1070 REM modtime/moddate crc compsize filesize extra1 extra2[load] extra3[exec] extra4[attr] extra5[0] extra6[ctime/cdate] extra7[account]
 1080 REM modtime moddate filesize load exec attr 0 ctime cdate account
 1090 REM load exec len attrs mdate mtime cdate ctime account
 1100 :
 1110 DEFPROCaddInfo
 1120 REM Needs to check HADFS, etc.
 1130 REM Should put l&e date into X%!15 for default
 1140 PROCFSExam(64):IF data%?3=0:X%!15=data%!10:X%?19=data%?14:X%!20=data%!5:X%?24=data%?9:REM Find mod & cret time&dates
 1150 PROCFSExam(65):IF data%?3=0:X%!25=data%!5:REM Acc numbers
 1160 PROCFSExam(4):IF data%?3=0:accessbyte=data%?6
 1170 ENDPROC
 1180 :
 1190 DEFPROCFSExam(A%):LOCAL X%,Y%:X%=data%:Y%=X%DIV256
 1200 !X%=0:X%?1=9+LEN in$:X%!3=18:X%?7=A%:$(X%+8)=in$:A%=&14:CALL&FFF1:ENDPROC
 1210 :
 1220 DEFFNconvertname(A$)
 1230 IF INSTR(A$,".")+INSTR(A$,"/")=0:=A$
 1240 FOR A%=1TOLEN A$:B%=ASC MID$(A$,A%,1):IF(B%AND&FE)=46:A$=LEFT$(A$,A%-1)+CHR$(B%EOR1)+MID$(A$,A%+1)
 1250 NEXT:=A$
 1260 :
 1270 REM Convert fs date/time to zip date/time:
 1280 DEFFNztime(A%):=(A%AND&1F)*&800+(A%AND&3F00)DIV8+(A%AND&3F0000)DIV&20000
 1290 DEFFNzdate(A%):=(A%AND31)+(A%AND&F00)DIV8+((A%AND&F000)DIV8+(A%AND&E0)*256)+&200
 1300 :
 1310 REM zfind() searches through zip from current ptr%
 1320 REM returns 0=nf, 1=file, 2=dir
 1330 REM should:
 1340 REM  if in same dir, and zobject>lookobject, return notfound
 1350 REM  if different dir, if zdir>lookdir, return notfound
 1360 :
 1370 DEFFNzfind(fn$,ptr%):LOCAL zname$,leaf%,found%,notfd%,zptr%
 1380 fn$=FNup(fn$):PTR#in%=ptr%:zptr%=ptr%:IFfn$="":=2:REM Start of zipfile
 1390 path%=LENfn$+1:REPEATpath%=path%-1:UNTILMID$(fn$,path%,1)="." OR path%<1
 1400 leaf%=LENfn$-path%
 1410 PROCdebug("Look for "+fn$)
 1420 REPEAT
 1430     ptr%=PTR#in%:id%=FNget32
 1440     IFid%=&04034B50:PROCzfound
 1450 UNTILid%=&02014B50 OR id%=&06054B50 OR EOF#in% OR found% OR notfd%
 1460 PTR#in%=ptr%
 1470 REM IFNOTfound%:PTR#in%=ptr%:REM If found, doesn't move PTR backwards
 1480 REM IFNOTfound% OR notfd%:PTR#in%=zptr%
 1490 IFfound%:=1-(RIGHT$(fn$,1)=".") ELSE =0
 1500 :
 1510 DEFPROCzfound
 1520 PROCzfile:zname$=FNup(zname$)
 1530 REM fn$=LOOKNAME, zname$=ZIPNAME, leaf%=length of LOOKLEAF
 1540 :
 1550 PROCdebug("Scanning "+zname$)
 1560 :
 1570 REM found exact match:
 1580 IFfn$=zname$:found%=TRUE:ENDPROC
 1590 :
 1600 REM match path.filename/z with path.filename/zip:
 1610 IFleaf%=10:IFINSTR(fn$,"/",path%):IFfn$=LEFT$(zname$,LENfn$):IFLENzname$-LENfn$<3:found%=TRUE:ENDPROC
 1620 :
 1630 REM Same directory, found entry after the one looked for:
 1640 IFpath%:IFLEFT$(fn$,path%)=LEFT$(zname$,path%):notfd%=MID$(zname$,path%)>MID$(fn$,path%):ENDPROC
 1650 :
 1660 REM Must be a different directory
 1670 A%=0:REPEATA%=A%+1:UNTILMID$(fn$,A%,1)<>MID$(zname$,A%,1)
 1680 REPEATA%=A%-1:UNTILMID$(zname$,A%,1)="." OR A%<1
 1690 B%=INSTR(zname$+".",".",A%+1)-1
 1700 A%=INSTR(fn$+".",".",A%+1)-1
 1710 :
 1720 PROCdebug("checking:"+LEFT$(fn$,A%))
 1730 PROCdebug("checking:"+LEFT$(zname$,B%))
 1740 :
 1750 IFpath%:IFA%:IFB%:notfd%=LEFT$(zname$,B%)>LEFT$(fn$,A%):ENDPROC
 1760 :
 1770 REM Keep scanning:
 1780 ENDPROC
 1790 :
 1800 DEFPROCzfile
 1810 zver%=FNget16:zflags%=FNget16:zcomptype%=FNget16
 1820 zmtime%=FNget16:zmdate%=FNget16:zcrc%=FNget32
 1830 zcompsize%=FNget32:zfilesize%=FNget32
 1840 znamelen%=FNget16:zextralen%=FNget16
 1850 zname$="":FORx%=0 TO 127 STEP4:extra%!x%=0:NEXT
 1860 IFznamelen%:FORx%=1 TO znamelen%:zname$=zname$+CHR$BGET#in%:NEXT
 1870 IFzextralen%:FORx%=0 TO zextralen%-1:extra%?x%=BGET#in%:NEXT
 1880 zhdrid%=FNex16(0):zdsz%=FNex16(2)
 1890 zsig%=extra%!4:zload%=extra%!8:zexec%=extra%!12:zattr%=extra%!16
 1900 zctime%=FNex16(24):zcdate%=FNex16(26):zacc%=FNex16(28):zaux%=FNex16(30)
 1910 REM hdrid%=&4341 -> Created on Acorn computer
 1920 REM dsz% usually =&14, ie 20 bytes of extra data
 1930 REM sig%='ARC0'  -> Archive
 1940 zname$=FNconvertname(zname$)
 1950 PTR#in%=PTR#in%+zcompsize%:IF(zflags%AND8):PTR#in%=PTR#in%+12
 1960 ENDPROC
 1970 :
 1980 DEFFNex16(A%)=extra%!A% AND &FFFF
 1990 DEFFNget32
 2000 zp%?0=BGET#in%:zp%?1=BGET#in%:zp%?2=BGET#in%:zp%?3=BGET#in%:=!zp%
 2010 DEFFNget16
 2020 =BGET#in%+(&100*BGET#in%)
 2030 :
 2040 DEFPROCputS(out%,A$):IFA$="" OR out%=0:ENDPROC
 2050 LOCAL A%:FOR A%=1TOLENA$:BPUT#out%,ASCMID$(A$,A%,1):NEXT:ENDPROC
 2060 :
 2070 DEFPROCadd(A$):PROCdebug("Adding"):PROCputS(add%,A$+CHR$13):ENDPROC
 2080 DEFPROCdel(A$):PROCdebug("Deling"):PROCputS(del%,A$+CHR$13):ENDPROC
 2090 :
 2100 DEFPROCdebug(A$):IFdebug%=0:ENDPROC
 2110 PRINTA$
 2120 ENDPROC
 2130 :
 2140 DEFFNbyte(A%,X%,Y%)=((USR&FFF4)AND&FF00)DIV256
 2150 DEFFNfs:LOCAL A%,Y%,E%:=(USR&FFDA)AND&FF
 2160 :
 2170 DEFPROCend:IFquit$<>"":A$=quit$:quit$="":PROCos(A$+LEFT$(" "+STR$ERR,ERR<>0))
 2180 END:ENDPROC
 2190 DEFFNfile(A$,A%):$data%=A$:?X%=data%:X%?1=data%DIV256:=(USR&FFDD)AND&FF
 2200 DEFFNOS_GetEnv:A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256
 2210 A%=(HIMEM>&FFFF)AND&900:A%=((PAGE>&9FFF)ANDA%)OR((&1400-PAGE)AND(A%=0)):IF?(TOP-3)ELSEA%=&B00
 2220 A$=$(PAGE-&E00+A%):IFA%=0:run$=A$:SYS16TOA$,,A%:SYS72,"",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):IFLENA$=0:A$=run$
 2230 FORY%=-1TO0:A$=" "+A$:REPEATA$=MID$(A$,2):UNTILASCA$<>32
 2240   IFY%:IFASCA$=34:A%=INSTR(A$,"""",2)+1 ELSE IFY%:A%=INSTR(A$+" "," ")
 2250   IFY%:run$=MID$(A$,1-(ASCA$=34),A%-1+2*(ASCA$=34)):IFrun$<>"":A$=MID$(A$,A%+1)
 2260 NEXT:=A$
 2270 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFA$<>"":CHAINA$
 2280 ENDPROC
 2290 DEFFNcl(l$,n%):IF l$="":I%=INSTR(A$+" "," "):l$=LEFT$(A$,I%-1):A$=FNs(MID$(A$,I%+1)):=l$
 2300 IF ASC l$=32 AND A$<>"":A$=" "+A$
 2310 I%=INSTR(A$,l$):l$="":IF I%>0ANDn%>0:l$=MID$(A$,INSTR(A$+" "," ",I%+1)+1):IF MID$(A$,I%,1)<>" ":l$=LEFT$(l$,INSTR(l$+" "," ")-1)
 2320 IF I%:IF MID$(A$,I%,1)=" ":A$=MID$(A$,2+(ASC A$<>32),I%-2-(I%=1)) ELSE IF I%:A$=LEFT$(A$,I%-1)+MID$(A$,INSTR(A$+" "," ",INSTR(A$+" "," ",I%)+LEN l$)+1)
 2330 A$=FNs(A$):IF n%:=FNs(l$) ELSE =I%<>0
 2340 DEFFNs(A$):IF LEFT$(A$,1)=" ":REPEAT A$=MID$(A$,2):UNTIL LEFT$(A$,1)<>" "
 2350 IF RIGHT$(A$,1)=" ":REPEAT A$=LEFT$(A$,LEN A$-1):UNTIL RIGHT$(A$,1)<>" "
 2360 =A$
 2370 DEFFNup(A$):IFA$="":=""
 2380 LOCALA%,B%:FORA%=1TOLENA$:B%=ASCMID$(A$,A%,1):IFB%>95:A$=LEFT$(A$,A%-1)+CHR$(B%-32)+MID$(A$,A%+1)
 2390 NEXT:=A$
 2400 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
65449 
  162  CLGOSCLITRUE4{ATNRECTANGLELOADLEFT$( PAGEREPEATEVALORLNPOSPROCATNINSTALLRECTANGLELOADWHEN PAGEREPORTATNINSTALLRECTANGLELEN"™  Z{¢A {L÷ÿQ%=PA.:CH."* BASIC Y{M{n{ORLENFNLNTRUERECTANGLEGCOLLNFNLEN`EVALORIGINTRUEPRIVATEELLIPSELNTRUEG{ATNPRIVATEELLIPSETAB(ATNG{STEPEXITVDU`WHENOSCLIPLOTFILLLEN`LINEINTORLEN Z{,zELLIPSE0EVALELLIPSEPOSINTERRORLNLOADPOSINTERRORLOGEVALTRUEWHENVTIMELNLOADPAGERETURNGCOLLOGONPAGE{EXITPRINTLENCIRCLE`LENPTR QUITMOUSEPAGERUNLENELLIPSE
43178   eLENINTLENCIRCLE QUITMOUSEEVAL SOUND{ SOUND{TRUEWHENV2302PAGEPRINTONMID$({EXITMOVELENPTR QUITMOUSELENCIRCLE`

Download ZipDiff

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.