Making the content list of files inside a Zip ?

[mdijkens]

Be aware that all versions above read filedata from the file entries itself. Which might be deleted/removed from the zipfile.
The correct central directory is at the end of the zip and gets rewritten everytime the zipfile is updated.
The central directory signature is Chr$(&H50) + Chr$(&H4B) + Chr$(&H01) + Chr$(&H02)

Also above code stops working with zipfiles larger then 2GB or ZIP64 extension

See below my version also retrieving date/time/size:

Code: (Select All)

Type fdType

  Date As String * 10

  Time As String * 8

  Size As _Unsigned _Integer64

  fName As String

End Type

ReDim Shared As fdType f(1000), d(1000)



Function processZip& (zipFile$)

  Const MAXCDIR = 2000000000

  Dim c As String

  Open zipFile$ For Binary Access Read As #1

  If LOF(1) < MAXCDIR Then

    c = String$(LOF(1), 0)

  Else

    c = String$(MAXCDIR, 0)

    Seek #1, LOF(1) - MAXCDIR + 1

  End If

  Get #1, , c

  Close #1

  Dim s As _Unsigned Long, fd As fdType, sig As String

  sig = Chr$(&H50) + Chr$(&H4B) + Chr$(&H01) + Chr$(&H02)

  fileCount& = 0: dirCount& = 0

  s = InStr(c, sig)

  Do

    If Mid$(c, s, 4) <> sig Then Exit Do

    tim~% = CVI(Mid$(c, s + 12, 2))

    th% = _ShR(tim~%, 11): tm% = _ShR(tim~%, 5) Mod (2 ^ 6): ts% = _ShL(tim~%, 1) Mod (2 ^ 6)

    dat~% = CVI(Mid$(c, s + 14, 2))

    dy% = 1980 + _ShR(dat~%, 9): dm% = _ShR(dat~%, 5) Mod (2 ^ 4): dd% = dat~% Mod (2 ^ 5)

    siz~&& = CVL(Mid$(c, s + 24, 4))

    flen~% = CVI(Mid$(c, s + 28, 2))

    xlen~% = CVI(Mid$(c, s + 30, 2))

    clen~% = CVI(Mid$(c, s + 32, 2))

    'iatt~% = CVI(Mid$(c, s + 36, 2))

    'xatt~% = CVL(Mid$(c, s + 38, 4))

    xfld$ = Mid$(c, s + 46 + flen~%, xlen~%)

    'cfld$ = Mid$(c, s + 46 + flen~% + xlen~%, clen~%)

    If xfld$ <> "" Then

      xtype~% = CVI(Left$(xfld$, 2))

      If xtype~% = 1 Then 'ZIP64

        'Print "xfld=";: For i% = 1 To xlen~%: Print Right$("0" + Hex$(Asc(xfld$, i%)), 2); " ";: Next i%: Print

        siz~&& = _CV(_Unsigned _Integer64, Mid$(xfld$, 5, 8))

        'Print siz~&&

      End If

    End If

    If th% < 24 And tm% < 60 And ts% < 60 And dy% < Val(Right$(Date$, 4)) And dm% > 0 And dm% < 13 And dd% > 0 And dd% < 32 And flen~% < 1024 And xlen~% <= 64 And clen~% < 1024 Then

      fd.fName = Mid$(c, s + 46, flen~%)

      fd.Date = LTrim$(Str$(dy%)) + "-" + Right$("0" + LTrim$(Str$(dm%)), 2) + "-" + Right$("0" + LTrim$(Str$(dd%)), 2)

      fd.Time = Right$("0" + LTrim$(Str$(th%)), 2) + ":" + Right$("0" + LTrim$(Str$(tm%)), 2) + ":" + Right$("0" + LTrim$(Str$(ts%)), 2)

      fd.Size = siz~&&

      'Print "Name="; fd.fName; "|"

      'Print "Date="; fd.Date;

      'Print " Time="; fd.Time;

      'Print " Size="; fd.Size

      'Print "iatt="; iatt~%, "xatt="; xatt~%

      'Print "flen="; flen~%; "xlen="; xlen~%; "clen="; clen~%

      'Print "Comment="; cfld$; "|"



      If Right$(fd.fName, 1) = "/" Then

        If dirCount& = UBound(d) Then ReDim _Preserve As fdType d(dirCount& + 1000)

        dirCount& = dirCount& + 1

        fd.Attrib = "D????"

        d(dirCount&) = fd

      Else

        If fileCount& = UBound(f) Then ReDim _Preserve As fdType f(fileCount& + 1000)

        fileCount& = fileCount& + 1

        fd.Attrib = ".????"

        f(fileCount&) = fd

      End If

      s = s + 46 + flen~% + xlen~% + clen~%

    Else

      s = InStr(s + 1, c, sig)

    End If

  Loop

  ReDim _Preserve As fdType d(dirCount&), f(fileCount&)

  processZip& = fileCount& + dirCount&

End Function