Est-ce possible de Dezzipé ?

Résolu
kakenette Messages postés 218 Date d'inscription dimanche 1 mai 2005 Statut Membre Dernière intervention 15 novembre 2009 - 23 juin 2005 à 22:16
nhervagault Messages postés 6063 Date d'inscription dimanche 13 avril 2003 Statut Membre Dernière intervention 15 juillet 2011 - 23 juin 2005 à 23:15
Voila en faisant un system de mise a jour pour mon progu je me
demandait si cétait possible de prendre un fichier zip et de mettre
tout le contenu de ce dernier dans un reperoit donner ?



Lol merci d'avence a vous.



kakenette

3 réponses

spaa05 Messages postés 148 Date d'inscription mardi 14 novembre 2000 Statut Membre Dernière intervention 26 juillet 2005 1
23 juin 2005 à 22:30
voici comment compréser / décompreser
Dans un module appelé : modLZW

Option Explicit


' Taille des mots à lire
Public BITCHAR As Long
' Taille des mots du dictionnaire
Public BITIND As Long
' Taille d'un long en binaire
Private Const LONGMOT = 32
Private lgDicoMin As Long
Private lgMaxDico As Long

' Taille du dictionnaire courant. Sa taille ne doit
' pas dépasser 2^BITIND
Private lgDictionnaire As Long
' Dictionnaire de compression/décompression
Private Dictionnaire() As String

' Handle du fichier à (dé)compresser
Private inFIn As Integer
' Handle du fichier résultat
Private inFOut As Integer

' Longueur du fichier source
Private lgLenF As Long
' Nombre d'éléments lus
Private lgNbLu As Long
' Nombre d'éléments écrits
Private lgNbEc
' Variable pour boucle For...Next
Private lgFor As Long

' Buffer de lecture
Private stReadBuffer As String
' Buffer d'écriture
Private stWriteBuffer As String
Private Sub CreationDico()
' Création du dictionnaire de base pour la compression/décompression
lgDicoMin = (2 ^ BITCHAR) - 1
lgDictionnaire = (2 ^ BITCHAR) - 1
ReDim Dictionnaire(lgDictionnaire) As String
For lgFor = 0 To lgDictionnaire
Dictionnaire(lgFor) = DecToBin(lgFor, BITCHAR)
Next lgFor
lgMaxDico = 2 ^ BITIND
ReDim Preserve Dictionnaire(lgMaxDico - 1) As String
End Sub
Public Function DecToBin(lgNbDec As Long, lgBase As Long) As String
' Transforme un décimal en binaire
' La fonction complète avec des 0 (ou des 1 si négatif) en fonction de BITCHAR
' Retourne le résultat sous forme de chaîne
Dim stResultat As String
Dim lgDec As Long, lgK As Long
If lgNbDec < 0 Then lgK = 1
lgDec = Abs(lgNbDec)
Do While lgDec <> 0
stResultat = (lgDec + lgK) Mod 2 & stResultat
' Divisions successives par 2, pour obtenir le nombre binaire
lgDec = lgDec \ 2
Loop
DecToBin = Right$(String$(lgBase, CStr(lgK)) & stResultat, lgBase)
End Function

Public Function BinToDec(stNbBin As String) As Long
' Transforme un binaire en décimal
Dim lgLen As Long
Dim dlResultat As Double, lgDeux As Double
Dim stTmp As String
lgLen = Len(stNbBin)
stTmp = StrReverse(stNbBin)
lgDeux = 1
For lgFor = 1 To lgLen
dlResultat = dlResultat + CLng(Mid$(stTmp, lgFor, 1)) * lgDeux
lgDeux = lgDeux * 2
Next lgFor
If dlResultat > 2147483647 Then
BinToDec = dlResultat - 4294967295#
Else
BinToDec = dlResultat
End If
End Function
Private Function InDico(stString As String) As Long
' Regarde si la chaîne 'stString' se trouve dans le dictionnaire
' Retourne sa position si la chaîne est trouvée, sinon -1
Dim lgDeb As Long
If Len(stString) > BITCHAR Then lgDeb = lgDicoMin
For lgFor = lgDeb To lgDictionnaire
If Dictionnaire(lgFor) = stString Then
InDico = lgFor
Exit Function
End If
Next lgFor
InDico = -1
End Function
Public Sub Start(blCompress As Boolean, stFileIn As String, stFileOut As String)
Dim lgTmp As Long
' Création du dictionnaire
Call CreationDico

' Initialisation des variables d'avancement
lgLenF = FileLen(stFileIn)
lgNbLu = 0
lgNbEc = 0

