Byte Array Compression (Zlib?)

[Teseng]

Hello all, I've been trying to compress a byte array, ranging from a few hundred bytes, to a couple thousand or so.

I've been trying to use Zlib's compress functions, but it randomly completely crashes the IDE, and when i say random, i mean COMPLETE randomness, the array can be full of the normal data, or even full of 0's, and it still crashes everything.

But when it DOES work, it works quite well, but its just too unstable to actually use

Basically I have an array of bytes, say 1000, and i need to compress it down to a much more smaller size to send over a tcp connection, any ideas??


::Oh, and even it doesnt seem to crash the IDE, it seems to infect it, and it will randomly crash at a later time, even if its just sitting there, mouse not even moving, so it may be leaking or something somewhere.

[Jim Davis]

Those crashes are because of the illegal memory usage. You must provide enough room space for the zlib dll to compress your string.

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

Function Zip(Container As String) As String
Dim CmpSize As Long, TBuff As String, orgSize As Long
Dim Ret As Long, FF As Long
  orgSize = Len(Container)
  TBuff = String(orgSize + (orgSize * 0.01) + 12, 0)
  CmpSize = Len(TBuff)
  
  Ret = compress2(ByVal TBuff, CmpSize, ByVal Container, Len(Container), 9)

  Zip = Left$(TBuff, CmpSize)
  
End Function

This is the way i use Zlib. You can also convert the byte array to String and vica versa.

sString = StrConv(aByteArray, vbUnicode)

Dim aByteArray() As Byte
aByteArray = StrConv(sString, vbFromUnicode)

But i'm sure that the zlib will accept byte array, just expand the memory array for the zlib. (TBuff)

[Teseng]

I've tried a few different things, but so far the only ones that compressed like it was suppose to, crashed, I've modified a byte compression sub i found a few days ago, but I can't figure out why it isnt compressing, its just increasing the size by 11, even with different data its the same size, so something isnt resizing correctly somewhere but i can't figure out why, anychance someone can point out the problem in the following sub?

Public Sub CompressByteArray(Data() As Byte)
Dim result As Long, BufferSize As Long, TempBuffer() As Byte
Dim OriginalSize As Long, CompressedSize As Long

  OriginalSize = UBound(Data)

  BufferSize = OriginalSize
  BufferSize = BufferSize + (BufferSize * 0.01) + 12
  ReDim TempBuffer(BufferSize)

  result = compress2(TempBuffer(0), BufferSize, Data(0), UBound(Data), 9)

  ReDim Preserve Data(BufferSize)
  CopyMemory Data(0), TempBuffer(0), BufferSize
  Erase TempBuffer
  
  CompressedSize = UBound(Data)
  
Debug.Print "Orig: " & OriginalSize & " | " & CompressedSize

End Sub

it just seems like the buffere stays the same for some reason.
Kinda new to this, sorry >.<

[Jim Davis]

What is the result code? If its 0 that means, everything went fine.

its just increasing the size by 11

There are headers in zip that is increases the size of the packed content, that is means an 8 bytes addition, exactly. Ill also be warn you, that the packed content will NOT contain any kind of description about the original content, that mean you cant unpack it, without providing the original lenght information, for example.

Its better to declare your compression method as a function in the following way:

Public Function CompressByteArray(Data() As Byte) As Long
  '....
  CompressByteArray = OriginalSize

Now, you can provide this information to your unpacker. Just like:

OriginalLength = CompressByteArray(Data())
sUnpacked = UnCompressByteArray(Data(), OriginalLength)

You also was wrong at where you calculating the OriginalLength, because you have to provide the number of elements of your byte array, but not its ubound. the number of elements will be ubound+1, because the first element is the 0th.

'....
OriginalSize = UBound(Data) + 1
'....
result = compress2(TempBuffer(0), BufferSize, Data(0), OriginalSize, 9)

Now, i get the results:

Orig: 44 | 35
Compressed: <noise data here...>
Uncompressed: WinZipLibTipBitBip aaaand WinZipLibTipBitBip

