Как распаковать файл ZIP функциями из Cabinet.dll или чем отличается ZIP от MSZIP

Private Type CFHEADER
    Signature     As Long        ' MSCF (cabinet file signature )
    Res1          As Long        ' CRC 32 of the cab header
    cbCabinet     As Long        ' size of this cabinet file in bytes
    Res2          As Long        ' CRC 32 of the folder header
    coffFiles     As Long        ' offset of the first CFFILE entry
    Res3          As Long        ' CRC 32 of the Files header
    VerMinor      As Byte        ' cabinet file format version, minor
    VerMajor      As Byte        ' cabinet file format version, major
    cFolders      As Integer     ' number of CFFOLDER entries in this cabinet
    cFiles        As Integer     ' number of CFFILE entries in this cabinet
    flags         As Integer     ' cabinet file option indicators ' 1- has prev. cab. 2 - has next cab. 3 - has reserved area.
    setID         As Integer     ' must be the same for all cabinets in a set
    iCabinet      As Integer     ' number of this cabinet file in a set
End Type
 
Private Type CFFOLDER
    coffCabStart As Long
    cCFData As Integer
    typeCompress As Integer
End Type
 
Private Type CFFILE
    FileSize As Long
    FileOffset As Long
    FolderIndex As Integer
    FileDate As Integer
    FileTime As Integer
    Attributes As Integer
    FileName As Currency
    Padding As Byte
End Type
 
Private Type CFDATA
    CheckSum As Long
    CompSize As Integer
    UncompSize As Integer
End Type

Option Explicit
'////////////////////////////////////////////
'// Класс для чтения ZIP-файлов            //
'// Copyright (c) 10.03.2025 by HackerVlad //
'// e-mail: vladislavpeshkov@ya.ru         //
'// Версия 1.32.8                          //
'// Распаковывает файлы до 32768 байт      //
'////////////////////////////////////////////
 
' Декларации API ...
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
Private Declare Function CreateDecompressor Lib "cabinet" (ByVal Algorithm As COMPRESS_ALGORITHMS, ByVal AllocationRoutines As Long, hDecompressor As Long) As Long
Private Declare Function Decompress Lib "cabinet" (ByVal hCompressor As Long, CompressedData As Any, ByVal CompressedDataSize As Long, UncompressedBuffer As Any, ByVal UncompressedBufferSize As Long, bytesOut As Long) As Long
Private Declare Function CloseDecompressor Lib "cabinet" (ByVal hDecompressor As Long) As Long
 
' Константы ...
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 LocalFileHeaderSignature As Long = &H4034B50
Private Const MSZIPSignature As Integer = &H4B43
Private Const CP_UTF8 As Long = 65001
Private Const CP_OEMCP = 1 ' default to OEM code page
Private Const MB64 As Long = 67108864
 
' Структуры ...
Private Type zipLocalFileHeader
    LocalFileHeaderSignature As Long
    VersionNeededToExtract As Integer
    GeneralPurposeBitFlag As Integer
    CompressionMethod As Integer
    LastModFileTime As Integer
    LastModFileDate As Integer
    ' hidden padding 2 bytes As Integer
    CRC32 As Long
    CompressedSize As Long
    UnCompressedSize As Long
    FileNameLength As Integer
    ExtraFieldLength As Integer
End Type
 
Public Enum AttributesInZip
    zipFileAttr
    zipFileDate
    zipFileTime
    zipFileDateAndTime
End Enum
 
Public Enum FileNameCodePageInZip
    zipCodePageAutoDetect
    zipCodePageCP866
    zipCodePageUTF8
End Enum
 
Private Enum COMPRESS_ALGORITHMS
    COMPRESS_ALGORITHM_MSZIP = 2
    COMPRESS_RAW = &H20000000
End Enum
 
' Переменные для хранения внутри экземпляра класса
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
Dim zipFileOffSet As New Collection
Dim OpenedZIPFileName As String
 
