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

Du même auteur (Fixnyl)