begin process at 2008 07 04 00:51:48
1 204 456 membres
3 nouveaux aujourd'hui
14 114 membres club

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

LISTE DE FICHIERS SUR UN DISQUE EN VB6


Information sur la source

Catégorie :Fichier / Disque Classé sous : algorithme, tri, liste, vb6, arborescence Niveau : Initié Date de création : 03/04/2008 Date de mise à jour : 04/04/2008 09:52:50 Vu / téléchargé: 3 772 / 282

Note :
Aucune note

Commentaire sur cette source (7)
Ajouter un commentaire et/ou une note

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

  • 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
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
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

04 avril 2008 09:52:50 :
Modification open #1 par FichierErreurs = FreeFile Paramétage de la fonction par xTypesDeFichiersRecherches (=vbDirectory Or vbSystem Or vbHidden)
  • signaler à un administrateur
    Commentaire de jack le 04/04/2008 01:28:37 administrateur CS

    Salut
    Ce qui m'étonne, c'est que la liste des fichiers ne soient pas déjà dans l'ordre alphabétique lors de l'acquisition - pas fait l'essai.

    Conseil pour la clarté du code :
    Dir(w & "\*.*", 22) ---> Dir(w & "\*.*", vbDirectory Or vbSystem Or vbHidden)
    (bizarre comme choix)
    Chr$(13) & Chr$(10) ---> vbCrLf

    + Close #1 ---> A revoir : aucun fichier n'a été ouvert avec ce numéro.
    Coup de bol si xx, yy ou zz correspondent = futur bug

  • signaler à un administrateur
    Commentaire de Renfield le 04/04/2008 06:51:14 administrateur CS

    me semble pas que Dir trie quoi que ce soit, effectivement...

    ben si:
    Open App.Path & "\fichiersOuRepertoiresNonLus.txt" For Output As #1

    justement, je trouve pas forcément top ce canal en dur... alors qu'après tu passes par FreeFile...
    tu dépose une fonction, donc exportable, réutilisable... d'autres programme qui integreront ta fonction auront peut etre déjà un #1 ouvert, et là.... boum!

    plutot que de passer (jongler, dans le cas présent)par des fichiers temporaires.
    Jack ici présent et moi même avons fais des "Dir récursif" qui aident à ce niveau...

    http://www.vbfrance.com/code.aspx?ID=37859
    et
    http://www.vbfrance.com/code.aspx?ID=43640

  • signaler à un administrateur
    Commentaire de CFCTABLE le 04/04/2008 09:57:40

    A l'origine ce programme était écrit en QuickBasic et la mémoire vive était chère c'est pour cela que je n'avais pas utilisé de fonctions trop élaborées.
    Les fonctions de tri sont dans le module HTSortMod.C'est pareil, les cannaux d'ouverture de fichier étaient en dur et je les ai laissés tels quels.
    Pour Dir(w & "\*.*", 22) ---> Dir(w & "\*.*", vbDirectory Or vbSystem Or vbHidden), j'ai mis 22 en dur pour ne pas effectuer le calcul à chaque passage! mais effectivement JACK, ton idée est bonne , je vais  mettre cette valeur dans une variable ce qui permettra de paramétrer la recherche.
    Quand au choix des valeurs a été fait pour avoir tous les fichiers.
    Pour le open #1 je l'ai juste rajouté vite fait pour fournir une liste de fichiers non traités!. Comme j'ai un peu de temps, je modifie le code et refait un Post.
    Voila c'est fait.
    Merci pour vos commentaires.

  • signaler à un administrateur
    Commentaire de Renfield le 04/04/2008 10:24:47 administrateur CS

    "j'ai mis 22 en dur pour ne pas effectuer le calcul à chaque passage"
    calculé une fois, a la compilation...

  • signaler à un administrateur
    Commentaire de PaTaTe le 04/04/2008 13:10:24

    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à

  • signaler à un administrateur
    Commentaire de bintou123 le 14/04/2008 14:37:06

    je trouve ce code bon mais trop opaque pour bien comprendre ajoute les commentaires
    merci!

  • signaler à un administrateur
    Commentaire de CFCTABLE le 14/04/2008 15:53:54

    :) 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 ..

Ajouter un commentaire

Pub



Appels d'offres

CalendriCode

Juillet 2008
LMMJVSD
 123456
78910111213
14151617181920
21222324252627
28293031   

VS Express FR Gratuit !

VS Express en français et 100% gratuit !

Téléchargements

Logiciels à télécharger sur le même thème :

Boutique

Boutique de goodies CodeS-SourceS