[Teseng]

I fixed what you said, but i only get decent results on small, similiar arrays
I just use a loop to fill an array(2000) with random bytes between 0 and 255

Doing this makes the compression swell instead of compress, and only works with numbers under 255, and then not very well

The other procedure i used compressed much better(not sure if it was actually compressing anything though)

But its very unstable, and seems to leak large amount of memory, I've spammed the process and was able to get a out of memory error, but if i just do it here and there, the IDE crashes completely, I can post the unstable one later tonight if you'd like, the one i posted before just doesnt seem viable. Then again, no compression might work for me in the long run

[Jim Davis]

OK just show an example code here that is better to walk thru what is going on there. Can you just upload your ziplib dll that do you use? Not in here, that is agains the rules of vbforums, but somewhere else.

http://sendspace.com/ would be nice, no megaupload/rapidshare, works for me.

[Teseng]

  uncompressed_size = UBound(Data) + 1
    ReDim uncompressed_bytes(0 To uncompressed_size)
    uncompressed_bytes = Data
    
    compressed_size = 1.01 * uncompressed_size + 20
    ReDim compressed_bytes(0 To compressed_size)

lReturn = compress(compressed_bytes(0), compressed_size, _
          uncompressed_bytes(0), _
          uncompressed_size)
    Select Case lReturn
        Case Z_OK
                ReDim Preserve compressed_bytes(0 To compressed_size)
                Debug.Print uncompressed_size & " | " & UBound(compressed_bytes)
                Erase uncompressed_bytes
        Case Z_MEM_ERROR
            Err.Raise vbObjectError + Abs(lReturn), "UncompressString", _
                "Insufficient memory to uncompress string"
        Case Z_BUF_ERROR
            Err.Raise vbObjectError + Abs(lReturn), "UncompressString", _
                "Insufficient space in output buffer to uncompress string"
        Case Z_DATA_ERROR
            Err.Raise vbObjectError + Abs(lReturn), "UncompressString", _
                "Cannot uncompress corrupt data"
        Case Else
            Err.Raise vbObjectError + Abs(lReturn), "UncompressString", _
                "Unknown error during uncompress operation"
    End Select

This one may be full of errors, because i kinda did it in a frenzy, the previous one i posted doesnt seem to compress enough for me, however this one seems to do it the compression i need, but theres a memory leak or something somewhere, and it causes the IDE to act up, then crash.

If I run this process very fast multiple times i end up getting "out of memory" errors, and basic things like the ".text" of a textbox failing to initialize, then Vb6.exe crashing out.

The current way i'm sending things is Im compressing an actual string containing the numbers i.e.(255,222,92,37,29,48,141...and so on) and then convertng the compressed into a byte array and sending the bytes, But its sluggish, and sometimes starts getting mangled up, so i figure sending the raw bytes compressed would be easier
-
and i'm using the newest zlib.dll i got off the zlib website
http://www.zlib.net/zlib123-dll.zip

[Alphadan]

Hi i have the same question but i think i found the solution just found a example and it works just fine.

Im not taking any credits for the code since just found on the internet... and it appears to works just fine..

just wanted to help since i came here looking for help

just add to a form

2 textboxs
txtUncompressed
txtCompressed
2 labels
lblUncompressedSize
lblCompressedSize
2 cmd buttons
cmdCompress
cmdUncompress

Dll Wrap

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

Check how its wraped the dll "as any" on the input and output parameters it will acept/output byte arrays

The constants

Private Const Z_OK = 0
Private Const Z_DATA_ERROR = -3
Private Const Z_MEM_ERROR = -4
Private Const Z_BUF_ERROR = -5

The compresion

