Compare et supprime les fichiers identiques

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

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)