Lister les fichiers d'un disque (v4)- amélioré le 17/05/02

Commenter

Contenu du snippet

Scan de la totalité d'un disque à la recherche des fichiers avec la possibilité de rediriger le résultat vers le disque ou vers un tableau.
De plus, on peut spécifier les extensions des fichiers à remonter.

Source / Exemple : 


Public Enum eREDIRECTION
    eREDIRECT_FICHIER
    eREDIRECT_TABLEAU
End Enum

Public Sub SCANNER_LE_DISQUE2(ByVal LE_REP_DE_DEPART As String, _
                              ByVal LA_REDIRECTION As eREDIRECTION, _
                              Optional ByVal LES_MASQUES As String = vbNullString, _
                              Optional ByRef LE_TABL_DE_SORTIE As Variant, _
                              Optional ByVal LE_NO_DE_FICHIER As Long = 1)
                             
On Error Resume Next 'Obligatoire pour ne pas être emmerdé par les fichier systèmes (jusqu'à autre solution...)

Dim I, N                  As Long
Dim LE_COMPTEUR           As Long
Dim LE_NOM_FICHIER        As String
Dim LE_TABL_DE_REP_FILS() As String
Dim LE_SPLIT_EXT()        As String 'Va permettre de récupérer l'extension d'un fichier

    LE_COMPTEUR = 0
    LES_MASQUES = UCase(LES_MASQUES)

    LE_NOM_FICHIER = Dir(LE_REP_DE_DEPART, vbReadOnly) 'Fichiers sans attribut + Fichiers en lecture seule ...
    
    Do While LE_NOM_FICHIER <> ""
        LE_SPLIT_EXT = Split(UCase(LE_NOM_FICHIER), ".") 'On utilise Split plutôt qu'un Right$(,3) car l'extension peut ne pas compter 3 car !
                
        LE_COMPTEUR = LE_COMPTEUR + 1: If (LE_COMPTEUR Mod 10) = 0 Then DoEvents
        
        If InStr(1, LES_MASQUES, ";" & LE_SPLIT_EXT(UBound(LE_SPLIT_EXT)) & ";") <> 0 Then
            Select Case LA_REDIRECTION
            Case eREDIRECT_FICHIER: Print #LE_NO_DE_FICHIER, LE_REP_DE_DEPART & LE_NOM_FICHIER
            Case eREDIRECT_TABLEAU:
                ReDim Preserve LE_TABL_DE_SORTIE(1 To 2, UBound(LE_TABL_DE_SORTIE, 2) + 1) As String
                
                LE_TABL_DE_SORTIE(1, UBound(LE_TABL_DE_SORTIE, 2)) = LE_REP_DE_DEPART
                LE_TABL_DE_SORTIE(2, UBound(LE_TABL_DE_SORTIE, 2)) = LE_NOM_FICHIER
            End Select
        End If
        
        LE_NOM_FICHIER = Dir 'Fichier Suivant
    Loop
    
    'Cherche ts les répertoires "fils"
    LE_NOM_FICHIER = Dir(LE_REP_DE_DEPART, vbDirectory) 'Fichiers sans attribut + répertoires ...

    Do While LE_NOM_FICHIER <> ""
        LE_COMPTEUR = LE_COMPTEUR + 1: If (LE_COMPTEUR Mod 10) = 0 Then DoEvents

        If LE_NOM_FICHIER <> "." And LE_NOM_FICHIER <> ".." Then
            'On regarde si le fichier est un répertoire. Si tel est le cas, on mémorise son nom
            'afin de scruter les sous répertoire de celui-ci par la suite...
            If (GetAttr(LE_REP_DE_DEPART & LE_NOM_FICHIER) And vbDirectory) = vbDirectory Then 'ATTENTION : Les fic systèmes nous foutent en erreur !
                N = N + 1
                ReDim Preserve LE_TABL_DE_REP_FILS(N) As String
                'Mémorise le nom du répertoire
                LE_TABL_DE_REP_FILS(N) = LE_REP_DE_DEPART & LE_NOM_FICHIER
            End If
        End If

        LE_NOM_FICHIER = Dir 'Fichier suivant dans la liste extraite par LE_NOM_FICHIER = Dir(CurrentPath, vbDirectory)
    Loop
    
    'Recense ts les fichiers des répertoires mémorisés => Va nous donner : 1. Une liste de fichiers
    '                                                                      2. Une autre liste de sous-répertoire (éventuellement)
    For I = 1 To N
        SCANNER_LE_DISQUE2 LE_TABL_DE_REP_FILS(I) & "\", LA_REDIRECTION, LES_MASQUES, LE_TABL_DE_SORTIE, LE_NO_DE_FICHIER
    Next I
End Sub

Private Sub Form_Load()
Dim A() As String
Dim J
Dim T1, T2

    'Open "d:\Files.txt" For Output As #1
    
    T1 = Time
    
    ReDim A(1 To 2, 0) As String 'A faire avant d'appeler SCANNER_LE_DISQUE sous peine d'erreur !
    
    'SCANNER_LE_DISQUE1 "Q:\", eREDIRECT_TABLEAU, ";zip;exe;doc;pdf;", A, 1
    SCANNER_LE_DISQUE2 "d:\", eREDIRECT_TABLEAU, ";zip;exe;doc;pdf;", A, 1
    
    For J = LBound(A, 2) + 1 To UBound(A, 2)
        Debug.Print A(1, J) & A(2, J)
    Next J
    
    'Close #1
    
    T2 = Time
    
    MsgBox DateDiff("s", T1, T2)
    
    Unload Me
End Sub

Conclusion :


!! Un bogue était présent dans mon évolution précédente dans la recherche des masques. Il faut à présent lister vos masques comme spécifié plus loin ... Désolé !

J'ai modifié la façon de tester le masque d'extensions et j'ai finalement réussi sur mon PC à gagner entre 10 et 15s sur le temps de scan de mon disque (en spécifiant un masque !) soit environ 10 à 15% d'optimisation.

SCANNER_LE_DISQUE2 et SCANNER_LE_DISQUE1 représentent les 2 version de mon code (pour comparer les temps d'exécution).

Vous remarquerez que la façon de lister les extensions à changé : il faut IMPERATIVEMENT lister en ";xx1;xx2;" les ";" sont obligatoires au début et à la fin sous peine de voir apparaître des extensions non souhaitées !

Dans le Form_Load, vous trouverez les détails de l'appel de ma procédure.

Je remercie d'ailleurs l'auteur FrostByte pour le source original que j'ai simplement modifié , un peu amélioré et pas mal commenté...

A voir également

S'inscrire maintenant

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.