inFIn = FreeFile
' Ouverture du fichier d'entrée
Open stFileIn For Random Access Read As inFIn Len = Len(lgTmp)
inFOut = FreeFile
' Ouverture du fichier résultat
Open stFileOut For Random Access Write As inFOut Len = Len(lgTmp)

' Initialisation des buffers de lecture et écriture
stReadBuffer = vbNullString
stWriteBuffer = vbNullString

If blCompress Then
' Appel de la procédure de compression
Call LZW
Else
' Appel de la procédure de décompression
Call DeLZW
End If

' Fermeture des fichiers
Close inFIn
Close inFOut



End Sub
Public Function LireBIT(lgBase As Long) As String
' Lit le prochain élément de longueur 'lgBase' dans le fichier d'entrée
Dim lgTmp As Long
Dim stResultat As String

Do While Len(stReadBuffer) < 200000 And Not EOF(inFIn)
Get inFIn, , lgTmp

' Un long fait 4 octets (donc lgNbLu + 4)
lgNbLu = lgNbLu + 4
frmLZW.lblInfo1.Caption = "Lu : " & lgNbLu & " / " & lgLenF
DoEvents

' Augmente le buffer de lecture avec l'élément qui vient d'être lu
stReadBuffer = DecToBin(lgTmp, LONGMOT) & stReadBuffer
Loop
stResultat = Right$(stReadBuffer, lgBase)
' ici plantage quand streadbuffer < lgbase !!
If Len(stReadBuffer) - lgBase < 0 Then
stReadBuffer = vbNullString
Else
stReadBuffer = Left$(stReadBuffer, Len(stReadBuffer) - lgBase)
End If
LireBIT = stResultat
End Function
Public Sub EcrireBIT(stBitIndice As String)
' Ecrit l'élément 'Indice' du dictionnaire sous la base 'lgBase' dans le fichier de résultat de la compression
Dim lgTmp As Long
Dim lgFor As Long
' Augmente le buffer d'écriture avec la chaîne stBitIndice
stWriteBuffer = stBitIndice & stWriteBuffer
' Dès que la chaîne fait au moins 32 caractère (la taille d'un binaire long)
' on en convertit un morceau pour l'ajouter au fichier résultat
Do While Len(stWriteBuffer) >= LONGMOT
' Conversion Binaire vers Long
lgTmp = BinToDec(Right$(stWriteBuffer, LONGMOT))
' Ecriture dans le fichier
Put inFOut, , lgTmp

' Un long fait 4 octets (donc lgNbEc + 4)
lgNbEc = lgNbEc + 4
frmLZW.lblInfo2.Caption = "Ecrit : " & lgNbEc

' On diminue la buffer d'écriture, de la chaîne qu'on vient d'ajouter
stWriteBuffer = Left$(stWriteBuffer, Len(stWriteBuffer) - LONGMOT)
Loop
End Sub
Public Sub LZW()
' Procédure principale de compression
Dim lgChaine As Long
Dim stCourant As String
Dim stCarTmp As String
stCourant = LireBIT(BITCHAR)
Do While Not EOF(inFIn) Or stReadBuffer <> vbNullString
stCarTmp = LireBIT(BITCHAR)
If InDico(stCarTmp + stCourant) > -1 Then
stCourant = stCarTmp + stCourant
Else
Call EcrireBIT(DecToBin(InDico(stCourant), BITIND))
' Augmente le dictionnaire
lgDictionnaire = lgDictionnaire + 1 If lgDictionnaire Mod 100 0 Then frmLZW.lblInfo3.Caption "Taille Dictionnaire : " & lgDictionnaire & " (" & lgMaxDico & ")"
Dictionnaire(lgDictionnaire) = stCarTmp + stCourant
stCourant = stCarTmp
DoEvents
End If
Loop
Call EcrireBIT(DecToBin(InDico(stCourant), BITIND))
' Ecriture du bout de chaîne restant
If stWriteBuffer <> vbNullString Then ' Taille d'un élément de type long
lgChaine = BinToDec(Right$(stWriteBuffer, LONGMOT))
Put inFOut, , lgChaine
End If
End Sub
Public Function DeLZW()
' Procédure de décompression
Dim stCode As String
Dim lgAvance As Long
Dim stOld As String
Dim lgCourant As Long
Dim stCarTmp As String
Dim stCourant As String
' Initialisation de la lecture
stCode = LireBIT(BITIND)
Call EcrireBIT(Dictionnaire(BinToDec(stCode)))
stOld = stCode
Do While Not EOF(inFIn) Or stReadBuffer <> vbNullString
stCode = LireBIT(BITIND)
stCourant = Dictionnaire(BinToDec(stOld))
If BinToDec(stCode) <= lgDictionnaire Then
stCarTmp = Right$(Dictionnaire(BinToDec(stCode)), BITCHAR)
Else
stCarTmp = Right$(stCourant, BITCHAR)
End If
' Augmente le dictionnaire
lgDictionnaire = lgDictionnaire + 1 If lgDictionnaire Mod 100 0 Then frmLZW.lblInfo3.Caption "Taille Dictionnaire : " & lgDictionnaire & " (" & lgMaxDico & ")"
Dictionnaire(lgDictionnaire) = stCarTmp + stCourant
Call EcrireBIT(Dictionnaire(BinToDec(stCode)))
stOld = stCode
DoEvents
Loop
End Function