Private Sub cmdCompress_Click()
Dim file_name As String
Dim fnum As Integer
Dim uncompressed_size As Long
Dim uncompressed_bytes() As Byte
Dim compressed_size As Long
Dim compressed_bytes() As Byte

    ' **************************************
    ' Load the uncompressed file into a byte array.
    file_name = txtUncompressed.Text
    uncompressed_size = FileLen(file_name)
    ReDim uncompressed_bytes(1 To uncompressed_size)

    fnum = FreeFile
    Open file_name For Binary Access Read As #fnum
    Get #fnum, , uncompressed_bytes()
    Close #fnum
    lblUncompressedSize.Caption = uncompressed_size & " bytes"

    ' **************************************
    ' Compress.

    ' Allocate the smallest allowed compression
    ' buffer (1% larger than the uncompressed data
    ' plus 12 bytes).
    compressed_size = 1.01 * uncompressed_size + 12
    ReDim compressed_bytes(1 To compressed_size)

    ' Compress the bytes.
    Select Case compress(compressed_bytes(1), compressed_size, uncompressed_bytes(1), uncompressed_size)
        Case Z_MEM_ERROR
            MsgBox "Insufficient memory", vbExclamation, "Compression Error"
            Exit Sub
        Case Z_BUF_ERROR
            MsgBox "Buffer too small", vbExclamation, "Compression Error"
            Exit Sub
        ' Else Z_OK.
    End Select

    ' Shrink the compressed buffer to fit.
    ReDim Preserve compressed_bytes(1 To compressed_size)

    ' **************************************
    ' Save the results into the output file.

    ' Remove the existing file.
    On Error Resume Next
    Kill txtCompressed.Text
    On Error GoTo 0

    ' Write the file.
    Open txtCompressed.Text For Binary Access Write As #fnum
    Put #fnum, , compressed_bytes()
    Close #fnum
    lblCompressedSize.Caption = compressed_size & " bytes"

    MsgBox "Done. Compressed " & uncompressed_size & " --> " & compressed_size & " (" & Format$(compressed_size / uncompressed_size * 100, "0.00") & "%)"
    cmdUncompress.Enabled = True
End Sub

the decompresion

Private Sub cmdUncompress_Click()
Dim file_name As String
Dim fnum As Integer
Dim compressed_size As Long
Dim compressed_bytes() As Byte
Dim uncompressed_size As Long
Dim uncompressed_bytes() As Byte

    ' **************************************
    ' Load the file into a byte array.
    file_name = txtCompressed.Text
    compressed_size = FileLen(file_name)
    ReDim compressed_bytes(1 To compressed_size)

    fnum = FreeFile
    Open file_name For Binary Access Read As #fnum
    Get #fnum, , compressed_bytes()
    Close #fnum
    lblCompressedSize.Caption = compressed_size & " bytes"

    ' **************************************
    ' Uncompress.

    ' Allocate room for the uncompressed file.
    ' Note that this routine needs to know
    ' the original file's uncompressed size.
    uncompressed_size = Val(lblUncompressedSize.Caption)
    ReDim uncompressed_bytes(1 To uncompressed_size)

    ' Decompress the bytes.
    Select Case uncompress( _
            uncompressed_bytes(1), uncompressed_size, compressed_bytes(1), compressed_size)
        Case Z_MEM_ERROR
            MsgBox "Insufficient memory", vbExclamation, "Compression Error"
            Exit Sub
        Case Z_BUF_ERROR
            MsgBox "Buffer too small", vbExclamation, "Compression Error"
            Exit Sub
        Case Z_DATA_ERROR
            MsgBox "Input file corrupted", vbExclamation, "Compression Error"
            Exit Sub
        ' Else Z_OK.
    End Select

    ' **************************************
    ' Save the results into the output file.

    ' Remove the existing file.
    file_name = txtUncompressed.Text
    On Error Resume Next
    Kill file_name
    On Error GoTo 0

    ' Write the file.
    Open file_name For Binary Access Write As #fnum
    Put #fnum, , uncompressed_bytes()
    Close #fnum
    lblUncompressedSize.Caption = uncompressed_size & " bytes"
    MsgBox "Done. Uncompressed " & compressed_size & " --> " & uncompressed_size & " (" & Format$(uncompressed_size / compressed_size, "0.00") & "x)"
End Sub

Form load

