1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Compare et supprime les fichiers identiques

Compare et supprime les fichiers identiques

Soyez le premier à donner votre avis sur cette source.

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

Commenter

Contenu du snippet

Ce script compare et supprime tous les fichiers identiques d'un dossier

Source / Exemple : 


'declaration des objets
Set ShellA = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dictionary = CreateObject("Scripting.Dictionary")

'choix du dossier
Set objFolder = ShellA.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", 0, "")       

'on determine si le dossier est valide
If objFolder Is Nothing = True Then WScript.Quit
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
objPath = Replace(objPath, "\", "\\")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery("Select * from Win32_Directory where name = '" & objPath & "'")
For Each objFile in colFiles
     If objFile.Readable = True Then strPath = objFile.Name
Next
If strPath = "" Then Wscript.Quit

'creation d'une collection contenant tous les fichiers avec le path
strFolder = Mid(strPath,4)
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery("Select * from CIM_DataFile where Path = '\\" & strFolder & "\\'")
For Each objFile in colFiles        
    Dictionary.Add objFile.Name , objFile.Name
Next

'debut de la boucle de comparaison et de suppression
For Each strKey in Dictionary
     Set File =  FSO.GetFile(strKey)
     If File.Size Then
         For Each strKey2 in Dictionary
             If strKey <> strKey2 Then     'vaut mieux eviter la comparaison avec lui meme
                Set File2 =  FSO.GetFile(strKey2)
                If File.Size = File2.Size Then          'les fichiers ont la meme taille on suppose qu'ils sont identiques
                   DeleteFile=True
                   Set File1 = FSO.OpenTextFile(strKey, 1)
                   Set File2 = FSO.OpenTextFile(strKey2, 1)
                   Do Until File1.AtEndOfStream                   'ici les fichiers sont comparer ligne par ligne
                        strLine1 = File1.Readline
                        strLine2 = File2.Readline
                        If strLine1 <> strLine2 Then 
                           DeleteFile=False
                           Exit Do
                        End If
                   Loop                   
                   File1.Close
                   File2.Close
                   If DeleteFile = True then   
                      FSO.DeleteFile(strKey2)
                      Dictionary.Remove strKey2
                   End If
               End If
             End If
        Next
    End If
Next

WScript.Echo "Compare & Delete End."

A voir également

Ajouter un commentaire

Commentaires

Signaler
Messages postés
11
Date d'inscription
mardi 21 janvier 2003
Statut
Membre
Dernière intervention
8 décembre 2013
 1
c'est un truc au quel je n'avais pas pensé, il serait possible de faire un choix de cette manière...

il suffit pour ça de remplacer les 2 lignes :

FSO.DeleteFile(strKey2)
Dictionary.Remove strKey2

par celle-ci :

r= msgbox("Quel fichier voulez-vous supprimer?" _
& chr(13) & "Répondre oui supprimera le fichier : " _
& strKey2 & chr(13) & "non supprimera le fichier : " _
& strKey2, 3 )

select case r
case 2 'annuler
strKey=""
case 6 'oui
strKey=strKey2
end select

if strKey <> "" then
FSO.DeleteFile(strKey)
Dictionary.Remove strKey
end if

... et aussi si les fichiers son de grandes tailles c'est possible que ça ne marche pas mais bon j'en suis pas sur.

-------------------------------------------------------------------

je pense faire une version qui pourrait prendre en charge 2 dossiers différents.
Signaler
Messages postés
39
Date d'inscription
mardi 2 septembre 2003
Statut
Membre
Dernière intervention
7 décembre 2006
Bonjour,
Oui, l'idée est bonne et c'est certainement très pratique.

Je vous remercie pour la leçon sur l'utilisation des objets.

Vous serez-t-il possible de donner le choix du fichier à supprimer ?
....................
If DeleteFile = True Then
' Affichage chemin 1
' Affichage du chemin 2
' Proposition de choix
' si 1 alors
' FSO.DeleteFile(strKey1)
' Dictionary.Remove strKey1
'si 2 alors
' FSO.DeleteFile(strKey2)
' Dictionary.Remove strKey2
' fin de choix
End If
.................
En effet, ce n'est pas forcément le premier fichier rencontré qui est à la bonne place !

Bien cordiales salutations
Signaler
Messages postés
1467
Date d'inscription
samedi 13 mars 2004
Statut
Membre
Dernière intervention
5 mai 2010
 2
Oui, mais c'est assez utile quand même, bien vue ! ;-)
Signaler
Messages postés
88
Date d'inscription
vendredi 26 avril 2002
Statut
Membre
Dernière intervention
24 février 2006
C'est simplement une comparaison de taille. Pour être parfait, une comparaison de CRC serait préferable.
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.

Du même auteur (Fixnyl)