MediaMonkey forum

Posted: **Tue Dec 04, 2007 11:07 am**

This script allows you to select one of your synchronised devices (auto-selects if there's only one) and then checks all your synchronised tracks to see if any artist+title combination appears more than once. It then displays a report showing all the albums, grouped by artist, with the duplicate tracks highlighted in red. This should help you to remove albums from the list which you do not need.

As always, installers are available from my website.

Code: Select all

'
' MediaMonkey Script
'
' NAME: FindSyncDups 1.3
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 27/05/2008
'
' INSTALL: Copy to Scripts directory and add the following to Scripts.ini 
'          Don't forget to remove comments (') and set the order appropriately
'
' [FindSyncDups]
' FileName=FindSyncDups.vbs
' ProcName=FindSyncDups
' Order=41
' DisplayName=Find Sync Dups
' Description=Find duplicate tracks in sync list
' Language=VBScript
' ScriptType=1
'
' FIXES: Fixed ordering of non-numeric disc and track numbers
'        Added disc number to report display
'        Fixed albums with multiple track versions should not be reported
'        Added duplicates now colour coded
'

Option Explicit
Dim AppTitle : AppTitle = "Find Sync Dups 1.3"

Sub FindSyncDups()
  'select device
  Dim arr,str,lst,i,j,k,sts
  Dim devc : devc = 0
  Dim devi : devi = ""
  Dim devn : devn = ""
  Dim devd : Set devd = CreateObject("Scripting.Dictionary")
  Dim dit : Set dit = SDB.Database.OpenSQL("SELECT DeviceCaption,ID FROM Devices WHERE DeviceID <> ''")
  While Not dit.EOF
    devc = devc+1
    devn = dit.StringByIndex(0)
    devi = dit.StringByIndex(1)
    devd.Item(devi) = devn
    dit.Next
  WEnd
  If devc < 1 Then
    Call SDB.MessageBox("FindSyncDups: You have no synchronised devices.",mtError,Array(mbOk))
    Exit Sub
  End If
  If devc > 1 Then
    devn = SkinnedListBox("Please select device:","FindSyncDups",devd.Items)  
    If devn = "" Then
      Exit Sub      
    End If
    arr = devd.Keys
    For i = 0 To UBound(arr)
      If devd.Item(arr(i)) = devn Then
        devi = arr(i)
        Exit For
      End If
    Next
  End If
  
  'create progress bar
  Dim prog : Set prog = SDB.Progress  
  prog.Value = 0
  prog.MaxValue = 1
  prog.Text = "FindSyncDups: Initialising..."
  SDB.ProcessMessages
  
  'list tracks
  Dim trac : trac = 0
  Dim trad : Set trad = CreateObject("Scripting.Dictionary")
  Set dit = SDB.Database.OpenSQL("SELECT IDTrack,ID FROM DeviceTracks WHERE IDDevice = "&devi)
  While Not dit.EOF
    trac = trac+1
    trad.Item(dit.StringByIndex(0)) = dit.StringByIndex(1)
    dit.Next
  WEnd
  If trac < 1 Then
    Call SDB.MessageBox("FindSyncDups: You have no synchronised tracks.",mtError,Array(mbOk))
    Exit Sub
  End If
  
  'process tracks
  prog.MaxValue = trac
  Dim dupc : dupc = 0
  arr = trad.Keys
  Set trad = CreateObject("Scripting.Dictionary")
  Set devd = CreateObject("Scripting.Dictionary")
  Dim sit : Set sit = Nothing
  For i = 0 To UBound(arr)
    prog.Value = i
    prog.Text = "FindSyncDups: Checking track "&(i+1)&" of "&(trac)&" (found: "&dupc&")..."
    SDB.ProcessMessages
    Set sit = SDB.Database.QuerySongs("AND Songs.ID = "&arr(i))
    If Not (sit.EOF) Then
      sts = UCase(sit.Item.ArtistName)
      str = sts&" *** "&UCase(sit.Item.Title)
      If devd.Exists(sts) Then               
        devd.Item(sts) = devd.Item(sts)&","&sit.Item.Album.ID
      Else      
        devd.Item(sts) = sit.Item.Album.ID
      End If      
      If trad.Exists(str) Then
        dupc = dupc+1       
        Set lst = trad.Item(str)        
      Else      
        Set lst = SDB.NewSonglist
      End If      
      Call lst.Add(sit.Item)
      Set trad.Item(str) = lst
    End If
    If prog.Terminate Then
      Exit Sub
    End If
  Next
  If dupc < 1 Then
    Call SDB.MessageBox("FindSyncDups: You have no duplicate synchronised tracks.",mtError,Array(mbOk))
    Exit Sub
  End If
  
  'remove non-duplicates
  prog.Text = "FindSyncDups: Calculating duplicates..."
  SDB.ProcessMessages
  Dim albd : Set albd = CreateObject("Scripting.Dictionary")
  arr = trad.Keys
  dupc = 0
  For i = 0 To UBound(arr)
    Set lst = trad.Item(arr(i))
    If lst.Count > 1 Then
      Set albd = CreateObject("Scripting.Dictionary")
      For j = 0 To lst.Count-1
        albd.Item(lst.Item(j).AlbumName) = ""
      Next
      If albd.Count > 1 Then
        dupc = dupc+1
        prog.MaxValue = prog.MaxValue+1
      Else
        Call trad.Remove(arr(i))
      End If
    Else
      Call trad.Remove(arr(i))
    End If
    If prog.Terminate Then
      Exit Sub
    End If    
  Next
  
  'create report
  prog.Text = "FindSyncDups: Initialising report..."
  SDB.ProcessMessages
  Dim wsh : Set wsh = CreateObject("WScript.Shell")  
  Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\FincSyncDups.htm"
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim out : Set out = fso.CreateTextFile(loc,True,True) 
  Call out.WriteLine("<html><head><title>"&AppTitle&"</title><style type=text/css>")
  Call out.WriteLine("body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}")
  Call out.WriteLine("H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-align:left}")
  Call out.WriteLine("TH{font-family:'Verdana',sans-serif; font-size:10pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}")
  Call out.WriteLine("TD{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px; vertical-align:top}")
  Call out.WriteLine("</style></head><body>")  
  
  'process duplicates
  Dim col : col = ""     
  Dim maxv : maxv = prog.MaxValue-1
  Dim lstd : Set lstd = CreateObject("Scripting.Dictionary")
  Dim artd : Set artd = CreateObject("Scripting.Dictionary")
  Set albd = CreateObject("Scripting.Dictionary")
  arr = trad.Keys
  For i = 0 To UBound(arr)
    prog.Value = trac+i
    prog.Text = "FindSyncDups: Processing duplicate "&(i-maxv)&" of "&(dupc)&"..."
    SDB.ProcessMessages
    Set lst = trad.Item(arr(i))
    Dim tmp : tmp = Split(arr(i)," *** ")
    Dim art : art = tmp(0)    
    Dim ttl : ttl = tmp(1)
    If Not (artd.Exists(art)) Then
      str = devd.Item(art)
      artd.Item(art) = str
      tmp = StrToArray(str)
      Dim alb : Set alb = Nothing
      Call out.WriteLine("<h1>"&art&"</h1><table><tr>")
      For j = 0 To UBound(tmp)
        If albd.Exists(tmp(j)) Then
          Set alb = albd.Item(tmp(j))
        Else
          str = "AND Songs.IDAlbum = "&tmp(j)
          If SDB.VersionHi > 2 Then
            str = str&" ORDER BY DiscNumber COLLATE NUMERICSTRING, TrackNumber COLLATE NUMERICSTRING"
          Else
            str = str&" ORDER BY Songs.SongOrder"
          End If
          Set sit = SDB.Database.QuerySongs(str)
          Set alb = sit.Item.Album
          Set lst = SDB.NewSongList
          While Not sit.EOF
            Call lst.Add(sit.Item)
            sit.Next
          WEnd
          Set albd.Item(tmp(j)) = alb
          Set lstd.Item(tmp(j)) = lst
        End If
        If Not(alb Is Nothing) And (alb.ID > 0) Then
          Call out.WriteLine("<th>"&alb.Name&"</th>")
        Else
          Call out.WriteLine("<th>&nbsp;</th>")
        End If
      Next
      Call out.WriteLine("</tr><tr>")
      Dim cold : Set cold = CreateObject("Scripting.Dictionary") '!!!
      For j = 0 To UBound(tmp)
        str = "<td>"
        Set alb = albd.Item(tmp(j))
        Set lst = lstd.Item(tmp(j))
        For k = 0 To lst.Count-1
          Dim itm : Set itm = lst.Item(k)
          Dim dupb : dupb = False
          Dim key : key = UCase(itm.ArtistName&" *** "&itm.Title)
          If trad.Exists(key) Then
            If cold.Exists(key) Then
              str = str&"<font color="""&cold.Item(key)&""">"
            Else
              col = GetNextColour(col)
              cold.Item(key) = col
              str = str&"<font color="""&col&""">"
            End If
            dupb = True
          End If
          If SDB.VersionHi > 2 Then
            If itm.TrackOrderStr = "" Then
              str = str&itm.Title
            Else
              If itm.DiscNumberStr = "" Then
                str = str&itm.TrackOrderStr&". "&itm.Title  
              Else
                str = str&itm.DiscNumberStr&"-"&itm.TrackOrderStr&". "&itm.Title  
              End If
            End If
          Else
            If itm.TrackOrder > 0 Then
              str = str&itm.TrackOrder&". "&itm.Title
            Else
              str = str&itm.Title
            End If
          End If
          If Not (itm.ArtistName = alb.Artist.Name) Then
            str = str&" ("&itm.ArtistName&")"
          End If
          If dupb Then
            str = str&"</font>"
          End If
          If k < lst.Count-1 Then
            str = str&"<br>"
          End if
        Next
        Call out.WriteLine(str&"</td>")
      Next
      Call out.WriteLine("</tr></table>")
    End If
    If prog.Terminate Then
      Exit For
    End If    
  Next
  
  'show report
  Call out.WriteLine("</body></html>")
  Call out.Close()
  If Not (prog.Terminate) Then
    prog.Value = prog.MaxValue
    prog.Text = "FindSyncDups: Report complete."
    If SDB.MessageBox("FindSyncDups: Report complete, display now?",mtConfirmation,Array(mbYes,mbNo)) = mrYes Then
      Call wsh.Run(Chr(34)&loc&Chr(34),1,0)
    End If
  End If  
End Sub

Function GetNextColour(col)
  Select Case col
    Case "red"
      GetNextColour = "blue"
    Case "blue"
      GetNextColour = "green"      
    Case "green"
      GetNextColour = "gold"  
    Case "gold"
      GetNextColour = "skyblue"
    Case "skyblue"
      GetNextColour = "purple"
    Case "purple"
      GetNextColour = "yellowgreen"
    Case "yellowgreen"
      GetNextColour = "violet"
    Case "violet"
      GetNextColour = "teal"
    Case "teal"
      GetNextColour = "sienna"
    Case "sienna"
      GetNextColour = "darkkhaki"
    Case "darkkhaki"
      GetNextColour = "lightsalmon"
    Case Else
      GetNextColour = "red"
  End Select
End Function

Function SkinnedListBox(Text, Caption, Options)
  Dim Form, Label, Edt, btnOk, btnCancel, modalResult, i

  ' Create the window to be shown 
  Set Form = SDB.UI.NewForm 
  Form.Common.SetRect 100, 100, 360, 130 
  Form.BorderStyle  = 2   ' Resizable 
  Form.FormPosition = 4   ' Screen Center 
  Form.Caption = Caption 
     
  ' Create a button that closes the window 
  Set Label = SDB.UI.NewLabel(Form) 
  Label.Caption = Text 
  Label.Common.Left = 5 
  Label.Common.Top = 10 
    
  Set Edt = SDB.UI.NewDropDown(Form) 
  Edt.Common.Left = Label.Common.Left 
  Edt.Common.Top = Label.Common.Top + Label.Common.Height + 5 
  Edt.Common.Width = Form.Common.Width - 20 
  Edt.Common.ControlName = "Edit1" 
  Edt.Common.Anchors = 1+2+4 'Left+Top+Right 
  Edt.Style = 2
  Edt.AddItem("Please select...")
  For i = 0 To UBound(Options)
    Edt.AddItem(Options(i))
  Next
  Edt.ItemIndex = 0
       
  ' Create a button that closes the window 
  Set BtnOk = SDB.UI.NewButton(Form) 
  BtnOk.Caption = "&OK" 
  BtnOk.Common.Top = Edt.Common.Top + Edt.Common.Height + 10 
  BtnOk.Common.Hint = "OK" 
  BtnOk.Common.Anchors = 4   ' Right 
  BtnOk.UseScript = Script.ScriptPath 
  BtnOk.Default = True
  BtnOk.ModalResult = 1 
    
  Set BtnCancel = SDB.UI.NewButton(Form) 
  BtnCancel.Caption = "&Cancel" 
  BtnCancel.Common.Left = Form.Common.Width - BtnCancel.Common.Width - 15 
  BtnOK.Common.Left = BtnCancel.Common.Left - BtnOK.Common.Width - 10 
  BtnCancel.Common.Top = BtnOK.Common.Top 
  BtnCancel.Common.Hint = "Cancel" 
  BtnCancel.Common.Anchors = 4   ' Right 
  BtnCancel.UseScript = Script.ScriptPath 
  BtnCancel.Cancel = True
  BtnCancel.ModalResult = 2 
      
  If (Form.showModal = 1) And (Edt.ItemIndex > 0) Then
    SkinnedListBox = Options(Edt.ItemIndex-1)
  Else
    SkinnedListBox = ""
  End If  
End Function

Function StrToArray(str)
  Dim i : i = 0 
  Dim dic : Set dic = CreateObject("Scripting.Dictionary")
  Dim arr : arr = Split(str,",")
  For i = 0 To UBound(arr)
    dic.Item(arr(i)) = i
  Next
  StrToArray = dic.Keys
End Function

Function MapXML(srcstring)
  MapXML = srcstring
  MapXML = Replace(MapXML,"&","&")
  MapXML = Replace(MapXML,"<","<")
  MapXML = Replace(MapXML,">",">")
  MapXML = Replace(MapXML,"""",""")
  Dim i : i = 1
  While i<=Len(MapXML)
    If (AscW(Mid(MapXML,i,1))>127) Then
      MapXML = Mid(MapXML,1,i-1)+"&#"+CStr(AscW(Mid(MapXML,i,1)))+";"+Mid(MapXML,i+1,Len(MapXML))
    End If
    i = i + 1
  WEnd
End Function

Sub Install()
  Dim inip : inip = SDB.ApplicationPath&"Scripts\Scripts.ini"
  Dim inif : Set inif = SDB.Tools.IniFileByPath(inip)
  If Not (inif Is Nothing) Then
    inif.StringValue("FindSyncDups","Filename") = "FindSyncDups.vbs"
    inif.StringValue("FindSyncDups","Procname") = "FindSyncDups"
    inif.StringValue("FindSyncDups","Order") = "41"
    inif.StringValue("FindSyncDups","DisplayName") = "Find Sync Dups"
    inif.StringValue("FindSyncDups","Description") = "Find duplicate tracks in sync list"
    inif.StringValue("FindSyncDups","Language") = "VBScript"
    inif.StringValue("FindSyncDups","ScriptType") = "1"
    SDB.RefreshScriptItems
  End If
End Sub

Posted: **Tue Dec 04, 2007 1:12 pm**

Trixmoto:

I tried the script and received this error:

using my work computer. I will try it at home later to see if I run into the same problems. Any ideas??

Nyn

EDIT: I tried the script in MM3 and although I did not receive the error above, the script also did not find any duplicates, which it shouldn't have originally. Then I synced two songs into two different folders and the script still did not find any dupes.

Posted: **Wed Dec 05, 2007 4:08 am**

Sorry, I thought I'd tested the SQL in both MM2 and MM3, but I must have changed something - I'll retest it in MM2 when I get a chance (probably tomorrow). As for not finding duplicates, are the artist and title exactly the same - I believe at the moment this script is case sensitive as well.

Posted: **Wed Dec 05, 2007 6:24 am**

Yes they are exactly the same. I purposely added duplicates so that I can see what the report would extract.

Nyn

Posted: **Wed Dec 05, 2007 8:18 am**

Could you please email me the report file that is created (in your %temp% directory) along with details of which tracks are duplicates?

Posted: **Wed Dec 19, 2007 3:43 pm**

New version (1.1) is now available to download from my website. Changes include...

- Fixed artist name and track title were case sensitive
- Fixed sql datatype mismatch error in MM2

Let me know what you think!

Posted: **Mon Jan 28, 2008 8:50 pm**

I am getting error message:

Code: Select all

There was a problem querying the database:
Error executing SQL "SELECT" Songs.*
FROM Songs
WHERE Songs.IDAlbum = 1895 ORDER BY Songs.SongOrder
": no such column: Songs.SongOrder (1, 1)

Followed by:

Code: Select all

Error #-2147418113 -
File: "C\Program Files\MediaMonkey3\MediaMonkey\Scripts\FindSynchDups.vbs", Line: 176, Column: 10

Device is 20G 4th Generation IPod.
Using version 1.1 of the script.

Any ideas

Posted: **Tue Jan 29, 2008 2:56 am**

Well this should be "Songs.TrackNumber" not "Songs.SongOrder" in MM3 as this field has changed, but I wrote this script in MM3 so I don't understand. Unless previously this field was still there (during the betas) but it was removed in the official release.

Anyway, for now you can replace "SongOrder" with "TrackNumber" in a text editor, but I'll try to get this fixed and released soon.

Posted: **Tue Jan 29, 2008 3:26 am**

trixmoto wrote: Anyway, for now you can replace "SongOrder" with "TrackNumber" in a text editor, but I'll try to get this fixed and released soon.

Yep, thanks, that fixed it.

Thanks for all your hard work and timely responses.

Posted: **Thu Mar 06, 2008 2:30 pm**

How Do I use this? s|

Posted: **Fri Mar 07, 2008 2:02 am**

Bug report:

I select the IPOD then:

Error executing SQL "SELECT songs*" FROM songs
WHERE songs IDAlbum = 844 ORDER By songs. songOrder
" : No such colum: SOng SONGORDER (1, 1)

THen I press retry it does nothing, and then Ignore.

then:

Error# 214748113
File not found in result (C:/...)
File " MM dir/ Scripts/ Findsynchdups.vbs" Line 176 , Colum 10.

THen:

Error: SQLLITLEDB.Pas line 1242

Press OK

THe End.

Thank you.

Posted: **Fri Mar 07, 2008 2:12 am**

I did this:

"Songs.TrackNumber" - replace - "Songs.SongOrder".

WORKS A OK

Thank you so much!

Posted: **Fri Mar 07, 2008 4:21 am**

Thanks - I'd spotted this but not had a chance to release an update yet. I'll try to get that done soon!

Posted: **Sun Mar 09, 2008 5:35 am**

New version (1.2) is now available to download from my website. I have fixed the track order in MM3 so there shouldn't be any more errors, and multi-disk albums should be in the right order too!

Posted: **Mon Mar 10, 2008 11:24 am**

How this suppose to be working? I am not seeing any dialogs or menus when I am syncing. No menus under my portable device either.

MM 3.0.3 1137
Creative Zen Video:M

MediaMonkey forum

Find Sync Dups 1.3 [MM2+3]

Find Sync Dups 1.3 [MM2+3]