Module zlib - la compression facile... (ou decompression)

Soyez le premier à donner votre avis sur cette source.

Vue 12 995 fois - Téléchargée 1 032 fois

Description

Je sais que de telles sources existent déjà sur le site, mais là, ca gère tout en mémoire, sans créer de fichier temporaire.

Ce module permet de compresser/décompresser très facilement vos données depuis et vers des tableaux d'octets.

Source / Exemple :


Public Function CompressData(ByRef vxbInput() As Byte, ByRef vxbOutput() As Byte, Optional vnStart As Long = 0, Optional vnMaxSize As Long = 0, Optional veCompressionLevel As ZLIB_CompressionLevelConstants = Z_DEFAULT_COMPRESSION) As Boolean
Dim tStream As zStream
Dim rc As Long
Dim xbCopy() As Byte
    With tStream
        '# On initialise les parametres de la structure stream
        If deflateInit(tStream, veCompressionLevel, ZLIB_Version, Len(tStream)) = 0 Then
            CompressData = True
            '# Les données sont a prendre dans le tableau en entrée
            CopyMemory rc, ByVal ArrPtr(vxbInput), 4
            If rc Then
                CopyMemory .avail_in, ByVal rc + 16, 4
                .avail_in = .avail_in - vnStart
            End If
            If .avail_in > 0 And vnStart < .avail_in Then
                '# Doit-on prendre tout le tableau ?
                If vnMaxSize <> 0 And vnMaxSize < .avail_in Then
                    .avail_in = vnMaxSize
                End If
                .next_in = VarPtr(vxbInput(vnStart))
                                
                '# On regarde ou sont les données du tableau de sortie.
                '# Pas de VarPtr ici car ce tableau peut etre vide, ca évite un On Error ^^
                CopyMemory rc, ByVal ArrPtr(vxbOutput), 4
                If rc Then
                    CopyMemory rc, ByVal rc + 12, 4

                    If rc + vnStart = .next_in Then
                        '# Le tableau d'entrée et le tableau de sortie pointent au même endroit...
                        '# ca ne va "pas le faire" ...
                        xbCopy = vxbInput
                        .next_in = VarPtr(xbCopy(vnStart))
                    ElseIf vnStart Then
                        '# On recopie le début du tableau
                        ReDim vxbOutput(vnStart - 1)
                        CopyMemory vxbOutput(0), vxbInput(0), vnStart - 1
                    End If
                Else
                    vxbOutput = vxbInput
                End If
                
                .avail_out = .avail_in + 12
                 '# On agrandit le tableau de sortie
                 ReDim Preserve vxbOutput(.total_out - 1 + .avail_out + vnStart)
                 '# Les nouvelles données décompressées seront placées à la suite, dans le tableau...
                 .next_out = VarPtr(vxbOutput(vnStart + .total_out))
                
                 '# Lance la décompression a proprement parler
                 CompressData = deflate(tStream, 4) = 1
                
                If .total_out Or vnStart Then
                    ReDim Preserve vxbOutput(.total_out + vnStart - 1)
                Else
                    Erase vxbOutput
                End If
            End If
            
            '# Fin de l'utilisation de ZLib
            deflateEnd tStream
        End If
    End With
End Function

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
745
Date d'inscription
mardi 25 mars 2003
Statut
Membre
Dernière intervention
14 juillet 2015

Ca maaaaaaaaaaaaarche ! Merci pour ces réponses miracles :) !
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
62
ben vi ^^
il repart pas du contenu de la texbox... mais du tableau obtenu en compressant la donnée en entrée.

si tu branche la décompression su r ce qu'affiche CcTxtComp, je pense que tu vas pas obtenir le bon résultat en sortie (caractères invalides, supprimés ?)

suffit de faire :

Private Sub Command2_Click()
If LenB(CcTxtComp.Text) Then
mxbBufferIn = StrConv(CcTxtComp.Text, vbFromUnicode)
UncompressData mxbBufferIn, mxbBufferOut
CcTxtVerif.Text = StrConv(mxbBufferOut, vbUnicode)
Else
CcTxtVerif.Text = vbNullString
End If
If CcTxtVerif.Text <> CcTxtUncomp.Text Then
MsgBox "Erreur, le flux décompressé est différent du flux d'entrée.", vbExclamation
End If
End Sub
Messages postés
745
Date d'inscription
mardi 25 mars 2003
Statut
Membre
Dernière intervention
14 juillet 2015

