Liste de fichiers sur un disque en vb6

Soyez le premier à donner votre avis sur cette source.

Vue 9 115 fois - Téléchargée 725 fois

Description

Ce programme permet de lister une arborescence de répertoires et de fichiers.
Le résultat est mis dans un fichier texte de votre choix.

Un fichier "\fichiersOuRepertoiresNonLus.txt" liste les erreurs d'accès
(droits d'accès ou fichier ouvert par autre appli ou erreur disque à cet endroit)
Il est dans le répertoire où est installé le programme.

La fonction de listage et les fonctions de tri utilisent pas mal d'accès disque.. il est donc préférable d

'installer le programme sur un disque dur et non sur une clé USB (ca peut être 10 fois plus long)

Le programme de tri peut être utilisé à d' autres fins Sa vitesse est en "NLog(N)" et dépend de la vitesse du

disque dur ou du média utilisé. Il peut nécessiter jusque à 4 fois le volume mémoire du fichier à trier.
En gros, on trie des ensembles déja ordonnés. Au début par 2, puis par 4 puis par ..2^n>= nb de lignes à
trier.J'appelle cela un 'tri Binaire .." Mais assez efficace.

C'est juste pour le fun et plaisir de programmer en VB car même le vieux MSDOS est efficace sur le sujet.

dir c:\rep_toto /s/w/ah/ar/aa/b >d:\tmplst.txt par exemple! Mais ça ne dit pas comment c'est fait!

Source / Exemple :


Public Sub FileSearch(xPath, XFile, xFichierSortie, xTypesDeFichiersRecherches As Byte)
    Dim ww As String
    Dim xx, yy, zz, FichierErreurs As Integer
    Dim NbErreurs As Long
    Dim w, wx As String
    Dim Test As Boolean
    Dim Entree1, Entree2 As String
    
    Entree1 = App.Path & "\tmp1.txt"
    Entree2 = App.Path & "\tmp2.txt"
    
    FichierErreurs = FreeFile:  Open App.Path & "\fichiersOuRepertoiresNonLus.txt" For Output As 

FichierErreurs
    
    zz = FreeFile: Open xFichierSortie For Output As zz
    Test = False
    xx = FreeFile
    Open Entree1 For Output As xx
        w = ""
        On Error GoTo TERR
        w = Dir(xPath & "*.*", xTypesDeFichiersRecherches)
        On Error GoTo 0
        While w <> ""
            If w <> ".." And w <> "." Then
                w = xPath & w
                If IsFile(w) Then
                    Print #zz, w
                Else
                    Print #xx, w
                    Test = True
                End If
            End If
            w = Dir
        Wend
    Close xx
    
    While Test
        xx = FreeFile: Open Entree1 For Input As xx
        yy = FreeFile: Open Entree2 For Output As yy
        Test = False
        While Not EOF(xx)
            Line Input #xx, w
            Print #zz, w & "\"
            ww = ""
            On Error GoTo TERR
            ww = Trim(Dir(w & "\*.*", xTypesDeFichiersRecherches))
            On Error GoTo 0
            While ww <> ""
                If ww <> ".." And ww <> "." Then
                    ww = w & "\" & ww
                    If IsFile(ww) Then
                        Print #zz, ww
                        LblInfo = w
                        DoEvents
                    Else
                        Print #yy, ww
                        Test = True
                    End If
                End If
                ww = Trim(Dir)
            Wend
        Wend
        wz = Entree1: Entree1 = Entree2: Entree2 = wz
        Close xx
        Close yy
    Wend
    Close zz
    If ExistFile(Entree1) Then Kill Entree1
    If ExistFile(Entree2) Then Kill Entree2
    Me.SetFocus
    ww = " Liste disponible dans : " & RésultatTxt.Text
    ww = ww & vbCrLf
    ww = ww & vbCrLf & "  Fichiers ou répertoires inaccessibles = " & NbErreurs
    ww = ww & vbCrLf & "  Voir le fichier " & App.Path & "\fichiersOuRepertoiresNonLus.txt"
    ww = ww & vbCrLf
    LblInfo.Caption = ww
    Close #FichierErreurs
    Exit Sub
TERR:
    Print #FichierErreurs, Err.Number, "| " & w & " |"
    NbErreurs = NbErreurs + 1
    Resume Next
End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

shaeks
Messages postés
24
Date d'inscription
mercredi 27 juillet 2005
Statut
Membre
Dernière intervention
21 janvier 2014

Il est super ce code 10/10 :-)
cs_CFCTABLE
Messages postés
18
Date d'inscription
samedi 1 mars 2003
Statut
Membre
Dernière intervention
14 avril 2008

:) oui je suis bien d'accord.. et c'est pour cela que je suis en train de reprendre le code , en particulier celui du tri, je remettrais des commentaires et des explications ..
bintou123
Messages postés
12
Date d'inscription
mardi 5 décembre 2000
Statut
Membre
Dernière intervention
28 janvier 2009

je trouve ce code bon mais trop opaque pour bien comprendre ajoute les commentaires
merci!
cs_PaTaTe
Messages postés
1878
Date d'inscription
mercredi 21 août 2002
Statut
Contributeur
Dernière intervention
7 janvier 2019

Pour ma part je trouve que ce code manque de clarté. Essais de mettre des noms de variables cohérentes avec ce qu'elle sont supposées contenir. Evites les variables sans type :

Public Sub FileSearch(xPath, XFile, xFichierSortie, xTypesDeFichiersRecherches As Byte)

3 dans la première ligne déjà
Renfield
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
60
"j'ai mis 22 en dur pour ne pas effectuer le calcul à chaque passage"
calculé une fois, a la compilation...

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.