Dans une form appelé : frmLZW

Private Sub cmdGo_Click()
' Lance l'opération de compression/décompression

' Vérifie que le fichier source existe
If Dir(txtSource.Text) = vbNullString Then
MsgBox "Le fichier source n'existe pas!", vbInformation, "Données incorrectes"
txtSource.SetFocus
Exit Sub
End If
' Vérifie que le fichier résultat n'existe pas
If Dir(txtResultat.Text) <> vbNullString Then
MsgBox "Le fichier résultat existe déjà!", vbInformation, "Données incorrectes"
txtResultat.SetFocus
Exit Sub
End If

BITCHAR = CLng(txtBITCHAR.Text)
BITIND = CLng(txtBITIND.Text)

lblInfo4.Caption = "Début : " & Time
If optChoix(0).Value Then
' Lance la compression
Call Start(True, txtSource.Text, txtResultat.Text)
Else
' Lance la décompression
Call Start(False, txtSource.Text, txtResultat.Text)
End If
lblInfo4.Caption = lblInfo4.Caption & "/ Fin : " & Time
End Sub

Private Sub cmdQuitter_Click()
' Pour Quitter l'application
Unload Me
End Sub

Private Sub cmdSource_Click()
' Choix du fichier source, affichage de la fenêtre d'ouverture d'un
' fichier avec le contrôle CommonDialog
cdgFichier.DialogTitle = "Choix d'un fichier source"
cdgFichier.Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or _
cdlOFNLongNames Or cdlOFNPathMustExist Or cdlOFNHideReadOnly
cdgFichier.CancelError = False
cdgFichier.Filter = "Tous les fichiers (*.*)|*.*"
cdgFichier.ShowOpen
txtSource.Text = cdgFichier.FileName
If optChoix(0).Value Then
txtResultat.Text = txtSource.Text & ".lvb"
Else
txtResultat.Text = Left$(txtSource.Text, Len(txtSource.Text) - 4)
End If
End Sub

Private Sub Form_Load()
' Initialisation des zones de la fenêtre
txtSource.Text = vbNullString
txtResultat.Text = vbNullString
optChoix(0).Value = True
lblInfo1.Caption = vbNullString
lblInfo2.Caption = vbNullString
lblInfo3.Caption = vbNullString
lblInfo4.Caption = vbNullString
End Sub

Private Sub lblTmp_Click(Index As Integer)

End Sub

Private Sub optChoix_Click(Index As Integer)
' Change le nom du fichier résultat lorsque la méthode change
If txtSource.Text <> vbNullString Then
If optChoix(0).Value Then
txtResultat.Text = txtSource.Text & ".lvb"
Else
txtResultat.Text = Left$(txtSource.Text, Len(txtSource.Text) - 4)
End If
End If
End Sub
3
kakenette Messages postés 218 Date d'inscription dimanche 1 mai 2005 Statut Membre Dernière intervention 15 novembre 2009 1
23 juin 2005 à 22:35
et je l'appelle comment ?



raa tous se qu'il y a ^^



Genre imaginon que jai ca dans un modul et que je veut dézzipé je fait appelle comment a ca ?



call dézipé "Moi.zip"



lol comment ^^

kakenette
0
nhervagault Messages postés 6063 Date d'inscription dimanche 13 avril 2003 Statut Membre Dernière intervention 15 juillet 2011 37
23 juin 2005 à 23:15
Salut



Call Start(False, txtSource.Text, txtResultat.Text)

ou txtSource.text est le nom du fichier



Il y avait la reponse dans le fichier ;-)



Il y a une form a la fin ;_)*



voila
0
Rejoignez-nous