Class for reading ZIP files

Hello everyone

I have written a mini-class for reading information about files contained inside a ZIP. My class reads file attributes, date and time of files stored inside a ZIP.

• It even works in Windows 98
• Opens all files, even DOCX format
• Automatically detects the encoding of file names inside the ZIP (DOS or UTF-8 encoding)
• Gets a list of files inside the ZIP
• Opens even SFX-EXE files for reading
• Gets file attributes and date and time
• Supports large files over 500 MB
• Supports unicode file names

Last update: 2025-03-02, posted version 1.2

Class code:

Code:

---

Option Explicit
'////////////////////////////////////////////
'// Class for reading ZIP files            //
'// Copyright (c) 2025-03-02 by HackerVlad //
'// e-mail: [email protected]        //
'// Version 1.2                            //
'////////////////////////////////////////////

' API declarations ...
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetMem2 Lib "msvbvm60" (src As Any, dst As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) As Long

' Constants ...
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_SHARE_READ = &H1
Private Const GENERIC_READ As Long = &H80000000
Private Const CREATE_ALWAYS = 2
Private Const EndOFCentralDirSignature As Long = &H6054B50
Private Const CentralFileHeaderSigniature As Long = &H2014B50
Private Const CP_UTF8 As Long = 65001
Private Const CP_OEMCP = 1 ' Default to OEM code page
Private Const MB64 As Long = 67108864

Public Enum AttributesInZip
    zipFileAttr
    zipFileDate
    zipFileTime
    zipFileDateAndTime
End Enum

Public Enum FileNameCodePageInZip
    zipCodePageAutoDetect
    zipCodePageCP866
    zipCodePageUTF8
End Enum

' Variables to store inside an instance of a class
Dim EntriesInTheCentralDir As Integer
Dim zipCountFiles As Integer
Dim zipCountDirs As Integer
Dim zipListFiles As New Collection
Dim zipListFilesCP866 As New Collection
Dim zipListFilesUTF8 As New Collection
Dim zipFileAttributes As New Collection
Dim zipFileDosDate As New Collection
Dim zipFileDosTime As New Collection
Dim zipFileSize As New Collection
Dim zipFileSizeCompressed As New Collection

