Attribute VB_Name = "mCompress"
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Módulo de compactação de string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' APIs externas
Private Declare Function ZCompress Lib "zlib.dll" Alias "compress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function ZUncompress Lib "zlib.dll" Alias "uncompress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long



' Guarda o nome do módulo
Private Const ST_MY_NAME As String = "mCompress"


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Compacta uma string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Compress(stInput As String) As String
    Dim lnSize As Long, lnCompSize As Long
    Dim vtAux() As Byte, vtBuff() As Byte
    Dim stAux As String
    On Error GoTo ErrTreat:
    
    ' Pega o tamanho da entrada
    lnSize = Len(stInput)
    
    ' Verifica se há algum dado a compactar
    If (lnSize > 0) Then
    
        ' Redimenciona vetor auxiliar
        ReDim vtAux(lnSize - 1)
        
        ' Copia string para o vetor auxiliar
        CopyMemory vtAux(0), stInput, lnSize
        
        ' Seta um tamanho estimado da compactação
        lnCompSize = lnSize + (lnSize * 1.01) + 16
        
        ' Aloca o buffer auxiliar
        ReDim vtBuff(lnCompSize - 1)
        
        ' Compacta
        ZCompress vtBuff(4), lnCompSize, vtAux(0), lnSize

        ' Copia o tamanho da entrada
        CopyMemory vtBuff(0), lnSize, 4
        
        ' Seta o tamanho compactado
        lnCompSize = lnCompSize + 4
        
        ' Redimenciona a entrada/saída
        stAux = String(lnCompSize, 0)
        
        ' Retorna valor para string
        CopyMemory ByVal stAux, vtBuff(0), lnCompSize
        
        ' Retorna
        Compress = stAux
    Else
        
        ' Retorna nulo
        Compress = ST_INVALID_VALUE
    End If
    
    ' Libera vetores
    Erase vtAux()
    Erase vtBuff()
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".Compress"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Descompacta uma string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Uncompress(stInput As String) As String
    Dim lnSize As Long, lnCompSize As Long
    Dim vtAux() As Byte, vtBuff() As Byte
    Dim stAux As String
    On Error GoTo ErrTreat:
    
    ' Pega o tamanho da entrada
    lnSize = Len(stInput)
    
    ' Verifica se há algum dado a descompactar
    If (lnSize > 0) Then
    
        ' Redimenciona vetor auxiliar
        ReDim vtAux(lnSize - 1)
        
        ' Copia string para o vetor auxiliar
        CopyMemory vtAux(0), stInput, lnSize
        
        ' Seta o tamanho da leitura do auxiliar
        lnCompSize = lnSize - 4
        
        ' Pega o tamanho descompactado
        CopyMemory lnSize, vtAux(0), 4
        
        ' Aloca o buffer auxiliar
        ReDim vtBuff(lnSize - 1)
        
        ' Descompacta
        ZUncompress vtBuff(0), lnSize, vtAux(4), lnCompSize
        
        ' Redimenciona a entrada/saída
        stAux = String(lnSize, 0)
        
        ' Retorna valor para string
        CopyMemory ByVal stAux, vtBuff(0), lnSize
        
        ' Retorna
        Uncompress = stAux
    
    Else
        
        ' Retorna nulo
        Uncompress = ST_INVALID_VALUE
    End If
    
    ' Libera vetores
    Erase vtAux()
    Erase vtBuff()
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".Uncompress"
End Function