' Открыть файл ZIP на чтение
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
    Dim RelativeOffsetOfLocalHeader 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 ' Если размер файла меньше 64 МБ то читать весь файл
                ReDim bArray(nFileSize - 1)
                ReadFile hFile, VarPtr(bArray(0)), nFileSize, dwBytesReaded, ByVal 0&
            Else ' Размер файла больше 64 МБ
                ReDim bArray(MB64 - 1)
                
                ' Прочитать только последние 64 МБ
                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
                    ' Загрузить в переменные данные из файла (я решил не использовать структуры)
                    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
                    If zipFileOffSet.Count > 0 Then Set zipFileOffSet = Nothing
                    
                    zipCountFiles = 0
                    zipCountDirs = 0
                    
                    For i = 1 To EntriesInTheCentralDir
                        GetMem4 bArray(OffSet), Signature
                        
                        If Signature = CentralFileHeaderSigniature Then
                            ' Получить всю необходимую информацию о файле
                            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
                            GetMem4 bArray(OffSet + 42), RelativeOffsetOfLocalHeader
                            
                            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&) ' Получить размер буфера в символах для кодировки DOS
                            MultiByteToWideChar CP_OEMCP, 0&, StrPtr(FileName), -1, StrPtr(FileNameCP866), nOutputCharLen ' Преобразовать кодировки
                            nOutputCharLen = 0
                            nOutputCharLen = MultiByteToWideChar(CP_UTF8, 0&, StrPtr(FileName), -1, 0&, 0&) ' Получить размер буфера в символах для кодировки UTF8
                            MultiByteToWideChar CP_UTF8, 0&, StrPtr(FileName), -1, StrPtr(FileNameUTF8), nOutputCharLen ' Преобразовать кодировки
                            
                            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 ' Авто-определение кодировок
                                    zipListFiles.Add FileNameCP866 ' Кодировка DOS
                                Else
                                    zipListFiles.Add FileNameUTF8 ' Кодировка UTF8
                                End If
                            Else ' Windows версии меньше чем Vista
                                zipListFiles.Add FileNameCP866 ' Кодировка DOS
                            End If
                            
                            zipListFilesCP866.Add FileNameCP866
                            zipListFilesUTF8.Add FileNameUTF8
                            zipFileAttributes.Add ExternalFileAttributes
                            zipFileDosDate.Add LastModFileDate
                            zipFileDosTime.Add LastModFileTime
                            zipFileSize.Add UnCompressedSize
                            zipFileSizeCompressed.Add CompressedSize
                            zipFileOffSet.Add RelativeOffsetOfLocalHeader
                            
                            If OpenZip = False Then
                                OpenedZIPFileName = ZipFileName
                                OpenZip = True
                            End If
                        End If
                    Next
                End If
            End If
        End If
        
        CloseHandle hFile
    End If
End Function
 
' Возвращает количество файлов и каталогов внутри ZIP
Public Property Get CountFilesAndDirs() As Long
    CountFilesAndDirs = EntriesInTheCentralDir
End Property
 
' Возвращает количество файлов внутри ZIP
Public Property Get CountFiles() As Long
    CountFiles = zipCountFiles
End Property
 
' Возвращает количество каталогов внутри ZIP
Public Property Get CountDirs() As Long
    CountDirs = zipCountDirs
End Property
 
' Возвращает список файлов внутри ZIP, по индексу
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
 
' Возвращает атрибуты файла внутри ZIP, по индексу
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
 
' Возвращает дату файла внутри ZIP, по индексу
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
 
' Возвращает время создания файла внутри ZIP, по индексу
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
 
' Возвращает размер файла внутри ZIP, по индексу
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
 
' Возвращает размер сжатого блока файла внутри ZIP, по индексу
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
 
' Возвращает имя открытого файла ZIP
Public Property Get GetOpenedZIPFileName() As String
    GetOpenedZIPFileName = OpenedZIPFileName
End Property
 
' Записывает в массив список файлов из ZIP
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
 
' Возвращает атрибуты файла внутри ZIP, а так же дату и время создания файлов
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
 
