vb6中用zlib.dll實作壓縮/解壓縮位元組數組

(聲明：魏滔序原創，轉貼請注明出處。)

Option Explicit

'Declares

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Declare Function Compress Lib "zlibwapi.dll" Alias "compress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long

Private Declare Function uncompress Lib "zlibwapi.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long

Private Const OFFSET As Long = &H8

'壓縮數組

Public Function CompressByte(ByteArray() As Byte) As Boolean

    Dim BufferSize As Long

    Dim TempBuffer() As Byte

    'Create a buffer to hold the compressed data

    BufferSize = UBound(ByteArray) + 1

    BufferSize = BufferSize + (BufferSize * 0.01) + 12

    ReDim TempBuffer(BufferSize)

    'Compress byte array (data)

    CompressByte = (Compress(TempBuffer(0), BufferSize, ByteArray(0), UBound(ByteArray) + 1) = 0)

    'Add the size of the original data

    Call CopyMemory(ByteArray(0), CLng(UBound(ByteArray) + 1), OFFSET)

    'Remove redundant data

    ReDim Preserve ByteArray(0 To BufferSize + OFFSET - 1)

    CopyMemory ByteArray(OFFSET), TempBuffer(0), BufferSize

End Function

'解壓縮數組

Public Function UnCompressByte(ByteArray() As Byte) As Boolean

    Dim OrigLen As Long

    Dim BufferSize As Long

    Dim TempBuffer() As Byte

    'Get the original size

    Call CopyMemory(OrigLen, ByteArray(0), OFFSET)

    'Create a buffer to hold the uncompressed data

    BufferSize = OrigLen

    BufferSize = BufferSize + (BufferSize * 0.01) + 12

    ReDim TempBuffer(BufferSize)

    'Decompress data

    UnCompressByte = (uncompress(TempBuffer(0), BufferSize, ByteArray(OFFSET), UBound(ByteArray) - OFFSET + 1) = 0)

    'Remove redundant data

    ReDim Preserve ByteArray(0 To BufferSize - 1)

    CopyMemory ByteArray(0), TempBuffer(0), BufferSize

End Function