Tri de collection d'images : compare et liste

Soyez le premier à donner votre avis sur cette source.

Vue 10 234 fois - Téléchargée 771 fois

Description

Pour se débarasser des doublons d'images dans les "bibliothèques d'images" (ou photos) perso, de son dd.

Ce programme fonctionne en deux temps :
1/ il recherche tout les fichiers images contenu dans le dossier et sous-dossiers, puis il en extrait les informations de dimensions XY, format et taille du fichier.
A partir de cette liste, il compare les dimensions des images pour trouver les résolutions identique, puis validé si le format et/ou la taille sont identique
2/ il ouvre les image et réalise une comparaison pixel par pixel des images qui "semble identique" avec le test 1

Une fenêtre de bilan (rapport) ainsi que de prévisu (visio) est disponible pour lire les résultats de l'analyse.

grâçe au système de recherche en 2 passes, dont l'une pour le de dégrossissement étant très rapide (100% en ram), on atteint des performance de 10 minutes de travail pour trouvé 900 images identique dans une collection de 17000 images (et grâçe au rapport, on a vu que un dossier complet étais dupliqué) sur un système 1GHz, là où des freeware mettent 5 jours!

interêt de la source :
- recherche dans les dossiers et sous-dossier avec la fonction Dir()
- récupération des headers des fichiers BMP, JPG, GIF et PNG (plus a venir)
- ouverture bitmap et comparaison bit-à-bit beaucoup plus rapide que GetPixel ou .Point grâçe à GetBitmapBits (alter-ego de GetDIBits)
- et en plus les résultats sont exhaustif à 99,5% :)

remarques :
- Si l'image est corrompu ou partiellement endommagé, le programme l'ignorera.
- Certain fichiers portant l'extension .jpg ne sont pas au format JFIF mais Exif (cas des photos numérique) et le programme à quelques difficultés à trouvé les dimensions XY de ces dernières (considéré alors comme = 0, donc ignoré par les tests)

Pensez à compilé le programme, il est 30% plus rapide en version .exe !

Source / Exemple :


'beaucoup trop long, voir Zip

'extrait de CompKern.bas : la récupération de la résolution XY :
Private Sub GET_PicXYRes(InFormat As Long, OutXres As Long, OutYres As Long)
Dim bMarker As Byte
Dim iLength As Byte
Dim lSeek As Long
Dim iXres As Integer
Dim iYres As Integer
Dim Checking As Integer
Dim HWtbl(1 To 4) As Byte
Dim JpegDebug As Long

Select Case InFormat
Case 1 ' BMP
    Get #1, 19, OutXres
    Get #1, 23, OutYres
Case 2 ' JPG
    'le format JPEG standard est rarement respecté, aussi il faut procéder a différent "saut"
    'avant de trouver le marqueur SOF0, auquel est rattaché la résolution
    
    Get #1, 3, Checking
    If Checking <> &HE0FF Then
        'non-JFIF (exif ?)
        i = 5
        ts = LOF(1) - 1
        Do Until Checking = &HE0FF Or Checking = &HD8FF Or Checking = &HC0FF
            Get #1, i, Checking
            i = i + 1
            If i >= ts Then
                'format jpeg incompatible ou inconnu
                OutXres = 0
                OutYres = 0
                Exit Sub
            End If
        Loop
        lSeek = i
    Else
        'JFIF
        lSeek = 21
    End If
    
    
JpegMarkSeek:
    Get #1, lSeek, bMarker
    If bMarker = 255 Then
        Get #1, lSeek + 1, bMarker
        If bMarker >= 192 And bMarker <= 195 Then  'marqueur SOF0 , SOF1 ou SOF2 de base
            Get #1, lSeek + 5, HWtbl
            OutYres = HWtbl(1) * 256 + HWtbl(2)
            OutXres = HWtbl(3) * 256 + HWtbl(4)
            'OutXres = CLng(iXres)
            'OutYres = CLng(iYres)
            
            
            Get #1, LOF(1) - 1, Checking
            If Checking <> &HD9FF And Checking <> 0 Then
                'image buggé (fin incorrect)
                OutXres = 0
                OutYres = 0
            End If
        
        Else
            lSeek = lSeek + 1
            GoTo JpegMarkSeek
        End If
        
    Else
        lSeek = lSeek + 1
        GoTo JpegMarkSeek

        'non-JFIF
        OutXres = 0
        OutYres = 0
    End If
Case 3 ' GIF
    Get #1, 7, iXres
    Get #1, 9, iYres
    OutXres = CLng(iXres)
    OutYres = CLng(iYres)
Case Else
    OutXres = 0
    OutYres = 0
End Select
End Sub

Conclusion :


mode d'emploi :

1/ choisissez le dossier de base de votre collection d'image a trier

2/ cliquer sur "build" pour lister les images existantes

3/ cliquer sur "begin" pour entamer le comparatif rapide puis bit-à-bit.

4/ cliquer, le cas échéant (résultat > 0) sur "visio" et "rapport" pour connaitre les images en double trouvé.

bug connus :
- quelques format jpeg corrompu/malformé non géré.

update mai 2003 :
- module Dir.bas optimisé (vitesse +5% )
- module CompKern.bas optimisé (vitesse pass1 x10! )

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
111
Date d'inscription
dimanche 6 janvier 2002
Statut
Membre
Dernière intervention
27 août 2004

ah bah non y a plus de problème... en ayant compilé le prog sa marche..
Messages postés
248
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
19 décembre 2008

Convertir tout les integer en long ! malheureux! le type integer sert uniquement pour la récupération des données dans les fichiers qui sont sur deux octets (long étant sur 4) il est fort probable que ça ai influé sur la construction de la liste! - à vérifier (d'où un surplus de doublon théorique...?)
La fonction "kill!" : en fait tu choisi toute les images a supprimer, et une fois la selection faite, tu cliques sur "valider" et le prog supprimera d'un coup toute la liste de choix. Je n'aime pas trop cette methode de suppression, manque de sécurité. Vé faire ta suggestion, c pas bête :)
Merci.
Skywalker13, essaye de savoir quel image est à l'origine de cette erreur, pour débogué il faut que je puisse faire le test chez moi.
Messages postés
439
Date d'inscription
dimanche 20 janvier 2002
Statut
Membre
Dernière intervention
2 février 2010
1
Très bon travail !!
Je n'ai pas modifié le code si ce n'est la nature des variables de types Integer que j'ai changer en Long (en faisant "Remplacer...", portée : Projet).

J'ai traité 5500 images, j'ai eu 2088 doublons sur la première étape et 117 sur la deuxième.

Une petite suggestion. Dans la fenêtre rapport ce serait bien que l'action du clique sur le bouton Kill fasse aussi passer à la photo suivante. Ou alors qu'il y ait une possibilité de tout effacer en bloque.

Ma note --> 10/10

@+, VIC
Messages postés
111
Date d'inscription
dimanche 6 janvier 2002
Statut
Membre
Dernière intervention
27 août 2004

Bien que j'ai fais appliqué ton correctif.. j'ai toujours un dépassement de capacité a : OutXres = HWtbl(3) * 256 + HWtbl(4)
Messages postés
248
Date d'inscription
vendredi 10 novembre 2000
Statut
Membre
Dernière intervention
19 décembre 2008

Image jif au format bizarre.
correctif :
remplacer iXres par OutXres et pour la ligne du dessus, iYres par OutYres .
have fun!
Afficher les 6 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.