Работа с zip архивами

Option Explicit
'=======
'Cabinet version 1.1
'=======
'
'Requires Windows 8 or later.
'
'Not entirely complete:
'
'   o COMPRESS_INFORMATION_CLASS_LEVEL is not working and so we can't support high
'     XPRESS and XPRESS_HUFF compression.
'
'   o Have not attempted using COMPRESS_RAW or COMPRESS_INFORMATION_CLASS_BLOCK_SIZE
'     with COMPRESS_ALGORITHM_LZMS. [LOW PRIORITY]
'
'   o Have not attempted to implement "Allocation Routine" callbacks.  We'll let
'     Cabinet.dll do its own default allocations. [LOW PRIORITY]
'
 
Private Const WIN32_FALSE As Long = 0
Private Const WIN32_TRUE As Long = Not WIN32_FALSE
Private Const WIN32_NULL As Long = 0
 
Private Const INVALID_HANDLE_VALUE = -1
 
Private Const ERROR_BAD_LENGTH As Long = 24
Private Const ERROR_FUNCTION_FAILED As Long = 1627
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Private Const ERROR_INVALID_HANDLE As Long = 6
Private Const ERROR_INVALID_PARAMETER As Long = 87
Private Const ERROR_NOT_SUPPORTED As Long = 50
Private Const ERROR_UNSUPPORTED_TYPE As Long = 1630
 
Public Enum COMPRESS_ALGORITHMS
    COMPRESS_ALGORITHM_INVALID = 0
    
    COMPRESS_ALGORITHM_NULL = 1           'No compression.
    
    COMPRESS_ALGORITHM_MSZIP = 2          '• Uses more resources than
                                          '  COMPRESS_ALGORITHM_XPRESS_HUFF.
                                          '• Generates a compressed block similar to RFC 1951.
                                          '• Medium to high compression ratio.
                                          '• Medium compression speed and high decompression speed.
                                          '• Medium memory requirement.
    
    COMPRESS_ALGORITHM_XPRESS = 3         '• Very fast with low resource requirements.
                                          '• Medium compression ratio.
                                          '• High compression and decompression speeds.
                                          '• Low memory requirement.
                                          '• Supports the COMPRESS_INFORMATION_CLASS_LEVEL
                                          '  option available in the COMPRESS_INFORMATION_CLASS
                                          '  enumeration. The default value is (DWORD)0. For
                                          '  some data, the value (DWORD)1 can improve the
                                          '  compression ratio with a slightly slower compression
                                          '  speed.
 
    COMPRESS_ALGORITHM_XPRESS_HUFF = 4    '• Compression ratio is higher than
                                          '  COMPRESS_ALGORITHM_XPRESS.
                                          '• Medium compression ratio.
                                          '• Medium to high compression and decompression speeds.
                                          '• Low memory requirement.
                                          '• Supports the COMPRESS_INFORMATION_CLASS_LEVEL option
                                          '  in the COMPRESS_INFORMATION_CLASS enumeration. The
                                          '  default value is (DWORD)0. For some data, the value
                                          '  (DWORD)1 can improve the compression ratio with a
                                          '  slightly slower compression speed.
 
    COMPRESS_ALGORITHM_LZMS = 5           '• Good algorithm if the size of the data to be
                                          '  compressed is over 2MB.
                                          '• High compression ratio.
                                          '• Low compression speed and high decompression speed.
                                          '• Medium to high memory requirement.
                                          '• Supports the COMPRESS_INFORMATION_CLASS_BLOCK_SIZE
                                          '  option in the COMPRESS_INFORMATION_CLASS enumeration.
                                          '  A minimum size of 1 MB is suggested to get a better
                                          '  compression ratio.
    
    COMPRESS_RAW = &H20000000             'Do not include the COMPRESS_RAW flag in the Algorithm
                                          'parameter when you call CreateCompressor and
                                          'CreateDecompressor to use buffer mode.
End Enum
#If False Then
Dim COMPRESS_ALGORITHM_MSZIP, COMPRESS_ALGORITHM_XPRESS, COMPRESS_ALGORITHM_XPRESS_HUFF
Dim COMPRESS_ALGORITHM_LZMS, COMPRESS_RAW
#End If
 