' Извлекает выбранный по индексу файл из архива ZIP в буфер байтового массива
Public Function ExtractToMemory(ByVal Index As Integer, bData() As Byte) As Boolean
    If zipFileOffSet.Count > 0 And Index > 0 Then
        If zipFileSizeCompressed(Index) > 32 Then
            If (zipFileAttributes(Index) And vbDirectory) = 0 Then
                Dim hFile As Long
                Dim dwBytesReaded As Long
                Dim ZipFileHeader As zipLocalFileHeader
                Dim bArray() As Byte
                Dim bArrayNew() As Byte
                Dim bytesOut As Long
                Dim h As Long
                Dim i As Byte
                
                hFile = CreateFileW(StrPtr(OpenedZIPFileName), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
                
                If hFile <> -1 And hFile <> 0 Then
                    ReDim bArray(zipFileSizeCompressed(Index) + 1024)
                    
                    SetFilePointer hFile, zipFileOffSet(Index), ByVal 0&, 1
                    ReadFile hFile, VarPtr(bArray(0)), zipFileSizeCompressed(Index) + 1024, dwBytesReaded, ByVal 0&
                    CloseHandle hFile
                    
                    If dwBytesReaded > 0 Then
                        CopyMemory ZipFileHeader, bArray(0), 14
                        CopyMemory ByVal VarPtr(ZipFileHeader) + 16, bArray(14), 14
                        
                        If ZipFileHeader.LocalFileHeaderSignature = LocalFileHeaderSignature Then
                            If ZipFileHeader.CompressedSize = zipFileSizeCompressed(Index) Then
                                If ZipFileHeader.UnCompressedSize = zipFileSize(Index) Then
                                    ' ZipFileHeader.GeneralPurposeBitFlag = 2050 это кодировка UTF8
                                    
                                    ReDim bArrayNew(ZipFileHeader.CompressedSize + 1)
                                    
                                    CopyMemory bArrayNew(0), MSZIPSignature, 2
                                    CopyMemory bArrayNew(2), bArray(30 + ZipFileHeader.FileNameLength + ZipFileHeader.ExtraFieldLength), ZipFileHeader.CompressedSize
                                    
                                    If CreateDecompressor(COMPRESS_ALGORITHM_MSZIP Or COMPRESS_RAW, 0, h) Then
                                        ReDim bData(ZipFileHeader.UnCompressedSize - 1)
                                        If ZipFileHeader.UnCompressedSize <= 32768 Then
                                            Decompress h, bArrayNew(0), UBound(bArrayNew) + 1, bData(0), ZipFileHeader.UnCompressedSize, bytesOut
                                        End If
                                        
                                        If bytesOut Then ExtractToMemory = True
                                        CloseDecompressor h
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End Function

Private Function pvInitRelocTable(uRtbl As ZipRelocTableType) As Long
    Dim lpThunk         As Long
    Dim vSplit          As Variant
    
    lpThunk = pvGetThunkAddress()
    vSplit = Split(STR_THUNK_OFFSETS, "|")
    With uRtbl
        .CompressInit = lpThunk + vSplit(zipRelCompressInit)
        .CompressCleanup = lpThunk + vSplit(zipRelCompressCleanup)
        .CompressBlock = lpThunk + vSplit(zipRelCompressBlock)
        .DecompressInit = lpThunk + vSplit(zipRelDecompressInit)
        .DecompressCleanup = lpThunk + vSplit(zipRelDecompressCleanup)
        .DecompressBlock = lpThunk + vSplit(zipRelDecompressBlock)
        .CalcCrc32 = lpThunk + vSplit(zipRelCalcCrc32)
        .MemNonce = lpThunk + vSplit(zipRelMemNonce)
        .MemXor = lpThunk + vSplit(zipRelMemXor)
        .ZipCrypt = lpThunk + vSplit(zipRelZipCrypt)
        .MallocImpl = GetProcAddress(GetModuleHandle(StrPtr("ole32")), "CoTaskMemAlloc")
        .ReallocImpl = GetProcAddress(GetModuleHandle(StrPtr("ole32")), "CoTaskMemRealloc")
        .FreeImpl = GetProcAddress(GetModuleHandle(StrPtr("ole32")), "CoTaskMemFree")
        .LenCodes = lpThunk + vSplit(zipRelLenCodes)
        .DistCodes = lpThunk + vSplit(zipRelDistCodes)
        .MirrorBytes = lpThunk + vSplit(zipRelMirrorBytes)
        .LenLenMap = lpThunk + vSplit(zipRelLenLenMap)
        .Crc32Table = pvGetCrc32Table()
    End With
End Function
 
Private Function pvGetThunkAddress() As Long
    Static lpThunk      As Long
    Dim baThunk()       As Byte
    Dim sBuffer         As String
    
    If lpThunk = 0 Then
        sBuffer = String$(50, 0)
        Call GetEnvironmentVariable(StrPtr("_ZIP_THUNK_" & GetCurrentProcessId() & "_" & STR_THUNK_BUILDDATE), StrPtr(sBuffer), Len(sBuffer) - 1)
        lpThunk = Val(sBuffer)
        If lpThunk = 0 Then
            pvGetThunkData baThunk
            lpThunk = VirtualAlloc(0, UBound(baThunk) + 1, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
            Call CopyMemory(ByVal lpThunk, baThunk(0), UBound(baThunk) + 1)
            Call SetEnvironmentVariable(StrPtr("_ZIP_THUNK_" & GetCurrentProcessId() & "_" & STR_THUNK_BUILDDATE), StrPtr(lpThunk))
        End If
    End If
    pvGetThunkAddress = lpThunk
End Function