merci de cette réponse super rapide, le code ressemble à ça là :

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Dim mxbBufferIn() As Byte
Dim mxbBufferOut() As Byte
Private Sub CcTxtComp_Change()
CcLblComp.Caption = "Longueur : " & Len(CcTxtComp.Text)
End Sub

Private Sub CcTxtVerif_Change()
CcLblVerif.Caption = "Longueur : " & Len(CcTxtVerif.Text)
End Sub

Private Sub Command1_Click()
CcLblUncomp.Caption = "Longueur : " & Len(CcTxtUncomp.Text)
If LenB(CcTxtUncomp.Text) Then
mxbBufferIn = StrConv(CcTxtUncomp.Text, vbFromUnicode)
CompressData mxbBufferIn, mxbBufferOut
CcTxtComp.Text = StrConv(mxbBufferOut, vbUnicode)
Else
CcTxtComp.Text = vbNullString
End If
End Sub

euh... lorsque je copie colle le résultat compressé, que je stope l'appli et que je la relance et que je colle le résultat compressé, il décompresse rien, c normal?

Private Sub Command2_Click()
If LenB(CcTxtComp.Text) Then
mxbBufferIn = mxbBufferOut
UncompressData mxbBufferIn, mxbBufferOut
CcTxtVerif.Text = StrConv(mxbBufferOut, vbUnicode)
Else
CcTxtVerif.Text = vbNullString
End If
' If CcTxtVerif.Text <> CcTxtUncomp.Text Then
' MsgBox "Erreur, le flux décompressé est différent du flux d'entrée.", vbExclamation
' End If
End Sub
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
62
dans Command2_Click
tu as xbBufferIn = xbBufferOut

mais là, ca ne va pas, tu parles de TON tableau xbBufferOut, déclaré deux lignes plus haut.

tu peux tenter:

Private mxbBufferIn() As Byte
Private mxbBufferOut() As Byte

Private Sub Command1_Click()
CcLblUncomp.Caption = "Longueur : " & Len(CcTxtUncomp.Text)
If LenB(CcTxtUncomp.Text) Then
mxbBufferIn = StrConv(CcTxtUncomp.Text, vbFromUnicode)
CompressData mxbBufferIn, mxbBufferOut
CcTxtComp.Text = StrConv(mxbBufferOut, vbUnicode)
Else
CcTxtComp.Text = vbNullString
End If
End Sub

Private Sub Command2_Click()
If LenB(CcTxtComp.Text) Then
mxbBufferIn = mxbBufferOut
UncompressData mxbBufferIn, mxbBufferOut
CcTxtVerif.Text = StrConv(mxbBufferOut, vbUnicode)
Else
CcTxtVerif.Text = vbNullString
End If
If CcTxtVerif.Text <> CcTxtUncomp.Text Then
MsgBox "Erreur, le flux décompressé est différent du flux d'entrée.", vbExclamation
End If
End Sub
Messages postés
745
Date d'inscription
mardi 25 mars 2003
Statut
Membre
Dernière intervention
14 juillet 2015

j'ai essayé de répartir le code dans deux boutons, ça ne fonctionne pas :/

Private Sub Command1_Click()
Dim xbBufferIn() As Byte
Dim xbBufferOut() As Byte
CcLblUncomp.Caption = "Longueur : " & Len(CcTxtUncomp.Text)

If LenB(CcTxtUncomp.Text) Then
xbBufferIn = StrConv(CcTxtUncomp.Text, vbFromUnicode)
CompressData xbBufferIn, xbBufferOut
CcTxtComp.Text = StrConv(xbBufferOut, vbUnicode)
Else
CcTxtComp.Text = vbNullString
End If
End Sub

Private Sub Command2_Click()
Dim xbBufferIn() As Byte
Dim xbBufferOut() As Byte
If LenB(CcTxtComp.Text) Then
xbBufferIn = xbBufferOut
UncompressData xbBufferIn, xbBufferOut
CcTxtVerif.Text = StrConv(xbBufferOut, vbUnicode)
Else
CcTxtVerif.Text = vbNullString
End If
If CcTxtVerif.Text <> CcTxtUncomp.Text Then MsgBox "Erreur, le flux décompressé est différent du flux d'entrée.", vbExclamation
End Sub

Où ça coince??
Afficher les 14 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.