Private Enum COMPRESS_INFORMATION_CLASS   'MSDN listed this incorrectly as of 17-May-2017.
                                          'They had COMPRESS_INFORMATION_CLASS_BLOCK_SIZE and
                                          'COMPRESS_INFORMATION_CLASS_LEVEL inverted, changing
                                          'their values!
    COMPRESS_INFORMATION_CLASS_INVALID = 0
 
    COMPRESS_INFORMATION_CLASS_BLOCK_SIZE 'Customized block size. The value specified may be
                                          'from 65536 to 67108864 bytes. This value can be used
                                          'only with the LZMS compression algorithm. A minimum
                                          'size of 1 MB is suggested to get a better
                                          'compression ratio. An information class of this type
                                          'is sizeof(DWORD).
 
    COMPRESS_INFORMATION_CLASS_LEVEL      'Desired level of compression. The default value
                                          'is (DWORD)0. The value (DWORD)1 can improve the
                                          'compression ratio with a slightly slower compression
                                          'speed. This value can be used only with the XPRESS
                                          'compression algorithm or the XPRESS with Huffman
                                          'encoding compression algorithm. An information class
                                          'of this type is sizeof(DWORD).
End Enum
#If False Then
Dim COMPRESS_INFORMATION_CLASS_INVALID, COMPRESS_INFORMATION_CLASS_BLOCK_SIZE
Dim COMPRESS_INFORMATION_CLASS_LEVEL
#End If
 
Public Enum COMPRESSION_LEVELS
    LEVEL_STD = 0
    LEVEL_HIGH = 1
End Enum
#If False Then
Dim LEVEL_STD, LEVEL_HIGH
#End If
 
Private Declare Function CloseCompressor Lib "Cabinet" ( _
    ByVal CompressorHandle As Long) As Long
 
Private Declare Function CloseDecompressor Lib "Cabinet" ( _
    ByVal DecompressorHandle As Long) As Long
 
Private Declare Function CompressAPI Lib "Cabinet" Alias "Compress" ( _
    ByVal CompressorHandle As Long, _
    ByRef UncompressedData As Byte, _
    ByVal UncompressedBufferLength As Long, _
    ByRef CompressedBuffer As Byte, _
    ByVal CompressedBufferLength As Long, _
    ByRef CompressedDataLength As Long) As Long
 
Private Declare Function CreateCompressor Lib "Cabinet" ( _
    ByVal Algorithm As COMPRESS_ALGORITHMS, _
    ByVal pAllocationRoutines As Long, _
    ByRef CompressorHandle As Long) As Long
 
Private Declare Function CreateDecompressor Lib "Cabinet" ( _
    ByVal Algorithm As COMPRESS_ALGORITHMS, _
    ByVal pAllocationRoutines As Long, _
    ByRef DecompressorHandle As Long) As Long
 
Private Declare Function DecompressAPI Lib "Cabinet" Alias "Decompress" ( _
    ByVal DecompressorHandle As Long, _
    ByRef CompressedData As Byte, _
    ByVal CompressedDataLength As Long, _
    ByRef UncompressedBuffer As Byte, _
    ByVal UncompressedBufferLength As Long, _
    ByRef UncompressedBufferLength As Long) As Long
 
Private Declare Function QueryCompressorInformation Lib "Cabinet" ( _
    ByVal CompressorHandle As Long, _
    ByVal CompressInformationClass As COMPRESS_INFORMATION_CLASS, _
    ByRef CompressInformation As Long, _
    ByVal CompressInformationSize As Long) As Long
 
Private Declare Function QueryDecompressorInformation Lib "Cabinet" ( _
    ByVal DecompressorHandle As Long, _
    ByVal CompressInformationClass As COMPRESS_INFORMATION_CLASS, _
    ByRef CompressInformation As Long, _
    ByVal CompressInformationSize As Long) As Long
 
Private Declare Function ResetCompressor Lib "Cabinet" ( _
    ByVal CompressorHandle As Long) As Long
 
Private Declare Function ResetDecompressor Lib "Cabinet" ( _
    ByVal DecompressorHandle As Long) As Long
 
Private Declare Function SetCompressorInformation Lib "Cabinet" ( _
    ByVal CompressorHandle As Long, _
    ByVal CompressInformationClass As COMPRESS_INFORMATION_CLASS, _
    ByRef CompressInformation As Long, _
    ByVal CompressInformationSize As Long) As Long
 
Private Declare Function SetDecompressorInformation Lib "Cabinet" ( _
    ByVal DecompressorHandle As Long, _
    ByVal CompressInformationClass As COMPRESS_INFORMATION_CLASS, _
    ByRef CompressInformation As Long, _
    ByVal CompressInformationSize As Long) As Long
 
Private Handle As Long           '<> INVALID_HANDLE_VALUE means open.
Private Decompressing As Boolean 'Compressing/Decompressing when open.
 
Public Sub CloseCompression()
    If Handle = INVALID_HANDLE_VALUE Then Err.Raise &H8004E100, , "Not open"
    
    If Decompressing Then
        CloseDecompressor Handle
    Else
        CloseCompressor Handle
    End If
    Handle = INVALID_HANDLE_VALUE
End Sub
 
