VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cls_zlib"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Klasse zum Kapseln der Funktionen der zlib

'nicht fertig!!!

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 "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 OriginalSize As Long 'die Dateigrösse/Stringgrösse für dem komprimieren

Enum CZErrors
    [Insufficient Buffer] = -5
End Enum

Public Function CompressData(TheData() As Byte) As Long

    On Error GoTo errorhandler

    'Allocate memory for byte array
    Dim BufferSize As Long
    Dim TempBuffer() As Byte
    Dim result As Long

    
    OriginalSize = UBound(TheData) + 1

    BufferSize = UBound(TheData) + 1
    BufferSize = BufferSize + (BufferSize * 0.01) + 12
    ReDim TempBuffer(BufferSize)

    'Compress byte array (data)
    result = compress(TempBuffer(0), BufferSize, TheData(0), UBound(TheData) + 1)

    'Truncate to compressed size
    ReDim Preserve TheData(BufferSize - 1)
    CopyMemory TheData(0), TempBuffer(0), BufferSize

    'Cleanup
    Erase TempBuffer

    'Return error code (if any)
    CompressData = result

    Exit Function
errorhandler:
    Debug.Print "Fehler in CompressData"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description

End Function

Public Function CompressString(TheString As String) As Long

    On Error GoTo errorhandler

    OriginalSize = Len(TheString)

'Allocate string space for the buffers
Dim CmpSize As Long
Dim TBuff As String
Dim orgSize As Variant
Dim ret As Long

orgSize = Len(TheString)
TBuff = String(orgSize + (orgSize * 0.01) + 12, 0)
CmpSize = Len(TBuff)

'Compress string (temporary string buffer) data
ret = compress(ByVal TBuff, CmpSize, ByVal TheString, Len(TheString))

'Set original value
OriginalSize = Len(TheString)

'Crop the string and set it to the actual string.
TheString = Left$(TBuff, CmpSize)

'Set compressed size of string.
'CompressedSize = CmpSize

'Cleanup
TBuff = ""

'Return error code (if any)
CompressString = ret

    Exit Function
errorhandler:
    Debug.Print "Fehler in CompressString"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description

End Function

Public Function DecompressData(TheData() As Byte, OrigSize As Long) As Long

    'Allocate memory for buffers
    Dim BufferSize As Long
    Dim TempBuffer() As Byte
    Dim result As Long

    On Error GoTo errorhandler

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

    'Decompress data
    result = uncompress(TempBuffer(0), BufferSize, TheData(0), UBound(TheData) + 1)

    'Truncate buffer to compressed size
    ReDim Preserve TheData(BufferSize - 1)
    CopyMemory TheData(0), TempBuffer(0), BufferSize

    'Reset properties
    If result = 0 Then
        OriginalSize = 0
    End If

    'Return error code (if any)
    DecompressData = result

    Exit Function
errorhandler:
    Debug.Print "Fehler in DecompressData"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description

End Function

Public Function DecompressString(TheString As String, OrigSize As Long) As Long

    On Error GoTo errorhandler

    'Allocate string space
Dim CmpSize As Long
Dim TBuff As String
Dim result As Long
TBuff = String(OrigSize + (OrigSize * 0.01) + 12, 0)
CmpSize = Len(TBuff)

'Decompress
result = uncompress(ByVal TBuff, CmpSize, ByVal TheString, Len(TheString))

'Make string the size of the uncompressed string
TheString = Left$(TBuff, CmpSize)

'Reset properties
If result = 0 Then
'CompressedSize = 0
OriginalSize = 0
End If

'Return error code (if any)
DecompressString = result


    Exit Function
errorhandler:
    Debug.Print "Fehler in DecompressString"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description

End Function

Public Function GetOriginalSize() As Long
    'liefert die Originalgrösse in Bytes nach einer Kompression
    'nach der Abfrage wird die Grösse wieder auf 0 gesetzt
    GetOriginalSize = OriginalSize
    OriginalSize = 0
    
End Function