' Open the ZIP file for reading
Public Function OpenZip(ByVal ZipFileName As String) As Boolean
    Dim hFile As Long
    Dim dwBytesReaded As Long
    Dim nFileSize As Long
    Dim bArray() As Byte
    Dim i As Long
    Dim signature As Long
    Dim FileName As String
    Dim FileNameCP866 As String
    Dim FileNameUTF8 As String
    Dim OffSet As Long
    Dim FileNameLength As Integer
    Dim LastModFileTime As Integer
    Dim LastModFileDate As Integer
    Dim CompressedSize As Long
    Dim UnCompressedSize As Long
    Dim ExtraFieldLength As Integer
    Dim FileCommentLength As Integer
    Dim ExternalFileAttributes As Long
    Dim nOutputCharLen As Long
    Dim numread As Long
    Dim SetNewPosition As Long
    Dim MajorWindowsVersion As Long
   
    hFile = CreateFileW(StrPtr(ZipFileName), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hFile = 0 Then hFile = CreateFileA(ZipFileName, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
   
    If hFile <> -1 And hFile <> 0 Then
        nFileSize = GetFileSize(hFile, ByVal 0&)
       
        If nFileSize <> -1 Then
            If nFileSize <= MB64 Then ' If the file size is less than 64 MB, then read the entire file
                ReDim bArray(nFileSize - 1)
                ReadFile hFile, VarPtr(bArray(0)), nFileSize, dwBytesReaded, ByVal 0&
            Else ' The file size is more than 64 MB
                ReDim bArray(MB64 - 1)
               
                ' Read only the last 64 MB
                SetNewPosition = nFileSize - MB64
                SetFilePointer hFile, SetNewPosition, ByVal 0&, 1
                ReadFile hFile, VarPtr(bArray(0)), MB64, dwBytesReaded, ByVal 0&
            End If
           
            If dwBytesReaded > 0 Then
                For i = UBound(bArray) - 3 To LBound(bArray) Step -1
                    GetMem4 bArray(i), signature
                   
                    If signature = EndOFCentralDirSignature Then
                        Exit For
                    End If
                Next
               
                If i > 0 Then
                    ' Load data from a file into variables (I decided not to use structures)
                    GetMem2 bArray(i + 10), EntriesInTheCentralDir
                    GetMem4 bArray(i + 16), OffSet
                   
                    If SetNewPosition > 0 Then
                        OffSet = OffSet - SetNewPosition
                    End If
                   
                    GetMem4 ByVal &H7FFE026C, MajorWindowsVersion
                   
                    If zipListFiles.Count > 0 Then Set zipListFiles = Nothing
                    If zipListFilesCP866.Count > 0 Then Set zipListFilesCP866 = Nothing
                    If zipListFilesUTF8.Count > 0 Then Set zipListFilesUTF8 = Nothing
                    If zipFileAttributes.Count > 0 Then Set zipFileAttributes = Nothing
                    If zipFileDosDate.Count > 0 Then Set zipFileDosDate = Nothing
                    If zipFileDosTime.Count > 0 Then Set zipFileDosTime = Nothing
                    If zipFileSize.Count > 0 Then Set zipFileSize = Nothing
                    If zipFileSizeCompressed.Count > 0 Then Set zipFileSizeCompressed = Nothing
                   
                    zipCountFiles = 0
                    zipCountDirs = 0
                   
                    For i = 1 To EntriesInTheCentralDir
                        GetMem4 bArray(OffSet), signature
                       
                        If signature = CentralFileHeaderSigniature Then
                            ' Get all the necessary information about the file
                            GetMem2 bArray(OffSet + 12), LastModFileTime
                            GetMem2 bArray(OffSet + 14), LastModFileDate
                            GetMem4 bArray(OffSet + 20), CompressedSize
                            GetMem4 bArray(OffSet + 24), UnCompressedSize
                            GetMem2 bArray(OffSet + 28), FileNameLength
                            GetMem2 bArray(OffSet + 30), ExtraFieldLength
                            GetMem2 bArray(OffSet + 32), FileCommentLength
                            GetMem4 bArray(OffSet + 38), ExternalFileAttributes
                           
                            OffSet = OffSet + 46
                           
                            FileName = String$(FileNameLength, vbNullChar)
                            CopyMemory ByVal StrPtr(FileName), bArray(OffSet), FileNameLength
                           
                            OffSet = OffSet + FileNameLength + ExtraFieldLength + FileCommentLength
                           
                            FileNameCP866 = Space$(FileNameLength)
                            FileNameUTF8 = Space$(FileNameLength)
                           
                            nOutputCharLen = MultiByteToWideChar(CP_OEMCP, 0&, StrPtr(FileName), -1, 0&, 0&) ' Get the buffer size in characters for DOS encoding
                            MultiByteToWideChar CP_OEMCP, 0&, StrPtr(FileName), -1, StrPtr(FileNameCP866), nOutputCharLen ' Convert Encodings
                            nOutputCharLen = 0
                            nOutputCharLen = MultiByteToWideChar(CP_UTF8, 0&, StrPtr(FileName), -1, 0&, 0&) ' Get the buffer size in characters for UTF8 encoding
                            MultiByteToWideChar CP_UTF8, 0&, StrPtr(FileName), -1, StrPtr(FileNameUTF8), nOutputCharLen ' Convert Encodings
                           
                            FileNameUTF8 = Left$(FileNameUTF8, nOutputCharLen - 1)
                            FileNameCP866 = Replace$(FileNameCP866, "/", "\")
                            FileNameUTF8 = Replace$(FileNameUTF8, "/", "\")
                           
                            If (ExternalFileAttributes And vbDirectory) <> 0 Then
                                zipCountDirs = zipCountDirs + 1
                            Else
                                zipCountFiles = zipCountFiles + 1
                            End If
                           
                            If MajorWindowsVersion >= 6 And MajorWindowsVersion < 600 Then
                                If FileNameUTF8 Like "*[" & ChrW(-3) & "]*" Then ' Auto-detect encodings
                                    zipListFiles.Add FileNameCP866 ' DOS encoding
                                Else
                                    zipListFiles.Add FileNameUTF8 ' UTF8 encoding
                                End If
                            Else ' Windows versions are smaller than Vista
                                zipListFiles.Add FileNameCP866 ' DOS encoding
                            End If
                           
                            zipListFilesCP866.Add FileNameCP866
                            zipListFilesUTF8.Add FileNameUTF8
                            zipFileAttributes.Add ExternalFileAttributes
                            zipFileDosDate.Add LastModFileDate
                            zipFileDosTime.Add LastModFileTime
                            zipFileSize.Add UnCompressedSize
                            zipFileSizeCompressed.Add CompressedSize
                           
                            If OpenZip = False Then OpenZip = True
                        End If
                    Next
                End If
            End If
        End If
       
        CloseHandle hFile
    End If
End Function

' Returns the number of files and directories inside a ZIP
Public Property Get CountFilesAndDirs() As Long
    CountFilesAndDirs = EntriesInTheCentralDir
End Property

' Returns the number of files inside the ZIP
Public Property Get CountFiles() As Long
    CountFiles = zipCountFiles
End Property

' Returns the number of directories inside a ZIP
Public Property Get CountDirs() As Long
    CountDirs = zipCountDirs
End Property

' Retrieves the list of files inside the ZIP, by index
Public Property Get List(ByVal Index As Integer, Optional ByVal CodePage As FileNameCodePageInZip) As String
    If zipListFiles.Count > 0 And Index > 0 Then
        If CodePage = zipCodePageAutoDetect Then
            List = zipListFiles(Index)
        ElseIf CodePage = zipCodePageCP866 Then
            List = zipListFilesCP866(Index)
        ElseIf CodePage = zipCodePageUTF8 Then
            List = zipListFilesUTF8(Index)
        End If
    End If
End Property

' Returns file attributes inside a ZIP, by index
Public Property Get FileAttributes(ByVal Index As Integer) As Long
    If zipFileAttributes.Count > 0 And Index > 0 Then
        FileAttributes = zipFileAttributes(Index)
    End If
End Property

' Returns the date of the file inside the ZIP, by index
Public Property Get FileDosDate(ByVal Index As Integer) As Integer
    If zipFileDosDate.Count > 0 And Index > 0 Then
        FileDosDate = zipFileDosDate(Index)
    End If
End Property

' Returns the creation time of the file inside the ZIP, by index
Public Property Get FileDosTime(ByVal Index As Integer) As Integer
    If zipFileDosTime.Count > 0 And Index > 0 Then
        FileDosTime = zipFileDosTime(Index)
    End If
End Property

' Returns the size of the file inside the ZIP, by index
Public Property Get FileSize(ByVal Index As Integer) As Long
    If zipFileSize.Count > 0 And Index > 0 Then
        FileSize = zipFileSize(Index)
    End If
End Property

' Returns the size of the compressed file block inside the ZIP, by index
Public Property Get FileSizeCompressed(ByVal Index As Integer) As Long
    If zipFileSizeCompressed.Count > 0 And Index > 0 Then
        FileSizeCompressed = zipFileSizeCompressed(Index)
    End If
End Property

' Retrieves the list of files inside the ZIP and writes it to the array
Public Function ListFiles(arrFileNames() As String, Optional ByVal CodePage As FileNameCodePageInZip) As Boolean
    Dim i As Integer
   
    If zipListFiles.Count > 0 Then
        ReDim arrFileNames(zipListFiles.Count - 1)
       
        For i = 1 To zipListFiles.Count
            If CodePage = zipCodePageAutoDetect Then
                arrFileNames(i - 1) = zipListFiles(i)
            ElseIf CodePage = zipCodePageCP866 Then
                arrFileNames(i - 1) = zipListFilesCP866(i)
            ElseIf CodePage = zipCodePageUTF8 Then
                arrFileNames(i - 1) = zipListFilesUTF8(i)
            End If
        Next
       
        ListFiles = True
    End If
End Function

' Returns the file attributes inside the ZIP, as well as the date and time the files were created
Public Property Get GetFileAttributesInZip(ByVal FileNameInZip As String, Optional ByVal AttrInZip As AttributesInZip) As Long
    Dim i As Integer
   
    If zipListFilesCP866.Count > 0 Then
        For i = 1 To zipListFilesCP866.Count
            If zipListFilesCP866(i) = FileNameInZip Then
                GoTo Subroutine
                Exit For
            End If
        Next
    End If
    If zipListFilesUTF8.Count > 0 Then
        For i = 1 To zipListFilesUTF8.Count
            If zipListFilesUTF8(i) = FileNameInZip Then
                GoTo Subroutine
                Exit For
            End If
        Next
    End If
    Exit Property
Subroutine:
    If AttrInZip = zipFileAttr Then
        GetFileAttributesInZip = zipFileAttributes(i)
    ElseIf AttrInZip = zipFileDate Then
        GetFileAttributesInZip = zipFileDosDate(i)
    ElseIf AttrInZip = zipFileTime Then
        GetFileAttributesInZip = zipFileDosTime(i)
    ElseIf AttrInZip = zipFileDateAndTime Then
        GetFileAttributesInZip = ((zipFileDosTime(i) And &H7FFF&) * &H10000) Or (zipFileDosDate(i) And &HFFFF&) Or (&H80000000 And zipFileDosTime(i) < 0)
    End If
End Property

---

Form code:

Code:

---

Option Explicit
Private Declare Function DosDateTimeToFileTime Lib "kernel32" (ByVal wFatDateAndwFatTime As Integer, ByVal wFatTime As Integer, lpFileTime As Currency) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As Currency, lpSystemTime As SYSTEMTIME) As Long

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Dim zip As New clsZipReader

Private Function FileTimeToString(ByVal DosDate As Integer, ByVal DosTime As Integer) As String
    Dim FILETIME As Currency
    Dim ST As SYSTEMTIME
   
    DosDateTimeToFileTime DosDate, DosTime, FILETIME
   
    If FILETIME > 0 Then
        FileTimeToSystemTime FILETIME, ST
        FileTimeToString = Format(ST.wDay & "." & ST.wMonth & "." & ST.wYear & " " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond, "yyyy-mm-dd  hh:mm:ss")
    End If
End Function

Private Sub ReadZip(ByVal FileName As String)
    Dim i As Integer, LenLongFileName As Integer
   
    If zip.OpenZip(FileName) = True Then
        If zip.CountFilesAndDirs > 0 Then
            Cls
            Print "CountFilesAndDirs: " & zip.CountFilesAndDirs
            Print "CountFiles: " & zip.CountFiles
            Print "CountDirs: " & zip.CountDirs
           
            If List1.ListCount > 0 Then List1.Clear
           
            ' For the beauty of table alignment, let's find the longest FileName and remember it
            For i = 1 To zip.CountFilesAndDirs
                If i <> 1 Then
                    If LenLongFileName < Len(zip.List(i)) And Len(zip.List(i)) > Len(zip.List(i - 1)) Then LenLongFileName = Len(zip.List(i))
                Else
                    LenLongFileName = Len(zip.List(i))
                End If
            Next
           
            ' Create a beautiful list
            For i = 1 To zip.CountFilesAndDirs
                List1.AddItem zip.List(i) & "  " & Space$(LenLongFileName - Len(zip.List(i))) & FileTimeToString(zip.FileDosDate(i), zip.FileDosTime(i)) & "  Attr: " & zip.FileAttributes(i) & "  Size: " & zip.FileSize(i)
            Next
           
            List1.Selected(0) = True
            If Me.Visible = True Then List1.SetFocus
        End If
    Else
        Beep
    End If
End Sub

Private Sub Command1_Click()
    Dim FileName As String
   
    FileName = GetDialogFileName(OFEOpenForLoad, "All files" & vbNullChar & "*.*" & vbNullChar, hWnd, App.Path)
   
    If Len(FileName) > 0 Then
        ReadZip FileName
        Text1.Text = FileName
    Else
        List1.SetFocus
    End If
End Sub

Private Sub Form_Load()
    ReadZip App.Path & "\test.zip"
    Text1.Text = App.Path & "\test.zip"
End Sub

Private Sub List1_Click()
    Label1.Caption = "FileSizeCompressed: " & zip.FileSizeCompressed(List1.ListIndex + 1)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        KeyAscii = 0
        ReadZip Text1.Text
    End If
End Sub

---

I wrote this class for myself, just because I needed to find out the attributes of files inside archives. Just for this purpose. I didn't even expect everyone to like my simple implementation so much. Since everyone liked my work so much, then I will write another version, a little more expanded.

Hello, everyone who is reading this!

I'm surprised that my little class for reading ZIP files has already received so many views!
Later, I will write a new version where decompression of the ZIP buffer using the API will already be implemented, while I am studying a new technology for decompressing the buffer using new APIs that work starting from Windows 8. But decompression will be very fast.

good job
work fine