Public Function Compress( _
    ByRef UncompressedData() As Byte, _
    ByRef CompressedBuffer() As Byte, _
    Optional ByVal UnCompressedDataLength As Long = 0, _
    Optional ByVal CompressedBufferLength As Long = 0) As Long
    'UnCompressedDataLength  If provided this is the number of bytes of UncompressedData
    '                        to compress.  Can be less than the entire array.
    '
    'CompressedBufferLength  If provided this is the number of bytes of space
    '                        available in CompressedBuffer (we trust the caller).
    '                        This non-0 value also tells us not to trim the
    '                        CompressedBuffer array.
    '
    'The return value is the actual spcace used in CompressedBuffer for output.
    Dim TrimOutput As Boolean
    Dim LastDllError As Long
    
    If Handle = INVALID_HANDLE_VALUE Then Err.Raise &H8004E100, , "Not open"
    
    If Decompressing Then
        CloseCompressor Handle
        Handle = INVALID_HANDLE_VALUE
        Err.Raise &H8004E110, , "Not open for compression"
    End If
    
    If UnCompressedDataLength = 0 Then
        UnCompressedDataLength = UBound(UncompressedData) - LBound(UncompressedData) + 1
    End If
    
    If CompressedBufferLength = 0 Then
        TrimOutput = True
        On Error Resume Next 'In case CompressedBuffer() was not allocated at all.
        CompressedBufferLength = UBound(CompressedBuffer) - LBound(CompressedBuffer) + 1
        If Err.Number <> 0 Or CompressedBufferLength <= 0 Then
            ReDim CompressedBuffer(0)
        End If
        On Error GoTo 0
    End If
    
    If CompressAPI(Handle, _
                   UncompressedData(LBound(UncompressedData)), _
                   UnCompressedDataLength, _
                   CompressedBuffer(LBound(CompressedBuffer)), _
                   CompressedBufferLength, _
                   CompressedBufferLength) Then
        If TrimOutput Then
            ReDim Preserve CompressedBuffer(LBound(CompressedBuffer) _
                                         To LBound(CompressedBuffer) + CompressedBufferLength - 1)
        End If
    Else
        LastDllError = Err.LastDllError
        If LastDllError = ERROR_INSUFFICIENT_BUFFER Then
            ReDim CompressedBuffer(LBound(CompressedBuffer) _
                                To LBound(CompressedBuffer) + CompressedBufferLength - 1)
            If CompressAPI(Handle, _
                           UncompressedData(LBound(UncompressedData)), _
                           UnCompressedDataLength, _
                           CompressedBuffer(LBound(CompressedBuffer)), _
                           CompressedBufferLength, _
                           CompressedBufferLength) = WIN32_FALSE Then
                LastDllError = Err.LastDllError
                CloseCompressor Handle
                Handle = INVALID_HANDLE_VALUE
                Err.Raise &H8004E200, , "Compress failed, error " & CStr(LastDllError)
            End If
        End If
    End If
    Compress = CompressedBufferLength
End Function
 
Public Function Decompress( _
    ByRef CompressedData() As Byte, _
    ByRef UncompressedBuffer() As Byte, _
    Optional ByVal CompressedDataLength As Long = 0, _
    Optional ByVal UncompressedBufferLength As Long = 0) As Long
    'CompressedDataLength     If provided this is the number of bytes of CompressedData
    '                         to decompress.  Can be less than the entire array.
    '
    'UncompressedBufferLength If provided this is the number of bytes of space
    '                         available in UncompressedBuffer (we trust the caller).
    '                         This non-0 value also tells us not to trim the
    '                         UncompressedBuffer array.
    '
    'The return value is the actual spcace used in UncompressedBuffer for output.
    Dim TrimOutput As Boolean
    Dim LastDllError As Long
    
    If Handle = INVALID_HANDLE_VALUE Then Err.Raise &H8004E100, , "Not open"
    
    If Not Decompressing Then
        CloseDecompressor Handle
        Handle = INVALID_HANDLE_VALUE
        Err.Raise &H8004E120, , "Not open for decompression"
    End If
    
    If CompressedDataLength = 0 Then
        CompressedDataLength = UBound(CompressedData) - LBound(CompressedData) + 1
    End If
    
    If UncompressedBufferLength = 0 Then
        TrimOutput = True
        On Error Resume Next 'In case UncompressedBuffer() was not allocated at all.
        UncompressedBufferLength = UBound(UncompressedBuffer) - LBound(UncompressedBuffer) + 1
        If Err.Number <> 0 Or UncompressedBufferLength <= 0 Then
            ReDim UncompressedBuffer(0)
        End If
        On Error GoTo 0
    End If
    
    If DecompressAPI(Handle, _
                     CompressedData(LBound(CompressedData)), _
                     CompressedDataLength, _
                     UncompressedBuffer(LBound(UncompressedBuffer)), _
                     UncompressedBufferLength, _
                     UncompressedBufferLength) Then
        If TrimOutput Then
            ReDim Preserve UncompressedBuffer(LBound(UncompressedBuffer) _
                                           To LBound(UncompressedBuffer) _
                                            + UncompressedBufferLength - 1)
        End If
    Else
        LastDllError = Err.LastDllError
        If LastDllError = ERROR_INSUFFICIENT_BUFFER Then
            ReDim UncompressedBuffer(LBound(UncompressedBuffer) _
                                  To LBound(UncompressedBuffer) + UncompressedBufferLength - 1)
            If DecompressAPI(Handle, _
                             CompressedData(LBound(CompressedData)), _
                             CompressedDataLength, _
                             UncompressedBuffer(LBound(UncompressedBuffer)), _
                             UncompressedBufferLength, _
                             UncompressedBufferLength) = WIN32_FALSE Then
                LastDllError = Err.LastDllError
                CloseDecompressor Handle
                Handle = INVALID_HANDLE_VALUE
                Err.Raise &H8004E210, , "Decompress failed, error " & CStr(LastDllError)
            End If
        End If
    End If
    Decompress = UncompressedBufferLength
