Lister le contenu d'un fichier zip (sans dll)

Description

[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

Codes Sources

A voir également

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.