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! )
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.