End Function
 
Public Sub OpenCompressor( _
    ByVal Algorithm As COMPRESS_ALGORITHMS, _
    Optional ByVal Level As COMPRESSION_LEVELS = LEVEL_STD)
    
    Dim LastDllError As Long
 
    If Handle <> INVALID_HANDLE_VALUE Then Err.Raise &H8004E300, , "Already open"
    
    If CreateCompressor(Algorithm, WIN32_NULL, Handle) Then
        'Getting ERROR_UNSUPPORTED_TYPE = 1630 so commenting this out.
'        If Algorithm = COMPRESS_ALGORITHM_XPRESS Or Algorithm = COMPRESS_ALGORITHM_XPRESS_HUFF Then
'            If SetCompressorInformation(Handle, _
'                                        COMPRESS_INFORMATION_CLASS_LEVEL, _
'                                        Level, _
'                                        4) = WIN32_FALSE Then
'                LastDllError = Err.LastDllError
'                CloseCompressor Handle
'                Handle = INVALID_HANDLE_VALUE
'                Err.Raise &H8004E310, _
'                          , _
'                          "SetCompressorInformation failed, error " _
'                        & CStr(LastDllError)
'            End If
'        End If
        Decompressing = False
    Else
        Err.Raise &H8004E320, , "CreateCompressor failed, error " & CStr(Err.LastDllError)
    End If
End Sub
 
Public Sub OpenDecompressor( _
    ByVal Algorithm As COMPRESS_ALGORITHMS, _
    Optional ByVal Level As COMPRESSION_LEVELS = LEVEL_STD)
    
    Dim LastDllError As Long
 
    If Handle <> INVALID_HANDLE_VALUE Then Err.Raise &H8004E330, , "Already open"
    
    If CreateDecompressor(Algorithm, WIN32_NULL, Handle) Then
        'Getting ERROR_UNSUPPORTED_TYPE = 1630 so commenting this out.
'        If Algorithm = COMPRESS_ALGORITHM_XPRESS Or Algorithm = COMPRESS_ALGORITHM_XPRESS_HUFF Then
'            If SetDecompressorInformation(Handle, _
'                                          COMPRESS_INFORMATION_CLASS_LEVEL, _
'                                          Level, _
'                                          4) = WIN32_FALSE Then
'                LastDllError = Err.LastDllError
'                CloseDecompressor Handle
'                Handle = INVALID_HANDLE_VALUE
'                Err.Raise &H8004E340, _
'                          , _
'                          "SetDecompressorInformation failed, error " _
'                        & CStr(LastDllError)
'            End If
'        End If
        Decompressing = True
    Else
        Err.Raise &H8004E350, , "CreateDecompressor failed, error " & CStr(Err.LastDllError)
    End If
End Sub
 
Private Sub Class_Initialize()
    Handle = INVALID_HANDLE_VALUE
End Sub
 
Private Sub Class_Terminate()
    If Handle <> INVALID_HANDLE_VALUE Then CloseCompression
End Sub

Public Function CompressDeltaB(bInp() As Byte, bOut() As Byte) As Boolean
    Dim ret As Long
    Dim DO_Res As DELTA_OUTPUT
    
    ret = CreateDeltaB(Trg_lpcStart:=bInp(0), Trg_uSize:=UBound(bInp) + 1, lpDelta:=DO_Res)
    
    If ret Then
        With DO_Res
            ReDim bOut(.uSize - 1)
            CopyMemory bOut(0), ByVal .lpStart, .uSize
            DeltaFree (.lpStart)
        End With
        
        CompressDeltaB = True
    End If
End Function

If CompressDeltaB(buf, buf2) = True Then ' Успех