Hello,

I have very difficult question (For me ;])

I'm making program witch would find duplicates in listview, but it wouldn't match 100%. For instance "ABCDE" and "ABCDF" would return 80%. It would be very useful for making program witch searches for duplicates mp3 songs (Almost same filenames, but not 100% match)

I have done it, but my code is very slow. To search for duplicates in listview with 2500 items would take about 40 hours. How to optimize this code? (Earlier I used function .FindItem, it is very fast, but this search would found items, witch matches 100%)




Listfiles1 = Listview (with filenames)
Duplicates = Listview (duplicates items)

My Code:
Code:
Private Sub FNDDPLBYNAME()
Dim x0, x1
Dim File0 As String, File1 As String
Dim ListViewItemX As ListItem



For x0 = 1 To ListFiles.ListItems.Count
File0 = Trim$(ListFiles.ListItems.Item(x0).Text)
File0 = Left$(File0, Len(File0) - 4)

For x1 = x0 + 1 To ListFiles.ListItems.Count
File1 = Trim$(ListFiles.ListItems.Item(x1).Text)
File1 = Left$(File1, Len(File1) - 4)

DoEvents
Debug.Print x0
If CompareTXT(File0, File1) >= 80 Then ' 80%, or other number to match songs filenames

Duplicates.ListItems.Add , , ListFiles.ListItems.Item(x0).Text
Duplicates.ListItems.Add , , ListFiles.ListItems.Item(x1).Text

End If
Next x1
Next x0

End Sub


Public Function CompareTXT(String1 As String, String2 As String) As Single
    Dim i, y, x As Integer
    Dim a, b As String
    String1 = UCase$(String1) 'take this out If you
    String2 = UCase$(String2) 'want it To be case
    'sensitive
    If String1 = String2 Then CompareTXT = 1: Exit Function
    'if the strings are
    'the same, don't
    'bother to waste time
    'and space on working
    'them out :).
    If Len(String1) > Len(String2) Then x = Len(String1)
    If Len(String2) > Len(String1) Then x = Len(String2)
    If Len(String1) = Len(String2) Then x = Len(String1)
    'find out the length
    'of the longest string


    For i = 1 To x
    DoEvents
        a = Mid$(String1, i, 1) 'get 1 character from
        b = Mid$(String2, i, 1) 'each string and compare
        If a = b Then y = y + 1 'the characters
    Next
    CompareTXT = y / x * 100
End Function

Regards,
Norkis