Private Sub Form_Load()
Dim app_path As String

    app_path = App.Path
    If Right$(app_path, 1) <> "\" Then app_path = app_path & "\"

    txtUncompressed.Text = app_path & "test.dat"
    txtCompressed.Text = app_path & "test.zip"
End Sub

[Alphadan]

well i just made 2 functions to make the compress/uncompress as simple as posible the uncompresed lenght it strored on the last 4 bytes of the array then on the uncompress function those bytes are recovered and striped.

so i hang this functions here so anyone can use it, any performance improvement you can do, please coment it here.


'Declarations

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function compress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function uncompress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long

Private Const Z_OK              As Long = 0
Private Const Z_STREAM_END      As Long = 1
Private Const Z_NEED_DICT       As Long = 2
Private Const Z_ERRNO           As Long = -1
Private Const Z_STREAM_ERROR    As Long = -2
Private Const Z_DATA_ERROR      As Long = -3
Private Const Z_MEM_ERROR       As Long = -4
Private Const Z_BUF_ERROR       As Long = -5
Private Const Z_VERSION_ERROR   As Long = -6

'Compress

Function CompressByteArray(ByRef RawBytes() As Byte) As Boolean
Dim uncompressed_size As Long
Dim uncompressed_bytes() As Byte
Dim compressed_size As Long
Dim compressed_bytes() As Byte

    uncompressed_size = UBound(RawBytes)
    uncompressed_bytes() = RawBytes()
    ' **************************************
    ' Compress.
    ' Allocate the smallest allowed compression
    ' buffer (1% larger than the uncompressed data
    ' plus 12 bytes).
    compressed_size = 1.01 * uncompressed_size + 12
    ReDim compressed_bytes(compressed_size)
    
    ' Compress the bytes.
    Select Case compress(compressed_bytes(0), compressed_size, uncompressed_bytes(0), uncompressed_size)
        Case Z_MEM_ERROR
            '"Insufficient memory"
            CompressByteArray = False
            Exit Function
        Case Z_BUF_ERROR
            '"Buffer too small"
            CompressByteArray = False
            Exit Function
        Case Else 'Z_OK
        CompressByteArray = True
    End Select
    
   'here we redim the array with a 4byte extra to store the uncompresed size
    ReDim Preserve compressed_bytes(compressed_size + 4) 
   'We write 4bytes on the end containing the lenght of the uncompresed size
   CopyMemory compressed_bytes(compressed_size), uncompressed_size, 4 
    
    'we return the value
    RawBytes() = compressed_bytes()
End Function

Function UnCompressByteArray(ByRef RawBytes() As Byte) As Boolean
Dim compressed_size As Long
Dim compressed_bytes() As Byte
Dim uncompressed_size As Long
Dim uncompressed_bytes() As Byte
    ' **************************************
    ' Load the file into a byte array.
    compressed_size = UBound(RawBytes)
    'we retrieve the uncompresed size from the last 4 bytes
    CopyMemory uncompressed_size, RawBytes(compressed_size - 4), 4
    'then we copy the content from the input array to another cuting the last 4 bytes
    ReDim compressed_bytes(compressed_size - 4)
    CopyMemory compressed_bytes(0), RawBytes(0), compressed_size - 4
    ' **************************************
    ' Uncompress.
    ' Allocate room for the uncompressed file.
    ' Note that this routine needs to know
    ' the original file's uncompressed size.
    ReDim uncompressed_bytes(uncompressed_size)

    ' Decompress the bytes.
    Select Case uncompress(uncompressed_bytes(0), uncompressed_size, compressed_bytes(0), compressed_size)
        Case Z_MEM_ERROR
            '"Insufficient memory"
            UnCompressByteArray = False
            Exit Function
        Case Z_BUF_ERROR
            '"Buffer too small"
            UnCompressByteArray = False
            Exit Function
        Case Z_DATA_ERROR
            '"Input file corrupted"
            UnCompressByteArray = False
            Exit Function
        Case Else 'Z_OK
        UnCompressByteArray = True
    End Select
    'we return the value
RawBytes() = uncompressed_bytes()
End Function