Doublons - Recherche et suppression de fichiers identiques

Présentation
Recherche et suppression de doublons sous Windows.

Par doublons on entend des fichiers identiques, même avec des noms différents (mais avec la même extension toutefois).

Le programme DEMO1.PAS recherche des doublons dans un dossier donné pour un fichier donné.
Le programme DEMO2.PAS recherche des doublons dans un dossier donné pour un ensemble de fichiers.
Le programme DEMO3.PAS recherche des doublons pour un ensemble de fichiers et les envoie à la corbeille.
Le programme DEMO4\DEMO.LPR est une application fenêtrée qui permet de rechercher les doublons pour un ensemble de fichiers avec en option la possibilité de les envoyer aussitôt à la corbeille.
Le programme DEMO5\DEMO.LPR fait la même chose que le précédent, avec cette différence qu'on peut choisir les fichiers à envoyer à la corbeille.

Les projets Lazarus utilisent l'unité THDIALOGS.PAS :

https://www.developpez.net/forums/d1471072/autres-langages/pascal/contribuez/fonction-substitution-messagedlg/

Les programmes ont été testés sous Windows 10 avec FPC 3.0.2 et Lazarus 1.6.4.
Téléchargement
Compatibilité
Windows
2  0 
Téléchargé 33 fois Voir les 6 commentaires
Détails
Catégories : Programmes complets
Avatar de Roland Chastain
Rédacteur / Modérateur
Voir tous les téléchargements de l'auteur
Licence : Autre
Date de mise en ligne : 10 mars 2017




Avatar de ThWilliam ThWilliam - Membre chevronné https://www.developpez.com
le 17/03/2017 à 17:34
Bonjour Roland.

Programme utile (surtout demo5) et, dans ton code, j'ai trouvé une ou deux fonctions dont j'ignorais l'existence.
Merci à toi.

Cordialement
Thierry

PS : je vais devoir mettre à jour l'unité ThDialogs qui a été écrite à l'époque où Lazarus n'utilisait pas les fichiers .res ---> plantage actuel avec les ressources images.
Avatar de FOCUS77 FOCUS77 - Membre confirmé https://www.developpez.com
le 17/03/2017 à 22:18
Bonsoir T.W,

Citation Envoyé par ThWilliam  Voir le message
PS : je vais devoir mettre à jour l'unité ThDialogs qui a été écrite à l'époque où Lazarus n'utilisait pas les fichiers .res ---> plantage actuel avec les ressources images.

.

Bonne nouvelle, pour ma part je désire avoir une 'QuestionDlg' ayant cet aspect si c'est possible.

img:
Avatar de alanglet alanglet - Membre averti https://www.developpez.com
le 18/03/2017 à 9:58
Bonjour,

Merci pour ce code. Pour ma part, j'ai surtout été intéressé par la demo_4 qui permet de rechercher des doublons, même lorsque les noms sont différents. J'ai modifié les ancrages de différents champs pour permettre à l'utilisateur d'ajuster les dimensions de la fiche à la liste des noms de fichiers qui s'affichent et donné la possibilité de comparer des répertoires différents.
Probablement sans importance sur le résultat (il doit être exceptionnel d'avoir un fichier de plus de 4 Go), mais il me semble que le calcul de la taille des fichiers est erroné.
La taille est obtenue à partir des parties haute et basse d'un vData:TWin32FindData par la formule:
Code : Sélectionner tout
1
2
3
vData.nFileSizeHigh * MaxDWord + vData.nFileSizeLow //MaxDWord=$FFFFFFFF 
devrait être 
(vData.nFileSizeHigh shl 32)or vData.nFileSizeLow
D'autre part la comparaison de 2 fichiers à partir de leur chargement total dans 2 TMemoryStream m’inquiète un peu. Ne risque-t-on pas de débordement mémoire en comparant 2 gros fichiers? (ce qu'un utilisateur peut ignorer avant de lancer la recherche).
Aussi j'ai préféré modifier la fonction CompareFiles pour que la comparaison se fasse par blocs de 10Mo maxi:
Code : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
function CompareFiles(const aFirstFileName,aSecondFileName:string): boolean; 
const 
  TailleMax=10000000; 
var 
  ms1,ms2:TMemoryStream; 
  F1,F2:TFileStream; 
  L,M,T:Int64; 
