Enfin la suppression d'une arborescence sans api ni filesystemobject !

0/5 (9 avis)

Snippet vu 6 132 fois - Téléchargée 33 fois

Contenu du snippet

Suppression d'un répertoire SANS API et SANS l'utilisation de FSO. Utilisation récursise d'une fonction utilisant l'instruction DIR. Même les fichiers / répertoires ayant les attributs systèmes / cachés / ReadOnly seront supprimés ! Donc, si vous le fait à la racine d'un disque, VOUS SUPPRIMEREZ TOUT LE CONTENU DE VOTRE DISQUE !

Source / Exemple :


Private Sub DelDir(ByVal PStrPath As String, Optional ByVal PBolDelSubDir As Boolean = True)
Const MODULE = "DelDir"
Dim LStrNomFic As String

    On Error GoTo TrtErrDelDir
    
    If Right$(PStrPath, 1) = "\" Then PStrPath = Left$(PStrPath, Len(PStrPath) - 1)
    
    ' Parcours récursif des sous-répertoires.

    If PBolDelSubDir Then
        Do
            LStrNomFic = Dir(PStrPath & "\*.*", vbDirectory)
            While LStrNomFic = "." Or LStrNomFic = ".." Or (GetAttr(PStrPath & "\" & LStrNomFic) And vbDirectory) <> vbDirectory
                LStrNomFic = Dir
            Wend
            
            If LStrNomFic <> "" And (GetAttr(PStrPath & "\" & LStrNomFic) And vbDirectory) = vbDirectory Then
                Call DelDir(PStrPath & "\" & LStrNomFic)
            End If
        Loop Until LStrNomFic = ""
    End If
    
    ' Suppression des fichiers se trouvant dans le répertoire en cours.

    LStrNomFic = Dir(PStrPath & "\*.*", vbNormal + vbReadOnly + vbHidden + vbSystem + vbArchive)
    While LStrNomFic <> ""
        SetAttr PStrPath & "\" & LStrNomFic, vbNormal
        DoEvents
        
        Kill PStrPath & "\" & LStrNomFic
        DoEvents
        
        LStrNomFic = Dir
    Wend
    
    If Len(PStrPath) > 3 Then
        SetAttr PStrPath, vbNormal
        DoEvents
        
        RmDir PStrPath
    End If
    
ExitDelDir:
    
    DoEvents
    
    Exit Sub
    
TrtErrDelDir:
    
    MsgBox "MODULE : " & MODULE & vbCrLf _
        & "PARAM. :" & vbCrLf _
        & "  Path   = " & PStrPath & vbCrLf _
        & "  SubDir = " & PBolDelSubDir & vbCrLf _
        & "ERREUR : " & Err.Number & vbCrLf _
        & Err.Description, vbCritical, App.EXEName
    
    Resume ExitDelDir

End Sub

Conclusion :


Appel du SUB :
DelDir("C:\Windows\Temp", True) -> Suppression du répertoire Temp et de ses sous-répertoires. A la fin de cette opération le répertoire C:\Windows\Temp n'existera plus !
DelDir("C:\Windows\Temp", False) -> Suppression UNIQUEMENT DES FICHIERS se trouvant dans le répertoire Temp (pas de parcours dans les sous-répertoires).

A voir également

Ajouter un commentaire Commentaires
Messages postés
2
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
5 novembre 2007

Dans ce cas, fais l'essai de supprimer un répertoire ayant un grand nombre de sous-répertoires avec ta méthode, puis avec la mienne, et n'oublie surtout pas de nous tenir au courant du résultat ... ;) Ce n'est pas parce que les ordinateurs d'aujourd'hui ont de plus en plus de mémoire qu'ils ont aussi une pile illimitée ! Ce n'est pas la mémoire de ton ordi que tu vas saturer mais LA PILE ! Le gros avantage de ma fonction par rapport à la tienne réside dans le fait que je n'utilise la récursivité QUE POUR DESCENDRE d'un niveau dans l'arborescence des sous-répertoires et, contrairement à ta méthode, cela est indépendant du NOMBRE de sous-répertoires qu'il y a dans le (sous-)répertoire où tu te trouves ! Plus concrêtement, prenons l'exemple suivant : je souhaite supprimer le répertoire "C:\TOTO" qui contient 50.000 (ce n'est qu'un exemple) sous-répertoires, mais tous sont au même niveau, donc directement sous TOTO ... Avec ma méthode, la récursivité n'ira donc pas plus bas que UN niveau (car avant de passer au répertoire suivant, le programme aura dépilé), alors qu'avec ta méthode, tu vas redimensionner un tablau avec une taille de 50.000 ! Là, je doute que ton ordi apprécie la chose ...

D'autre part, ma fonction est destinée à SUPPRIMER une arborescence et non d'en lister le contenu ! Compare donc ce qui est comparable ! Cela dit, si je voulais lister le contenu d'une arborescence, j'aurai sans doute fait un autre code, et je n'aurai pas pour autant utilisé ta fonction car elle ne marchera pas ! Utiliser récursivement la fonction Dir n'est pas une riche idée car c'est une fonction VB qui est GLOBALE à ton projet et non LOCALE à ta fonction ! Alors fais l'essai et tu verras que la liste des fichiers que tu récupèreras sera incomplète ...
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
67
plus de Dos sous Vista, mais pas plus ni moins que sous Xp....

coté consommation de la pile, le coté récursif de la chose n'est pas mal non plus :p
d'ici a saturer la mémoire avec un tableau de String, va falloir y aller ^^
Messages postés
2
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
5 novembre 2007

En réponse à SamsonTam, j'aurai 2 petits commentaires à faire :

1- A moins que je n'ai pas compris ce que tu voulais dire, mais, sauf erreur de ma part, ma fonction n'est récurcive QUE si tu lui demandes de supprimer aussi les sous-répertoires en lui passant le dernier paramètre à "True" ... Donc, si tu ne souhaites supprimer QUE LES FICHIERS, je ne vois pas où sera la boucle infinie puisque la fonction n'exécutera pas la partie récurcive !

2- Je n'ai pas testé ton code mais je vois que tu utilises des tableaux que tu redimensionnes dynamiquement ... C'est bien, mais je crois que ton programme aura pas mal de chances de planter dans le cas où tu as beaucoup (pas juste 10 ou 20) de sous-répertoires à supprimer car ta pile risque de ne pas trop aimer ...

En réponse à Renfield, cette fonction a le mérite de fonctionner sous Vista aussi ... Essaie de faire un 'Shell "Cmd ..."' sous Vista sachant qu'il n'y a plus de "DOS" ! ;-)
Messages postés
3
Date d'inscription
samedi 30 décembre 2006
Statut
Membre
Dernière intervention
31 décembre 2006

La procédure est fonctionnelle mais seulement dans le cas de suppression du répertoire au complet, je m'explique :

La procédure recommence à lister le répertoire au complet depuis le début après s'avoir appelé elle-même. Donc, ça marche si on supprime tout, mais sinon on entre dans une boucle infinie aussitôt qu'il y a un dossier impossible à supprimer. Car, à chaque fois, la procédure recommencera depuis le début et repassera sur le même répertoire indédiniment.

Do
'ICI <- (La procédure recommence à lister le répertoire depuis le début)
LStrNomFic = Dir(PStrPath & "\*.*", vbDirectory)
While LStrNomFic "." Or LStrNomFic ".." Or (GetAttr(PStrPath & "" & LStrNomFic) And vbDirectory) <> vbDirectory
LStrNomFic = Dir
Wend

If LStrNomFic <> "" And (GetAttr(PStrPath & "" & LStrNomFic) And vbDirectory) = vbDirectory Then
Call DelDir(PStrPath & "" & LStrNomFic)
End If
Loop Until LStrNomFic = ""


Voici un listing qui passera 1 seule fois sur chaque dossier

Private Function GetFilesPaths(ByVal PStrPath As String, ByRef FPathList() As String, _
Optional ByVal SubFolders As Boolean True, Optional Begin As Boolean False)
Dim FPath As String
Static UB As Long

On Error GoTo ExitDelDir

If Begin Then UB = -1
If Right$(PStrPath, 1) "" Then PStrPath Left$(PStrPath, Len(PStrPath) - 1)

' Parcours récursif des sous-répertoires.
If SubFolders Then
FPath = Dir(PStrPath & "\*.*", vbDirectory)
'On lis chaque ficher/répertoire
While FPath <> ""
'On lance la procédure uniquement s'il s'agit d'un répertoire autre que "." et ".."
If FPath <> "." and FPath <> ".." and _
(GetAttr(PStrPath & "" & FPath) And vbDirectory) = vbDirectory Then
GetFilesPaths PStrPath & "" & FPath, FPathList()
End If
FPath = Dir
Wend
End If

FPath = Dir(PStrPath & "\*.*")
While FPath <> ""
UB = UB + 1
ReDim Preserve FPathList(UB)
FPathList(UB) = App.Path & "" & FPath
FPath = Dir
Wend

ExitDelDir:

DoEvents

End Function

Sinon c'est utile.
Messages postés
9
Date d'inscription
samedi 12 mars 2005
Statut
Membre
Dernière intervention
19 août 2006

Bravo pour cette excellente source
grâce à toi j'ai pu résoudre mon problème et surtout mieux comprendre
le méchanisme.
je ne peux que noter 10
Afficher les 9 commentaires

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.