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

Option Explicit
'////////////////////////////////////////////
'// Класс для чтения ZIP-файлов            //
'// Copyright (c) 05.03.2025 by HackerVlad //
'// e-mail: vladislavpeshkov@ya.ru         //
'// Версия: тестовая, полу-рабочая         //
'////////////////////////////////////////////
 
' Декларации 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 HackMSZIPSignature 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
 
Private Type HackedMSZIPBufferStructure
    BeginningHeader1 As Long           ' 4
    BeginningHeader2 As Integer        ' 6
    HackByte As Byte                   ' 7
    ContinuationHeader As Byte         ' 8
    UnCompressedSize As Long           ' 12
    NotSolved1 As Long                 ' 16
    UnCompressedLength As Long         ' 20
    NotSolved2 As Long                 ' 24
    CompressedSize As Long             ' 28
    MSZIPSignature As Integer          ' 30
    ' hidden padding 2 bytes As Integer  32
End Type
 
Private Enum COMPRESS_ALGORITHMS
    COMPRESS_ALGORITHM_MSZIP = 2
    COMPRESS_ALGORITHM_XPRESS = 3
    COMPRESS_ALGORITHM_XPRESS_HUFF = 4
    COMPRESS_ALGORITHM_LZMS = 5
End Enum
 
Public Enum AttributesInZip
    zipFileAttr
    zipFileDate
    zipFileTime
    zipFileDateAndTime
End Enum
 
Public Enum FileNameCodePageInZip
    zipCodePageAutoDetect
    zipCodePageCP866
    zipCodePageUTF8
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 hack As HackedMSZIPBufferStructure
                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
                                    
                                    ' Заполнить хакерскую структуру
                                    hack.BeginningHeader1 = &HC0E5510A
                                    hack.BeginningHeader2 = &H18
                                    hack.ContinuationHeader = &H2
                                    hack.UnCompressedSize = ZipFileHeader.UnCompressedSize
                                    hack.UnCompressedLength = ZipFileHeader.UnCompressedSize
                                    hack.CompressedSize = ZipFileHeader.CompressedSize + 2
                                    hack.MSZIPSignature = HackMSZIPSignature
                                    
                                    ReDim bArrayNew(ZipFileHeader.CompressedSize + 29)
                                    
                                    CopyMemory bArrayNew(0), hack, 30
                                    CopyMemory bArrayNew(30), bArray(30 + ZipFileHeader.FileNameLength + ZipFileHeader.ExtraFieldLength), ZipFileHeader.CompressedSize
                                    
                                    If CreateDecompressor(COMPRESS_ALGORITHM_MSZIP, 0, h) Then
                                        ReDim bData(hack.UnCompressedSize - 1)
                                        
                                        ' Взламываем неизвестный байт с помощью BruteForce атаки
                                        For i = 0 To 254
                                            bArrayNew(6) = i
                                            Decompress h, bArrayNew(0), UBound(bArrayNew) + 1, bData(0), hack.UnCompressedSize, bytesOut
                                            If bytesOut > 0 Then Exit For
                                        Next
                                        
                                        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

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Dim zip As New clsZipReader
 
Private Sub Form_Load()
    Dim i As Long
    
    zip.OpenZip App.Path & "\test.zip"
    
    For i = 1 To zip.CountFilesAndDirs
        List1.AddItem zip.List(i)
    Next
    
    List1.Selected(0) = True
    Label1.Caption = "Count files: " & zip.CountFiles
    If Me.Visible = True Then List1.SetFocus
End Sub
 
Private Sub List1_Click()
    Dim bytesData() As Byte
    Dim tick As Long
    
    tick = GetTickCount
    
    If zip.ExtractToMemory(List1.ListIndex + 1, bytesData) = True Then
        Label2.Caption = "ms: " & GetTickCount - tick
        Picture1.Picture = PictureFromBits(bytesData)
    Else
        Label2.Caption = "Ошибка загрузки"
        Picture1.Picture = LoadPicture("")
    End If
End Sub

    'Add a simple checksum value to the result header for corruption identification
'    Добавление простого значения контрольной суммы в заголовок результата для контроля повреждений.
    Char = 0
    For i = 0 To (ByteLen - 1)
        Char = Char Xor ByteArray(i)
    Next
    Result(ResultLen) = Char             
    ResultLen = ResultLen + 1