begin 
  Result:=False; 
 
  if FileExists(aFirstFileName) and FileExists(aSecondFileName) then 
  begin 
    F1:=TFileStream.Create(aFirstFileName,fmOpenRead); 
    try 
      F2:=TFileStream.Create(aSecondFileName,fmOpenRead); 
      try 
        T:=F1.Size; 
        if T=F2.Size then 
        begin; 
          ms1:=TMemoryStream.Create; 
          ms2:=TMemoryStream.Create; 
          try 
            F1.Position:=0; 
            F2.Position:=0; 
            L:=0; 
            repeat 
              if (T-L)>TailleMax then 
                M:=TailleMax 
              else 
                M:=T-L; 
              Inc(L,M); 
              ms1.CopyFrom(F1,M); 
              ms2.CopyFrom(F2,M); 
              ms1.Position := 0; 
              ms2.Position := 0; 
              Result:=CompareMem(ms1.Memory,ms2.Memory,M); 
            until not Result or (L>=T); 
          finally 
            ms2.Free; 
            ms1.Free; 
          end; 
        end; 
      finally 
        F2.Free; 
      end; 
    finally 
      F1.Free; 
    end; 
  end; 
end;
André
Avatar de Roland Chastain Roland Chastain - Rédacteur/Modérateur https://www.developpez.com
le 18/03/2017 à 13:27
Bonjour !

Merci pour vos retours.

Citation Envoyé par alanglet  Voir le message
Probablement sans importance sur le résultat (il doit être exceptionnel d'avoir un fichier de plus de 4 Go), mais il me semble que le calcul de la taille des fichiers est erroné.

Ah oui, bien vu. J'avais trouvé dans des discussions lues ici et là les deux formules et j'ai cru paresseusement qu'elles étaient équivalentes : je m'aperçois que ce n'est pas le cas.

Citation Envoyé par alanglet  Voir le message
D'autre part la comparaison de 2 fichiers à partir de leur chargement total dans 2 TMemoryStream m’inquiète un peu. Ne risque-t-on pas de débordement mémoire en comparant 2 gros fichiers ?

Effectivement. Le problème a été évoqué dans cette discussion. J'aurais dû utiliser l'une des procédures par blocs.

Citation Envoyé par ThWilliam  Voir le message
PS : je vais devoir mettre à jour l'unité ThDialogs qui a été écrite à l'époque où Lazarus n'utilisait pas les fichiers .res ---> plantage actuel avec les ressources images.

Effectivement, je m'en étais aperçu. Nous attendons avec impatience la nouvelle version.
Avatar de anapurna anapurna - Membre expert https://www.developpez.com
le 18/03/2017 à 16:51
salut,

j'ai regardé un peu le code

le fait de parcourir tout les sous répertoire pour chaque fichier afin de trouver un doublon n'est pas super optimisé

J'aurais parcouru les répertoires pour enregistrer chaque fichier dans une liste d'enregistrement du type
genre

Code : Sélectionner tout
1
2
3
4
5
6
7
8
 
TFichierData = record 
        nom     : string; 
        dossier : string; 
        date    : integer; 
        taille  : integer; 
        use     : boolean; 
    end;


le parcourt se ferait comme ceci

Code : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Function FindOwnAllFiles(AFolder,AExt: String;Recursif : Boolean) : TListFichier; 
 
  procedure RechercherFichiers(Lst : TListFichier ;NomDossier,exten : string ; Recursif : Boolean ); 
  var 
    hFind : TSearchRec; 
  begin 
    NomDossier := slach(NomDossier);  // Attention au '\' ;-) 
    if FindFirst( NomDossier + exten, FaAnyFile, hFind ) = 0 then 
    begin 
      repeat 
        if (hFind.Name <> '.') and (hFind.Name <> '..') then 
        begin 
          { c'est un fichier on l'ajoute a la structure } 
          if ( hFind.Attr and faDirectory ) <> faDirectory then 
            Lst.AddEnreg( hFind.Name, NomDossier, hFind.Size, hFind.Time ) // Ajoute fichier à la liste 
          else { c'est un dossier on va voir dedans } 
            if Recursif Then 
              RechercherFichiers(Lst,(slach(NomDossier) + hFind.Name),exten,Recursif); 
        end; 
      until FindNext(hFind) <> 0; 
      Application.ProcessMessages; 
      FindClose(hFind); 
    end; 
  end; 
 
begin 
  result := TListFichier.Create; 
  RechercherFichiers(result,AFolder,AExt,Recursif); 
end;
J'aurais trié cette liste par taille
et ensuite si les fichiers on la même taille j'aurais fait la comparaison et enregistrer dans une deuxième liste de fichiers dupliqués
Avatar de Roland Chastain Roland Chastain - Rédacteur/Modérateur https://www.developpez.com
le 20/03/2017 à 11:15
@anapurna

Merci pour ta remarque. En effet, j'ai choisi la solution de facilité et non pas la plus efficace. Quand j'aurai le temps, j'essaierai d'appliquer la méthode que tu proposes.
Developpez.com décline toute responsabilité quant à l'utilisation des différents éléments téléchargés.
Responsables bénévoles de la rubrique Lazarus : Alcatîz - Gilles Vasseur -