PDF XChange Forum

Code: Select all

Imports System.Runtime.InteropServices
Public Class frmDuplicateImageFinder

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim bmpFiles As New List(Of String)
        For Each foundFile As String In My.Computer.FileSystem.GetFiles(txtRootPath.Text, FileIO.SearchOption.SearchTopLevelOnly, "*bmp")
            bmpFiles.Add(foundFile)
        Next
        GetDulicateImage(bmpFiles.ToArray)
    End Sub
    Function GetDulicateImage(InFiles As String())
        Dim ResultUnique As New List(Of String)
        Dim ResultDuplicate As New List(Of String)
        Dim PixelsFile As New Dictionary(Of String, String)
        For Each CurrentFile In InFiles
            Dim EveryFilePixel As String = GetPixelsFile(CurrentFile)
            If Not PixelsFile.Keys.Contains(EveryFilePixel) Then
                PixelsFile.Add(EveryFilePixel, "Uniqe(" & My.Computer.FileSystem.GetName(CurrentFile) & ")")
                ResultUnique.Add(CurrentFile)
            Else
                PixelsFile(EveryFilePixel) += "_" & My.Computer.FileSystem.GetName(CurrentFile)
                ResultDuplicate.Add(CurrentFile)
            End If
        Next
        My.Computer.FileSystem.CreateDirectory(txtDuplicate.Text)
        My.Computer.FileSystem.CreateDirectory(txtUnique.Text)
        For Each file In ResultDuplicate.ToArray
            My.Computer.FileSystem.MoveFile(file, txtDuplicate.Text & "\" & My.Computer.FileSystem.GetName(file))
        Next
        For Each file In ResultUnique.ToArray
            My.Computer.FileSystem.MoveFile(file, txtUnique.Text & "\" & My.Computer.FileSystem.GetName(file))
        Next
        txtResultDup.Text = Join(PixelsFile.Values.ToArray, vbNewLine)
        MsgBox("Duplicate File " & ResultDuplicate.Count)
    End Function
    Function GetPixelsFile(Path As String) As String
        Dim RecCheck As New List(Of Rectangle)
        Dim Pixels As New List(Of String)
        Dim RecPixel As String = ""
        Dim bm As Bitmap = New Bitmap(Path)
        'Here, a user's choice needs to be set, such as the number of vertical or horizontal lines
        Dim Len As Integer = 10 'Set By User
        Dim per As Integer = 6 'Set By User
        For Vertical = bm.Width / per To bm.Width Step (bm.Width / per) - 1
            RecCheck.Add(New Rectangle With {.X = Vertical, .Y = bm.Height / 2 - Len / 2, .Width = 1, .Height = Len})
        Next
        For Horizontal = bm.Height / per To bm.Height Step (bm.Height / per) - 1
            RecCheck.Add(New Rectangle With {.X = bm.Width / 2 - Len / 2, .Y = Horizontal, .Width = Len, .Height = 1})
        Next

        For Each Check As Rectangle In RecCheck
            Dim rec As New Rectangle(Check.X, Check.Y, Check.Width, Check.Height)
            Dim bmpData As System.Drawing.Imaging.BitmapData = bm.LockBits(rec, Drawing.Imaging.ImageLockMode.ReadOnly, Imaging.PixelFormat.Format32bppArgb)
            Pixels.Add(GetStringOfPixel(bmpData))
            bm.UnlockBits(bmpData)
        Next
        bm.Dispose()
        RecPixel = Join(Pixels.ToArray, "")
        Return RecPixel
    End Function
End Class