[Permet de lister le contenu d'un fichier zip grace a une fonction sans dll ou control activeX]
Tout simplement car j'en avais marre d'utiliser des dll lourde a implementer
et toujours encombrante a distribuer et par ce que j'avais besoin de lister le contenu d'un zip de maniere simple et rapide je vous livre une routine
efficace...
Contient egalement une version etendue pour afficher par exemple
la taille du fichier ou son taux de compression !
Source / Exemple :
' O O O
' \__/ \__/
' /=||=||=\ oouuuunnnnnnnnmmmmmmmmmmmmmm\
' // ||_|| ZIP Browser \
' \\ /\ #\ oouuuunnnnnnnnmmmmmmmmmmmmmmmm\
' /=( \ )==> Coded by EBArtSoft@ \
'// \O_\/ Copyright(C) 2003 \
'\\ || || post http://www.vbfrance.com \
' \==||=||==/ oouuuunnnnnnnnmmmmmmmmmmmmmmmmmmmm\
' ===========
'==== E.B ====
'------------------------------------------------------------------
' Function ZIPBrowse
'------------------------------------------------------------------
' Renvoi une collection contenant les
' fichiers/dossier d'une archive ZIP
'------------------------------------------------------------------
Private Function ZIPBrowse(ByVal vFileName As String) As Collection
'drapeau indicant si le fichier est bon ou non
Dim Found As Boolean
'var conteantn le nombre de fichier dans le zip
Dim FileNum As Integer
'var con,tenant les nom de fichier
Dim Name As String
'var temporaire multiusage
Dim Temp As Long
'var d'index
Dim i As Long
'var d'index
Dim j As Long
'var contenant le n° de fichier libre
Dim f As Long
'recupere un n° de fichier libre
f = FreeFile
'test l'ouverture du fichier
Open vFileName For Input As #f: Close #f
'ouvre le fichier
Open vFileName For Binary Access Read Lock Write As #f
'recupere la signature du fichier
Get #f, , Temp
'si la signature est un zip (PK)
If Temp = &H4034B50 Then
'parcour le dossier
For i = LOF(1) - 20 To 1 Step -1
'recupere un mot long
Get #f, i, Temp
'si la signature correspond
If Temp = &H6054B50 Then
'recupere le nombre de fichier
Get #f, i + 10, FileNum
'definis le drapeau
Found = True
'quitte la boucle
Exit For
End If
Next
End If
'si le fichier est bon !
If Found Then
'crée une nouvelle collection
Set ZIPBrowse = New Collection
'parcour tout les fichiers
For j = 1 To FileNum
'initialise le pointer
i = i - 36
'parcour le dossier
For i = i To 1 Step -1
'recupere un mot long
Get #f, i, Temp
'si la signature correspond
If Temp = &H2014B50 Then
'recupere la longueur du nom de fichier
Get #f, i + 28, Temp
'crée un buffer
Name = Space(Temp)
'recupere le nom de fichier
Get #f, i + 46, Name
'ajoute dans la collection
ZIPBrowse.Add Name
'quitte la boucle
Exit For
End If
Next
Next
End If
'ferme le fichier
Close #f
End Function
Conclusion :
J'accepte volontier toute optimisation de taille ou de rapidité
Mise à jour :
- 23 Oct 2003 :
Extraction Niveau 0
Some bug fix
b@nne prog
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.