With Android devices - if you don't want to use "MediaMonkey for Android" - Auto-Sync is unable to sync back ratings (tags only, not the entire file!) and play count, neither in MTP (Media Player) nor in MSC (Mass Storage) mode. Basically the same problem exists for all portable devices in MSC mode.
And here comes the solution: this script enables you to sync your rating tags from any portable USB device back to MediaMonkey and to sync play statistics from/to Android Music PlayerPro!
How does it work?
The script looks up all tracks from the last Auto-Sync of a device in MediaMonkey. Therefore the songs are matched precisely by their ID in MediaMonkey and the file name on the device. So it doesn't matter if you changed e.g. the artist name of a song after your last Auto-Sync anywhere, or even the file name on the PC. And it works for format converted songs as well, e.g. ape on PC and mp3 on portable device.
Ratings are synced back from the device node (be aware that in MM 4 only the Folder node shows current tags, the Music node is not refreshed).
Unchanged or empty (no star) ratings are ignored.
Play count, skip count (needs MM 4) and last played date are synced from an XML file on the device. If a value is higher than in MM it is copied to MM, otherwise it is copied from MM. At the moment, this feature is supported only for Android with PlayerPro as music player app.
New files from the device are ignored (e.g. tracks downloaded to a phone).
If you have several synced MSC devices, you can choose which one to sync. The device has to be attached of course...
Instructions
Download and execute the installation package SyncBackRatings.mmip
After this, you can start "Sync Back Ratings" by the corresponding menu item in Tools or in the pop up of the main tree (press right mouse key).
Requires USB mass storage device (d_USBMass*.dll)! If your device was automatically attached using d_WMDM.dll, you have to disable it and configure d_USBMass1.dll manually.
The script is for MediaMonkey version 3 and 4. I will be glad to give you support, however my spare time is somewhat limited. So use it at your own risk.
Android devices
The android USB connection has to be set to "Mass storage" (not "Media player").
Your music player app has to be capable of writing the rating tag to the file.
In case you use PlayerPro:
- Select Settings, Music library, Rating system, Media Monkey
- Select Settings, Music library, Import music stats, Music files (ratings only)
How to sync play statistics:
- In MM, go to Tools, Options, Portable/Audio Devices, SyncBackRatings and enable "Sync back play count from PlayerPro on Android (Songbird format)"
- Create the XML file from PlayerPro. To do this, start the app, go to Settings, Library, Settings, Music library, Export music stats, Songbird.
- Attach the device (you may have to activate the USB drive and restart MM)
- Start "Sync Back Ratings"
- Detach the device (eject and deactivate)
- In PlayerPro, Import music stats, External library.
After an auto-sync do steps 2-6 before playing any music in order to import stats from MM first.
To update or uninstall, go to menu Tools->Extensions.
Uninstall will remove any older manually installed version (before v0.7) as well. If you update from a version before v0.7, it is strongly recommended to uninstall the old version, either manually (delete from \scripts and scripts.ini) or by installing, then uninstalling and reinstalling the current version.
Remarks
This script is not a perfect solution yet. Why?
- A few new Android phones like Samsung Galaxy S3 don't support MSC natively. Alternatives are rooting and Easy UMS or using the external SD card directly on the PC. Or you can use the other script Sync stats for Android PlayerPro XML (MTP).
- This has to be executed manually. Does anybody know how the script could execute an Auto-Sync afterwards? I guess it's not possible to let the script be started automatically with an Auto-Sync, but before MM syncs actually?
- To get the ratings the script navigates to the node of the device and reads its song list, which can take some time.
Update songs screen
Source Code (SyncBackRatings.vbs)
Code: Select all
'----------------------------------------------------------------------------------------------------------------
' Sync back ratings and play count from device to MM according to last executed sync
'
' 12. Mar. 2013
' First created 14. Aug. 2011
' by Aff
'
' Some portions inspired from trixmoto and apoujade
' Thanks abatistas1709 for contributing conversion from UTC/GMT to local time
'
' For details please visit the MediaMonkey forum:
' http://www.mediamonkey.com/forum/viewtopic.php?f=2&t=59888
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program. If not, see <http://www.gnu.org/licenses/>.
'
' If you plan to modify this script and publish it, please
' - make a clear reference to the above-mentioned forum thread and authorship
' - use the most recent source if possible
' - inform me (PM) if there are any bugs in my code or if you have made any improvements to it.
'----------------------------------------------------------------------------------------------------------------
Option Explicit
Const AppTitle = "Sync Back Ratings"
Const AppID = "SyncBackRatings"
Const AppVersion = "1.9.2"
Dim bOnTrackListFilled
Dim bTimeOut
Dim aMulticolList 'for TreeView ListView event
Sub OnStartup()
' Add a submenu to the Tools menu...
Dim Mnu
Set Mnu = SDB.UI.AddMenuItem(SDB.UI.Menu_Tools, 2, -2) ' The second item from the bottom in the second section of tools menu
Mnu.Caption = AppTitle
Mnu.UseScript = Script.ScriptPath
Mnu.OnClickFunc = AppID
Mnu.IconIndex = 66
'...and keep a reference for uninstall
Set SDB.Objects(AppID & "_MnuTools") = Mnu
' Add a submenu to pop-up menu of the main tree. ...
SDB.UI.AddMenuItemSep SDB.UI.Menu_Pop_Tree, -1, -1
Set Mnu = SDB.UI.AddMenuItem(SDB.UI.Menu_Pop_Tree, -1, -1)
Mnu.Caption = AppTitle
Mnu.UseScript = Script.ScriptPath
Mnu.OnClickFunc = AppID
Mnu.IconIndex = 66
'...and keep a reference for uninstall
Set SDB.Objects(AppID & "_MnuPopTree") = Mnu
' Create default options if missing
If SDB.IniFile.IntValue(AppID, "TimeOut") = 0 Then _
SDB.IniFile.IntValue(AppID, "TimeOut") = 120
' Create sheet that is a child of Portable/Audio devices sheet and store ID for uninstall
SDB.IniFile.IntValue(AppID, "OptionSheet") = _
SDB.UI.AddOptionSheet(AppTitle, Script.ScriptPath, "InitSheet", "SaveSheet", -4)
End Sub
Sub SyncBackRatings(v)
Dim aHeader 'for ReportMulticolList
'create progress bar
Dim prog: Set prog = SDB.Progress
prog.Value = 0
prog.MaxValue = 1
prog.Text = AppTitle & ": Initialising - getting devices..."
WriteLog AppID & " " & AppVersion
'select device
Dim i
Dim DevC: DevC = 0
Dim DevId: DevId = "" 'Device ID
Dim DevName: DevName = "" 'Device name
Dim DevTg: DevTg = "" 'Target (music folder)
Dim aDevN() 'DeviceCaption (name)
Dim aDevIdTg() 'ID and Target (music folder)
'Get devices, last synched will be selected in DropDown
Dim sTarget
If SDB.VersionHi >= 4 Then sTarget = "MusicMask" Else sTarget = "TargetMask"
Dim DevIt
Set DevIt = SDB.Database.OpenSQL( _
"SELECT DeviceCaption, ID, " & sTarget & _
" FROM Devices WHERE DeviceCaption <> '' AND PluginName LIKE 'd\_USBMass%.dll' ESCAPE '\' AND LastAutoSynch > 0 ORDER BY LastAutoSynch DESC")
While Not DevIt.EOF
ReDim Preserve aDevN(DevC)
ReDim Preserve aDevIdTg(1, DevC)
DevName = DevIt.StringByIndex(0)
DevId = DevIt.StringByIndex(1)
DevTg = DevIt.StringByIndex(2)
WriteLog DevName & "; " & DevTg
'Find music root folder. DevTg could be e.g. "\music\%R" or "%A" or "\%A", we are interested in "\music" only.
i = InStr(1, DevTg, "\")
If i <> 1 Then
DevTg = "" 'No root folder for music
Else
DevTg = Mid(DevTg, 2)
i = InStr(1, DevTg, "\")
If i > 0 Then DevTg = Mid(DevTg, 1, i - 1)
If InStr(DevTg, "%") Then DevTg = "" 'No common root folder for all music
End If
aDevN(DevC) = DevName
aDevIdTg(0, DevC) = DevId
aDevIdTg(1, DevC) = DevTg
DevIt.Next
DevC = DevC + 1
Wend
Set DevIt = Nothing
If DevC < 1 Then
Call SDB.MessageBox(AppTitle & ": You have no synchronised devices." & vbCrLf & vbCrLf & _
"Please configure the plug-in for USB Mass Storage Devices with your device and Auto-Sync first." & vbCrLf & _
"If your device was automatically attached using d_WMDM.dll, you have to disable it and configure d_USBMass1.dll manually.", mtError, Array(mbOK))
Exit Sub
End If
If DevC > 1 Then
i = SkinnedListBox("Please select device:", AppTitle, aDevN)
If i < 0 Then Exit Sub
DevName = aDevN(i)
DevId = aDevIdTg(0, i)
DevTg = aDevIdTg(1, i)
WriteLog "Selected: " & DevName
End If
prog.Text = AppTitle & ": Initialising - getting song list from device..."
'Tracks last synced to device
Dim DevTrackIt
Dim DevTrackItCount
Set DevTrackIt = SDB.Database.OpenSQL("SELECT COUNT(*) FROM DeviceTracks WHERE IDDevice = " & DevId)
If Not DevTrackIt.EOF Then DevTrackItCount = CInt(DevTrackIt.ValueByIndex(0))
WriteLog "DevTrackItCount: " & DevTrackItCount
If DevTrackItCount < 1 Then
Call SDB.MessageBox(AppTitle & ": You have no synchronised tracks.", mtError, Array(mbOK))
Exit Sub
End If
'Register events to wait for songlist
Script.RegisterEvent SDB, "OnTrackListFilled", "OnTrackListFilled"
Dim Tmr
Set Tmr = SDB.CreateTimer(SDB.IniFile.IntValue(AppID, "TimeOut") * 1000) 'Timeout (milliseconds)
Script.RegisterEvent Tmr, "OnTimer", "TestTimer"
'Check/Enable All-Node
Const sMsgAll = ": Options, Appearance, ""Show 'All' node for contents of folders at top"" has to be enabled."
With SDB.IniFile
If Not (.BoolValue("Tree", "ShowLocationAll") And .BoolValue("Tree", "LocationAllTop")) Then
If SDB.VersionHi >= 4 Then 'in MM3 any change would be lost when closing MM
If SDB.MessageBox(AppTitle & sMsgAll & vbCrLf & " Change this now?", mtWarning, Array(mbYes, mbabort)) = mrYes Then
.BoolValue("Tree", "ShowLocationAll") = True
.BoolValue("Tree", "LocationAllTop") = True
.Apply
Else
Exit Sub
End If
Else
SDB.MessageBox AppTitle & sMsgAll, mtError, Array(mbabort)
Exit Sub
End If
End If
End With
'Navigate to device node
Dim OldNode
Set OldNode = SDB.MainTree.CurrentNode
Dim Node
Dim NodeMatch
Set Node = SDB.MainTree.Node_Library
Do While Not (Node Is Nothing)
'Node caption is device name + drive letter in brackets
If Len(Node.Caption) > 5 Then NodeMatch = Left(Node.Caption, Len(Node.Caption) - 5)
WriteLog NodeMatch & " _ " & DevName
If NodeMatch = DevName Then Exit Do
Set Node = SDB.MainTree.NextSiblingNode(Node)
Loop
If Node Is Nothing Then
SDB.MessageBox AppTitle & ": Device node for '" & DevName & "' not found", mtError, Array(mbabort)
Exit Sub
End If
Dim Drive
Drive = Left(Right(Node.Caption, 3), 2)
'MM4: Navigate to Folders node (first Music node is not relevant as it reflects the PC or sync history rather than the actual track tags from the device)
If SDB.VersionHi >= 4 Then
Node.Expanded = True 'necessary before activating FirstChildNode if the node wasn't expanded once manually before! Otherwise children not available. MM bug IMHO.
Set Node = SDB.MainTree.FirstChildNode(Node)
Do While Not Node Is Nothing
WriteLog Node.Caption & " _ " & SDB.localize("Folders")
If Node.Caption = SDB.localize("Folders") Then Exit Do
Set Node = SDB.MainTree.NextSiblingNode(Node)
Loop
If Node Is Nothing Then
SDB.MessageBox AppTitle & ": " & SDB.localize("Folders") & " node '" & DevTg & "' not found", mtError, Array(mbabort)
Exit Sub
End If
End If
'Navigate to music folder (if defined)
If DevTg <> "" Then
Node.Expanded = True 'necessary before activating FirstChildNode if the node wasn't expanded once manually before! Otherwise children not available. MM bug IMHO.
Set Node = SDB.MainTree.FirstChildNode(Node)
Do While Not Node Is Nothing
WriteLog Node.Caption & " _ " & DevTg
If LCase(Node.Caption) = LCase(DevTg) Then Exit Do
Set Node = SDB.MainTree.NextSiblingNode(Node)
Loop
If Node Is Nothing Then
SDB.MessageBox AppTitle & ": Music node '" & DevTg & "' not found", mtError, Array(mbabort)
Exit Sub
End If
End If
SDB.MainTree.CurrentNode = Node
Node.Expanded = True 'necessary before activating FirstChildNode if the node wasn't expanded once manually before! Otherwise children not available. MM bug IMHO.
bOnTrackListFilled = False
bTimeOut = False
SDB.MainTree.CurrentNode = SDB.MainTree.FirstChildNode(Node) '"All" node
'SDB.MainTracksWindow.Refresh
Do
SDB.ProcessMessages
Loop Until bOnTrackListFilled Or bTimeOut
'unregister events
Script.UnRegisterEvents SDB
Script.UnRegisterEvents Tmr
If bTimeOut Then
If SDB.MessageBox(AppTitle & ": Time out waiting for complete track list." & vbCrLf & _
"Please increase the time out in Options, Sync Back Ratings." & vbCrLf & _
"Sync anyway?", mtError, Array(mbOK, mbabort)) <> mrOk Then Exit Sub
End If
Dim DevNodeSongList
Set DevNodeSongList = SDB.AllVisibleSongList
SDB.MainTree.CurrentNode = OldNode
WriteLog "DevNodeSongList.Count: " & DevNodeSongList.Count
'Get synced tracks
Set DevTrackIt = SDB.Database.OpenSQL("SELECT IDTrack,ID,DevicePath,Rating FROM DeviceTracks WHERE IDDevice = " & DevId)
'Get track statistics from XML on device for play count (search loop on array is 100x faster than on xml node objects!)
Dim bSyncPlayCount
bSyncPlayCount = SDB.IniFile.BoolValue(AppID, "SyncPlayCount")
If bSyncPlayCount Then
prog.Text = AppTitle & ": Initialising - getting play count from PlayerPro..."
'Get the newest file, e.g. "exported_Di._Okt_25_110412_Songbird.xml"
Dim sXMLFolder, oFSO, oDrive, oFolder, oFile, sXMLFile, sXMLFileFolder, dNewestDate, sDrives
Const sSubdirs = "\PlayerPro\Stats\", sFileNameL = "exported_", sFileNameR = "_songbird.xml"
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Search all removable drives for the latest file (e.g. Samsung Galaxy S has internal & external drive)
For Each oDrive In oFSO.Drives
If oDrive.DriveType = 1 Then 'Removable
If oDrive.IsReady Then
WriteLog "Searching XML on " & oDrive.Path
sDrives = sDrives & vbCrLf & oDrive.Path 'Drive list for message if nothing found
sXMLFolder = oDrive.Path & sSubdirs
If oFSO.FolderExists(sXMLFolder) Then
Set oFolder = oFSO.GetFolder(sXMLFolder)
For Each oFile In oFolder.Files
If LCase(Left(oFile.Name, 9)) = sFileNameL And LCase(Right(oFile.Name, 13)) = sFileNameR Then
If oFile.DateLastModified > dNewestDate Then
dNewestDate = oFile.DateLastModified
sXMLFile = oFile.Path
sXMLFileFolder = oFile.ParentFolder
WriteLog sXMLFile & " " & dNewestDate
End If
End If
Next
End If
Else
WriteLog "Drive not ready " & oDrive.Path
End If
End If
Next
If sXMLFile = "" Then
SDB.MessageBox AppTitle & ": no statistics file found " & vbCrLf & sSubdirs & sFileNameL & "*" & sFileNameR & vbCrLf _
& "on drive(s)" & sDrives & vbCrLf & vbCrLf _
& "Please export statistics from Android PlayerPro in Songbird format:" & vbCrLf _
& "Settings, Music library, Export music stats, Songbird", mtError, Array(mbabort)
Exit Sub
End If
'Read play count statistics from the file
Dim oXmlFile
Dim oXmlChildNodes, oXmlChildNode
Set oXmlFile = CreateObject("Microsoft.XMLDOM")
If oXmlFile.Load(sXMLFile) Then
Set oXmlChildNodes = oXmlFile.SelectNodes("/properties/mediaitem")
If oXmlChildNodes.Length = 0 Then
SDB.MessageBox AppTitle & ": Invalid XML format" & vbCrLf & "No properties/mediaitem found in " & vbCrLf & sXMLFile, mtError, Array(mbabort)
Exit Sub
End If
Else
SDB.MessageBox AppTitle & ": Unable to load" & vbCrLf & sXMLFile, mtError, Array(mbabort)
Exit Sub
End If
'Put statistics into array
Dim aDevXMLStat '()
ReDim aDevXMLStat(5, oXmlChildNodes.Length - 1)
i = 0
For Each oXmlChildNode In oXmlChildNodes
aDevXMLStat(0, i) = oXmlChildNode.getElementsByTagName("artist")(0).Text
aDevXMLStat(1, i) = oXmlChildNode.getElementsByTagName("track")(0).Text
aDevXMLStat(2, i) = oXmlChildNode.getElementsByTagName("album")(0).Text
aDevXMLStat(3, i) = CInt(0 & oXmlChildNode.getElementsByTagName("play-count")(0).Text) 'Trick to avoid type mismatch error if there is no play-count
aDevXMLStat(4, i) = CInt(0 & oXmlChildNode.getElementsByTagName("skip-count")(0).Text)
aDevXMLStat(5, i) = Epoch2DateLocal(CDbl(0 & oXmlChildNode.getElementsByTagName("last-played")(0).Text) / 1000) 'Unix timestamp in Millisekunden
i = i + 1
Next
'Check and optionally show duplicates in XML
Dim aXMLData
If i > 0 Then
aXMLData = aDevXMLStat
Dim iDuplicates, iDupl
iDuplicates = iGetDuplicates(aXMLData, aMulticolList, Array(1, 2, 3))
If iDuplicates > 0 Then
If SDB.IniFile.BoolValue(AppID, "ShowDuplicates") Then
aHeader = Array("Artist ", "Title ", "Album ", "Play Count", "Skip Count", "Last Played")
rsSort aMulticolList, aHeader, aHeader 'sort from left to right column
ReportMulticolList iDuplicates & " duplicate tracks found in XML. " & vbCrLf & _
"This may cause unsynched statistics. You may have to clear PlayerPro app data.", _
AppTitle & ": Duplicate Tracks in XML", aHeader, aMulticolList, False
End If
WriteLog "Duplicates in XML: " & iDuplicates
For iDupl = 0 To UBound(aMulticolList, 2)
Dim sDupl, iCol
sDupl = ""
For iCol = 0 To 5
sDupl = sDupl & " | " & aMulticolList(iCol, iDupl)
Next
WriteLog "Duplicate " & iDupl & sDupl
Next
End If
End If
End If
'Get tracks to update
Dim iSongsUpd
iSongsUpd = 0
Dim SongsIt 'Songs from MM
Dim oSonglistUpd 'Songs to update in MM
Set oSonglistUpd = SDB.NewSongList
Dim oSonglistDevTrack
Set oSonglistDevTrack = SDB.NewSongList 'Songs from device
Dim abUpdRating()
Dim aiUpdPlaycount()
Dim aiUpdSkipcount()
Dim adUpdLastPlayed()
Dim iRatingsUpd 'count for info
iRatingsUpd = 0
Dim iPlaycountsUpd 'count for info
iPlaycountsUpd = 0
Dim iSkipcountsUpd 'count for info
iSkipcountsUpd = 0
Dim iLastPlayedUpd 'count for info
iLastPlayedUpd = 0
Dim iImpTrackUpd 'count tracks to import in PlayerPro for info
iImpTrackUpd = 0
Dim bNoSyncIfModifiedInMM
bNoSyncIfModifiedInMM = SDB.IniFile.BoolValue(AppID, "NoSyncIfModifiedInMM")
Dim iDevNodeUnmatched
iDevNodeUnmatched = 0
Dim iMatched
iMatched = 0
Dim iUnMatched
iUnMatched = 0
ReDim aMulticolList(3, 0) 'used for report of unmatched
prog.MaxValue = DevTrackItCount
i = 0
'loop synced tracks
While Not DevTrackIt.EOF
i = i + 1
prog.Value = i
prog.Text = AppTitle & ": Checking track " & i & " of " & DevTrackItCount & "..."
WriteLog DevTrackIt.StringByName("IDTrack") & " " & DevTrackIt.StringByName("DevicePath")
'get MM track
Set SongsIt = SDB.Database.QuerySongs("AND Songs.ID = " & DevTrackIt.StringByName("IDTrack"))
If SongsIt.EOF Then
SDB.MessageBox AppTitle & ": Track not found in MM: " & SongsIt.Item.Title, mtError, Array(mbOK)
Else
'lookup track in device node
Dim DevNodeSongItm, iP
Dim bDevNodeMatched
bDevNodeMatched = False
Dim FileName
FileName = Drive & "\" & DevTrackIt.StringByName("DevicePath")
'WriteLog FileName & vbCrLf & DevNodeSongItm.Path
For iP = 0 To DevNodeSongList.Count - 1
If prog.Terminate Then
Exit Sub
End If
Set DevNodeSongItm = DevNodeSongList.Item(iP)
'if found
If DevNodeSongItm.Path = FileName Then
bDevNodeMatched = True
'check if rating has to be synced to MM
If DevNodeSongItm.Rating <> -1 Then WriteLog "Old rating " & SongsIt.Item.Rating & " New: " & DevNodeSongItm.Rating
Dim bChangeRating
bChangeRating = False
If DevNodeSongItm.Rating > -1 Then 'Is there any rating?
If DevNodeSongItm.Rating <> SongsIt.Item.Rating Then 'Is it different to MM?
If DevNodeSongItm.Rating <> DevTrackIt.StringByName("Rating") Then 'Has it changed on the device (since the last autosync)?
If Not bNoSyncIfModifiedInMM _
Or DevNodeSongItm.FileModified > SongsIt.Item.FileModified _
Or SongsIt.Item.Rating = -1 Then 'Optionally: was the track modified and not empty in MM?
WriteLog "Rating for: " & SongsIt.Item.Title & _
" Date: " & SongsIt.Item.FileModified & " Date device: " & DevNodeSongItm.FileModified
bChangeRating = True
iRatingsUpd = iRatingsUpd + 1
End If
End If
End If
End If
'check if play count has to be synced to MM
Dim iNewPlaycount
iNewPlaycount = 0
Dim iNewSkipcount
iNewSkipcount = 0
Dim dNewLastPlayed
dNewLastPlayed = CDate(0)
'...and if there are changes to be imported in Player Pro
Dim bImpStatsTrack
If bSyncPlayCount Then
Dim bMatched
bMatched = False
'Memo: play count increase after Auto-Sync could be calculated and added to MM count, but be aware of unwanted double counts by repeated execution!
Dim iaD
For iaD = 0 To UBound(aDevXMLStat, 2)
'Search array for the track (use current tags from device as they may have been changed in MM or on the device, assuming the XML is up to date)
'PlayerPro writes "/" if there are several artists and uses path if title or album is empty or for flac (empty artist remains empty)
If LCase(aDevXMLStat(0, iaD)) = LCase(Trim(Replace(DevNodeSongItm.ArtistName, "; ", "/"))) And _
( _
LCase(aDevXMLStat(1, iaD)) = LCase(Trim(DevNodeSongItm.Title)) Or _
( _
(LCase(Right(DevNodeSongItm.Path, 4)) <> ".mp3" Or DevNodeSongItm.Title = "") And _
LCase(aDevXMLStat(1, iaD)) = LCase(WOExtension(FileNameWOPath(DevNodeSongItm.Path))) _
) _
) And _
(LCase(aDevXMLStat(2, iaD)) = LCase(Trim(DevNodeSongItm.AlbumName)) Or _
(DevNodeSongItm.AlbumName = "" And _
LCase(aDevXMLStat(2, iaD)) = LCase(AlbumFromPath(DevNodeSongItm.Path)))) Then
bMatched = True
iMatched = iMatched + 1
bImpStatsTrack = False
'Is play count higher than in MM?
If aDevXMLStat(3, iaD) > SongsIt.Item.PlayCounter Then
iNewPlaycount = aDevXMLStat(3, iaD)
WriteLog "Play count XML > MM: " & iNewPlaycount & " for: " & SongsIt.Item.Title
iPlaycountsUpd = iPlaycountsUpd + 1
ElseIf aDevXMLStat(3, iaD) < SongsIt.Item.PlayCounter Then 'Change XML according to MM {Übergangslösung}
oXmlChildNodes.Item(iaD).getElementsByTagName("play-count")(0).Text = SongsIt.Item.PlayCounter
WriteLog "Play count MM > XML: " & SongsIt.Item.PlayCounter & " for: " & SongsIt.Item.Title
bImpStatsTrack = True
End If
If SDB.VersionHi >= 4 Then
If aDevXMLStat(4, iaD) > SongsIt.Item.SkipCount Then
iNewSkipcount = aDevXMLStat(4, iaD)
WriteLog "Skip count XML > MM: " & iNewSkipcount & " for: " & SongsIt.Item.Title
iSkipcountsUpd = iSkipcountsUpd + 1
ElseIf aDevXMLStat(4, iaD) < SongsIt.Item.SkipCount Then 'Change XML according to MM {Übergangslösung}
oXmlChildNodes.Item(iaD).getElementsByTagName("skip-count")(0).Text = SongsIt.Item.SkipCount
WriteLog "Skip count MM > XML: " & SongsIt.Item.SkipCount & " for: " & SongsIt.Item.Title
bImpStatsTrack = True
End If
End If
If DateDiff("s", SongsIt.Item.LastPlayed, aDevXMLStat(5, iaD)) > 0 Then
dNewLastPlayed = aDevXMLStat(5, iaD)
WriteLog "Last played XML > MM: " & dNewLastPlayed & " for: " & SongsIt.Item.Title
iLastPlayedUpd = iLastPlayedUpd + 1
ElseIf DateDiff("s", SongsIt.Item.LastPlayed, aDevXMLStat(5, iaD)) < 0 Then 'Change XML according to MM {Übergangslösung}
oXmlChildNodes.Item(iaD).getElementsByTagName("last-played")(0).Text = DateLocal2Epoch(SongsIt.Item.LastPlayed) * 1000
WriteLog "Last played MM > XML: " & SongsIt.Item.LastPlayed & " for: " & SongsIt.Item.Title
bImpStatsTrack = True
End If
If bImpStatsTrack Then iImpTrackUpd = iImpTrackUpd + 1
Exit For
End If
Next
If Not bMatched Then
'Fill list for report
ReDim Preserve aMulticolList(3, iUnMatched)
aMulticolList(0, iUnMatched) = DevNodeSongItm.ArtistName
aMulticolList(1, iUnMatched) = DevNodeSongItm.AlbumName
aMulticolList(2, iUnMatched) = DevNodeSongItm.Title
aMulticolList(3, iUnMatched) = Right(DevNodeSongItm.Path, 4)
iUnMatched = iUnMatched + 1
WriteLog "Not found in XML: " & DevNodeSongItm.ArtistName & " | " & DevNodeSongItm.AlbumName & " | " & DevNodeSongItm.Title
End If
End If
'Add song to lists if a tag has to be synced back
If bChangeRating Or iNewPlaycount > 0 Or iNewSkipcount > 0 Or dNewLastPlayed > 0 Then
'Add to songlist
oSonglistUpd.Add (SongsIt.Item)
oSonglistDevTrack.Add (DevNodeSongItm)
'Remember if rating has to be changed
ReDim Preserve abUpdRating(iSongsUpd)
abUpdRating(iSongsUpd) = bChangeRating
'Remember play count (if it has to be changed)
ReDim Preserve aiUpdPlaycount(iSongsUpd)
aiUpdPlaycount(iSongsUpd) = iNewPlaycount
ReDim Preserve aiUpdSkipcount(iSongsUpd)
aiUpdSkipcount(iSongsUpd) = iNewSkipcount
ReDim Preserve adUpdLastPlayed(iSongsUpd)
adUpdLastPlayed(iSongsUpd) = dNewLastPlayed
iSongsUpd = iSongsUpd + 1
End If
Exit For
End If
Next
If Not bDevNodeMatched Then
iDevNodeUnmatched = iDevNodeUnmatched + 1
WriteLog "Not found on device: " & FileName
End If
End If
Set SongsIt = Nothing
DevTrackIt.Next
Wend
Set DevTrackIt = Nothing
'Write import for PlayerPro (even if there is no change to the export because user could try to import anyway)
If bSyncPlayCount Then
If iMatched < DevTrackItCount Then
aHeader = Array("Artist ", "Album ", "Title ", "Extension")
rsSort aMulticolList, aHeader, aHeader 'sort from left to right column
ReportMulticolList "Only " & iMatched & " of " & DevTrackItCount & " tracks found in XML." & vbCrLf & _
"This can happen if tag interpretation by PlayerPro is different from MM.", _
AppTitle & ": Unmatched Tracks", aHeader, aMulticolList, False
ReDim aMulticolList(3, 0) 'Clean up
End If
Dim sImportFile
sImportFile = sXMLFileFolder & "\import.xml"
prog.Text = AppTitle & ": Writing " & sImportFile
WriteLog sImportFile
oXmlFile.Save sImportFile
End If
Dim sMsg
If bSyncPlayCount Then
If iImpTrackUpd > 0 Then
sMsg = "Please import statistics in PlayerPro (" & iImpTrackUpd & " track"
If iImpTrackUpd > 1 Then sMsg = sMsg & "s"
sMsg = sMsg & " to be updated): Settings, Music library, Import music stats, External library." & vbCrLf & vbCrLf
Else
sMsg = "No tracks found to be updated in PlayerPro." & vbCrLf
End If
End If
'Update in MM (ask user)
Dim iColMax
If bSyncPlayCount Then iColMax = 7 Else iColMax = 4
If iSongsUpd > 0 Then
ReDim aMulticolList(iColMax, 0)
If bSyncPlayCount Then
aHeader = Array("Artist ", "Album ", "Title ", "Path ", "Rating ", "Play count", "Skip count", "Last played ")
Else
aHeader = Array("Artist ", "Album ", "Title ", "Path ", "Rating")
End If
For iP = 0 To oSonglistUpd.Count - 1
'Fill list for report
ReDim Preserve aMulticolList(iColMax, iP)
aMulticolList(0, iP) = oSonglistUpd.Item(iP).ArtistName
aMulticolList(1, iP) = oSonglistUpd.Item(iP).AlbumName
aMulticolList(2, iP) = oSonglistUpd.Item(iP).Title
aMulticolList(3, iP) = oSonglistUpd.Item(iP).Path
If abUpdRating(iP) Then aMulticolList(4, iP) = String(RatingMM2XML(oSonglistDevTrack.Item(iP).Rating), "*")
If bSyncPlayCount Then
If aiUpdPlaycount(iP) > 0 Then aMulticolList(5, iP) = aiUpdPlaycount(iP)
If aiUpdSkipcount(iP) > 0 Then aMulticolList(6, iP) = aiUpdSkipcount(iP) '=0 if MM<=3
If adUpdLastPlayed(iP) > 0 Then aMulticolList(7, iP) = adUpdLastPlayed(iP)
End If
Next
rsSort aMulticolList, aHeader, aHeader 'sort from left to right column
sMsg = sMsg & "Ratings (" & iRatingsUpd & ")"
If bSyncPlayCount Then
sMsg = sMsg & ", play count (" & iPlaycountsUpd & ")"
If SDB.VersionHi >= 4 Then sMsg = sMsg & ", skip count (" & iSkipcountsUpd & ")"
sMsg = sMsg & " or last played (" & iLastPlayedUpd & ")"
End If
'Ask user
If ReportMulticolList(sMsg & " found to be updated from device to:", AppTitle, aHeader, aMulticolList, True) = 1 Then
'Update
For iP = 0 To oSonglistUpd.Count - 1
If abUpdRating(iP) Then oSonglistUpd.Item(iP).Rating = oSonglistDevTrack.Item(iP).Rating
If aiUpdPlaycount(iP) > 0 Then oSonglistUpd.Item(iP).PlayCounter = aiUpdPlaycount(iP)
If aiUpdSkipcount(iP) > 0 Then oSonglistUpd.Item(iP).SkipCount = aiUpdSkipcount(iP) '=0 if MM<=3
If adUpdLastPlayed(iP) > 0 Then oSonglistUpd.Item(iP).LastPlayed = adUpdLastPlayed(iP)
Next
oSonglistUpd.UpdateAll
Else
Set oSonglistUpd = Nothing
End If
Else
SDB.MessageBox AppTitle & ": " & vbCrLf & vbCrLf & sMsg & "No tracks found to be updated from the device.", mtInformation, Array(mbOK)
End If
prog.Text = AppTitle & ": Finished"
WriteLog "Finished"
End Sub
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) Then ' And (Edt.ItemIndex > 0) Then
SkinnedListBox = Edt.ItemIndex 'Options(Edt.ItemIndex) '- 1)
Else
' SkinnedListBox = ""
End If
End Function
Sub OnTrackListFilled()
bOnTrackListFilled = True
End Sub
Sub TestTimer(Timer)
' SDB.MessageBox "10 seconds elapsed!", mtInformation, Array(mbOk)
bTimeOut = True
Script.UnRegisterEvents Timer ' Terminate usage of this timer
End Sub
Function ReportMulticolList(Text, Caption, aHeader, aMulticolList, bCancelBt)
'aTitle(Column)
'e.g. aTitle=Array("Column0Title","Column1Title")
'asList(Column, RowIndex)
'bCancelBt True if Cancel button shall be shown
Dim Form, Label, VT, btnOk, btnCancel, iColHdMax, iRowMax, i, iHdrTotalLen
iColHdMax = UBound(aHeader)
iRowMax = UBound(aMulticolList, 2)
' Create the window to be shown
Set Form = SDB.UI.NewForm
Form.Common.SetRect 100, 100, 800, 600 'l, t, w, h
Form.BorderStyle = 2 ' Resizable
Form.FormPosition = 4 ' Screen Center
Form.Caption = Caption
'Label
Set Label = SDB.UI.NewLabel(Form)
Label.Caption = Text
Label.Common.Left = 5
Label.Common.Top = 10
'TreeList listview
Set VT = SDB.UI.NewTreeList(Form)
VT.Common.Left = Label.Common.Left
VT.Common.Top = Label.Common.Top + Label.Common.Height + 5
VT.Common.Height = Form.Common.Height - Label.Common.Height - 90
VT.Common.Width = Form.Common.Width - 25
VT.Common.Anchors = 1 + 2 + 4 + 8 'Left+Top+Right+Bottom
VT.HeaderVisible = True
iHdrTotalLen = Len(Join(aHeader, "")) 'Total length of headers
For i = 0 To iColHdMax
VT.HeaderAddColumn aHeader(i)
'Fit weighted by length of header
VT.HeaderColumnWidth(i) = (VT.Common.Width - 6.5) * (Len(aHeader(i)) / iHdrTotalLen)
Next
VT.RootNodeCount = iRowMax + 1
VT.ShowTreeLines = False
VT.Indent = 0
VT.FullRowSelect = True
VT.ExtendedFocus = True
VT.MultiSelect = True
VT.GridExtensions = True
VT.ShowRoot = False
Script.RegisterEvent VT, "OnGetText", "VTGetText"
' Create buttons that close the window
Set btnOk = SDB.UI.NewButton(Form)
btnOk.Caption = "&OK"
btnOk.Common.Top = VT.Common.Top + VT.Common.Height + 10
btnOk.Common.Left = Form.Common.Width - btnOk.Common.Width - 20
btnOk.Common.Hint = "OK"
btnOk.Common.Anchors = 4 + 8 ' Right+Bottom
btnOk.UseScript = Script.ScriptPath
btnOk.Default = True
btnOk.modalResult = 1
If bCancelBt Then
Set btnCancel = SDB.UI.NewButton(Form)
btnCancel.Caption = "&Cancel"
btnCancel.Common.Left = Form.Common.Width - btnCancel.Common.Width - 20
btnOk.Common.Left = btnCancel.Common.Left - btnOk.Common.Width - 10
btnCancel.Common.Top = btnOk.Common.Top
btnCancel.Common.Hint = "Cancel"
btnCancel.Common.Anchors = 4 + 8 ' Right+Bottom
btnCancel.UseScript = Script.ScriptPath
btnCancel.Cancel = True
btnCancel.modalResult = 2
End If
ReportMulticolList = Form.showModal
End Function
Function VTGetText(Node, Column)
VTGetText = aMulticolList(Column, Node.Index)
End Function
Sub rsSort(ByRef aData, aFields, aSort)
'Text-based sort of a two-dimension array.
'aData: two-dimension array (columns, rows)
'aFields: field names
'aSort: fields on which the rows are to be sorted, like Array("FieldName1 Desc", "FieldName2")
'Credits to: http://www.mombu.com/microsoft/scripting-vb-script/t-sorting-vbscript-array-1207362.html
Dim rs 'recordset object
Dim n, i, j 'looping and array indices
Dim sOrder, sSort 'Sort strings
ReDim aValues(UBound(aData, 1)) 'Single dimension array for the values
Const adVarWChar = 202 'Indicates a unicode string value for field added to recordset.
'Const adVariant = 12 <- no sort
Const adUseClient = 3
On Error Resume Next
Set rs = CreateObject("ADODB.recordset") 'New empty recordset
On Error GoTo 0
If IsEmpty(rs) Then
SDB.MessageBox AppTitle & ": Can't create ADODB object. You may have to install MSDAC from http://msdn.microsoft.com/de-de/data/aa937730 first!", _
mtError, Array(mbOK)
Exit Sub
End If
rs.CursorLocation = adUseClient
For n = 0 To UBound(aFields) 'Add fields
rs.fields.append aFields(n), adVarWChar, 255
Next 'n
rs.Open
For j = 0 To UBound(aData, 2) 'Add data rows
For i = 0 To UBound(aData, 1)
aValues(i) = aData(i, j)
Next 'i
rs.addnew aFields, aValues
rs.Update
Next 'j
For n = 0 To UBound(aSort) 'Add brackets (needed if field name has spaces)
If LCase(Right(aSort(n), 4)) = " asc" Then sOrder = " asc"
If LCase(Right(aSort(n), 5)) = " desc" Then sOrder = " desc"
sSort = sSort & "[" & Left(aSort(n), Len(aSort(n)) - Len(sOrder)) & "]" & sOrder & ", "
Next 'n
rs.Sort = sSort 'Sort on specified fields
Const adBookmarkFirst = 1 'the first record.
aData = rs.GetRows(UBound(aData, 2) + 1, adBookmarkFirst, aFields)
End Sub
Sub InitSheet(oSheet)
Dim oCtrl
Set oCtrl = SDB.UI.NewLabel(oSheet)
With oCtrl
.Caption = "v" & AppVersion & " "
.Common.Align = 4 ' Right
On Error Resume Next
.Common.FontColor = &HF0 'Dark red
On Error GoTo 0
End With
Set oCtrl = SDB.UI.NewCheckBox(oSheet)
With oCtrl
.Checked = SDB.IniFile.BoolValue(AppID, "NoSyncIfModifiedInMM")
.Caption = "Don't sync back rating for tracks with file modification on PC newer than on device"
.Common.SetRect 10, 10, 425, 20 'L, T, W, H
.Common.ControlName = "cbNoSyncIfModifiedInMM"
.Common.Hint = "If the modification date of a song on the PC is updated by any tag change, not only ratings, the rating won't be synced, " & _
"except if there is no rating on the PC, but on the device"
End With
Set oCtrl = SDB.UI.NewCheckBox(oSheet)
With oCtrl
.Checked = SDB.IniFile.BoolValue(AppID, "SyncPlayCount")
.Caption = "Sync back play count from/to PlayerPro on Android (Songbird format)"
.Common.SetRect 10, 40, 425, 20 'L, T, W, H
.Common.ControlName = "cbSyncPlayCount"
.Common.Hint = "Play count statistics are read from an XML file in the Songbird RatingFile AddOn format (SRF)." & vbCrLf & _
"The Android app PlayerPro can use this. You have to export the file there before starting " & AppTitle
Script.RegisterEvent .Common, "OnClick", "cbSyncPlayCountClick"
End With
Set oCtrl = SDB.UI.NewCheckBox(oSheet)
With oCtrl
.Checked = SDB.IniFile.BoolValue(AppID, "ShowDuplicates")
.Caption = "Show duplicates in the XML file"
.Common.SetRect 40, 70, 500, 20 'L, T, W, H
.Common.ControlName = "cbShowDuplicates"
.Common.Hint = "Duplicates can cause unsynchronised tags"
.Common.Enabled = oSheet.Common.ChildControl("cbSyncPlayCount").Checked
End With
Set oCtrl = SDB.UI.NewLabel(oSheet)
With oCtrl
.Common.SetRect 10, 104, 65, 20 'L, T, W, H
.Common.ControlName = "lbTimeOut"
.Caption = "Time out when waiting for the device song list for more than:"
End With
Set oCtrl = SDB.UI.NewSpinEdit(oSheet)
With oCtrl
.MaxValue = 3600
.MinValue = 10
.Value = SDB.IniFile.IntValue(AppID, "TimeOut")
.Common.SetRect 310, 100, 50, 20 'L, T, W, H
.Common.ControlName = "seTimeOut"
.Common.Hint = "Time out (min 10s, max 3600s)"
End With
Set oCtrl = SDB.UI.NewLabel(oSheet)
With oCtrl
.Common.SetRect 370, 104, 20, 20 'L, T, W, H
.Common.ControlName = "lbSec"
.Caption = "seconds"
End With
Set oCtrl = SDB.UI.NewCheckBox(oSheet)
With oCtrl
.Checked = SDB.IniFile.BoolValue(AppID, "WriteLog")
.Caption = "Write debug log file '" & sLogfile() & "'"
.Common.SetRect 10, 130, 500, 20 'L, T, W, H
.Common.ControlName = "cbWriteLog"
.Common.Hint = "May be helpful for support (please visit the " & AppTitle & " thread in forum 'Need Help with Addons?')."
End With
End Sub
Sub cbSyncPlayCountClick(oCtrl)
oCtrl.Common.TopParent.Common.ChildControl("cbShowDuplicates").Common.Enabled = oCtrl.Checked
End Sub
Sub SaveSheet(oSheet)
SDB.IniFile.BoolValue(AppID, "NoSyncIfModifiedInMM") _
= oSheet.Common.ChildControl("cbNoSyncIfModifiedInMM").Checked
SDB.IniFile.IntValue(AppID, "TimeOut") _
= oSheet.Common.ChildControl("seTimeOut").Value
SDB.IniFile.BoolValue(AppID, "SyncPlayCount") _
= oSheet.Common.ChildControl("cbSyncPlayCount").Checked
SDB.IniFile.BoolValue(AppID, "ShowDuplicates") _
= oSheet.Common.ChildControl("cbShowDuplicates").Checked
SDB.IniFile.BoolValue(AppID, "WriteLog") _
= oSheet.Common.ChildControl("cbWriteLog").Checked
End Sub
Function Epoch2DateLocal(dEpoch)
Dim dDateGMT
If dEpoch > 0 Then
'Convert from epoch to VB
dDateGMT = DateAdd("s", dEpoch, #1/1/1970#)
'Convert from UTC/GMT to local time (thanks abatistas1709 for contributing this!)
Epoch2DateLocal = DateAdd("n", iLocalTimeOffset() * -1, dDateGMT)
End If
End Function
Function DateLocal2Epoch(dDateLocal)
Dim dDateGMT
If dDateLocal > 0 Then
'Convert from local time to UTC/GMT
dDateGMT = DateAdd("n", iLocalTimeOffset(), dDateLocal)
'Convert from VB to epoch
DateLocal2Epoch = DateDiff("s", #1/1/1970#, dDateGMT)
End If
End Function
Function iLocalTimeOffset()
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
iLocalTimeOffset = WshShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
End Function
Sub WriteLog(txt)
If SDB.IniFile.BoolValue(AppID, "WriteLog") Then
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim logf: Set logf = fso.OpenTextFile(sLogfile(), 8, True)
logf.WriteLine (Time & " " & SDB.ToAscii(txt))
logf.Close
End If
End Sub
Function sLogfile()
sLogfile = SDB.TemporaryFolder & AppID & ".log"
End Function
Function RatingMM2XML(iRating)
'PlayerPro doesn't support bomb and half stars yet and interprets 0 the same as empty, i.e. we can simply round
RatingMM2XML = Round(0.01 + iRating / 20) 'Trick to round 0.5 up to 1 because VB does Banker's rounding, see http://support.microsoft.com/kb/196652/EN-US
End Function
Function FileNameWOPath(ByVal sFilename)
Dim iPos
Do
sFilename = Mid(sFilename, iPos + 1)
iPos = InStr(1, sFilename, "\")
Loop Until iPos = 0
FileNameWOPath = sFilename
End Function
Function WOExtension(ByVal sFile)
Dim iPos
iPos = InStrRev(sFile, ".")
If iPos > 0 Then
iPos = iPos - 1
sFile = Mid(sFile, 1, iPos)
End If
WOExtension = sFile
End Function
Function AlbumFromPath(sPath)
Dim iPos1, iPos2
iPos2 = InStrRev(sPath, "\")
If iPos2 > 1 Then
iPos2 = iPos2 - 1
iPos1 = InStrRev(Mid(sPath, 1, iPos2), "\") + 1
AlbumFromPath = Mid(sPath, iPos1, iPos2 - iPos1 + 1)
End If
End Function
Function iGetDuplicates(ByRef aData, ByRef aDuplicates, aCheckColumns)
Dim i, j, c, bDouble, iDouble, aFields
iDouble = 0
ReDim aDuplicates(UBound(aData, 1), 0)
ReDim aFields(UBound(aData, 1))
For c = 0 To UBound(aFields)
aFields(c) = c
Next
rsSort aData, aFields, aCheckColumns
For i = 0 To UBound(aData, 2) - 1
bDouble = True
For c = 0 To UBound(aData, 1)
If aData(c, i) <> aData(c, i + 1) Then bDouble = False
Next
If bDouble Then
ReDim Preserve aDuplicates(UBound(aData, 1), iDouble + 1)
For c = 0 To UBound(aData, 1)
aDuplicates(c, iDouble) = aData(c, i)
aDuplicates(c, iDouble + 1) = aData(c, i + 1)
Next
iDouble = iDouble + 2
End If
Next
iGetDuplicates = iDouble / 2
End Function
History
0.2 (2011-08-14)
- Initial alpha release
0.2.1
- Message for number of updated songs
0.3
- Last synced device is preselected
- Checks for fully loaded song list (no more user interaction needed)
- List of tracks with ratings to be updated, user can decide if update shall be executed
- Sync only if there is a rating from the device (don't overwrite existing ratings with empty ones)
- go back to last node
- Some other minor improvements
0.4 (2011-08-15)
- Only synced usb msc devices can be selected. No selection needed if there is only one.
- Handling fixed if device is not attached (missing node)
0.4.1
- Listbox description changed
- Known issue (since 0.3): for format converted songs the sync is applied even if the user cancels from the list of tracks to be updated (MM bug?)
0.5 (2011-08-26)
- (Resolved known issue:) really no change to tags at all until user presses OK from the list of tracks to be updated
- Timeout for reading device song list increased to 90 sec
0.6
- Read songs from music folder only (if specified for the device) -> faster!
- Width of sync report increased
- Status bar text changed
0.7 (2011-08-27)
- Installation package and web update
- Menu items in Tools and Main Tree
0.8 (2011-10-16)
- Don't sync back if the rating on the device is unchanged since the last Auto-Sync
- Option sheet (under Portable/Audio Devices)
- Options: don't sync back if the file date on the PC is newer; set time-out limit for the track list from the device
- Default timeout for reading device song list increased to 120 sec
- Uninstall removes the menu items (no restart of MM needed anymore)
0.8.1 (2011-10-17)
- If option "Don't sync back tracks having a file modification on the PC..." is set, sync back anyways if rating is empty on the PC
0.9 (2011-11-13)
- MediaMonkey 4.0 supported
1.0 (2011-11-21)
- Sync back play count from PlayerPro
- Minor UI improvements (option sheet, update report, progress bar)
1.1 (2011-11-27)
- Search for newest XML statistics file on all removable drives
- Options sheet caption and uninstall message with spaces
1.2 (2012-01-15)
- Sync back skip count (MM4) and last played from PlayerPro
- Check 'All' node setting
1.3 (2012-02-19)
- Convert UTC/GMT to local time for last played date. Thanks a lot to abatistas1709 for contributing this!
- Additional USBMass DLLs (e.g. USBMass1.dll for your phone and USBMass2.dll for your partner's phone) were ignored
- Hints added to some error messages
- GNU General Public License (GPL) added
1.4 (2012-09-02)
- Sync stats from MM to Player Pro via import file (based on the last export)
- Sync back from PlayerPro was indicated even if there was no change, because of a finer time resolution in the XML than in MM
- Option for writing a debug log file
1.5 (2012-09-02)
- Change items in import file for Player Pro only where needed
- Inform user if import in Player Pro is recommended
1.6 (2012-10-06)
- Added message text on how to ex-/import PlayerPro statistics and about deactivating WMDM
- Buttons in report list keep the exact position to the bottom when window is resized
- Log file shows statistics that are higher in MM than in PlayerPro (MM > XML)
1.7 (2012-10-08)
- XML track matching improved where PlayerPro uses file or folder name (e.g. flac, unknown album and multiple artists)
- Message and detailed log if tracks could not be found in the XML
1.8 (2012-10-15)
- XML track matching improved for unknown song titles
- Detailed reports
- Log tracks that were not found on the device
1.8.1 (2012-10-16)
- Report layout improved
1.9 (2013-02-23)
- Match for USBMass*.dll instead of USBMass?.dll
- Check and optionally show duplicate tracks in XML
- Ignore case for XML look up
1.9.1 (2013-02-23)
- More detailed log for duplicate tracks in XML
1.9.2 (2013-03-12)
- Ignore case for Music node matching
1.9.3 (2013-12-03)
- Message fixed when synced song is missing in MM
I'm looking forward to your feedback! Hope the script is useful for some of you!
