Sync stats for Android PlayerPro XML (MTP) v1.1 2013-02-24
Posted: Sun Oct 07, 2012 2:15 pm
What is it about?
This is to sync your rating tags and play statistics based on an XML file in Songbird RatingFile AddOn format (SRF) as used by Android Music PlayerPro.
If your device supports USB mass storage (MSC), please use Sync back ratings & play counts (MSC) instead, because it can match tracks more precisely.
Some Android devices like Samsung Galaxy S3 don't support MSC, but only MTP (Media Player). Alternatives are rooting and Easy UMS or using the external SD card directly on the PC. As Android MTP doesn't support ratings and play count, Auto-Sync is unable to sync them, so you can use this script instead.
How does it work?
The script looks up all tracks from the last Auto-Sync of a device in MediaMonkey. It works for format converted songs as well, e.g. ape on PC and mp3 on portable device.
Unchanged or empty (no star) ratings are ignored. If a Play count, skip count (needs MM 4) or last played date value is higher than in MM it is copied to MM, otherwise it is copied from MM. New files from the device are ignored (e.g. tracks downloaded to a phone).
If you have several synced devices, you can choose which one to sync.
Instructions
Download and execute the installation package SyncMusicStatsXML.mmip
"Sync Music Stats XML" will be shown in the corresponding menu item in Tools or in the pop up of the main tree (press right mouse key).
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.
In PlayerPro, select Settings, Music library, Rating system, PlayerPro.
Only with this setting it is possible to import ratings from the XML to PlayerPro. With other rating systems they are ignored.
How to sync play statistics:
To update or uninstall, go to menu Tools->Extensions.
Remarks
This script is not a perfect solution yet. Why?
Portions of the script were inspired by Find Sync Dups 1.3 and Update Rating from Ipod to MM, thanks trixmoto and apoujade.
History
0.1 (2012-10-07)
- Initial alpha release
0.2 (2012-10-08)
- Message about tracks not found was shown even if there was no mismatch
1.0 (2012-10-15)
- Improved matching of tracks (derived from the path on the device for some cases)
- Detailed reports
1.0.1 (2012-10-16)
- Improved report layout
1.0.2 (2012-12-16)
- Error message fixed for track not found in MM
1.1 (2013-02-24)
- Check and optionally show duplicate tracks in XML
- Ignore case for XML look up
- XML folder selection dialog
This is to sync your rating tags and play statistics based on an XML file in Songbird RatingFile AddOn format (SRF) as used by Android Music PlayerPro.
If your device supports USB mass storage (MSC), please use Sync back ratings & play counts (MSC) instead, because it can match tracks more precisely.
Some Android devices like Samsung Galaxy S3 don't support MSC, but only MTP (Media Player). Alternatives are rooting and Easy UMS or using the external SD card directly on the PC. As Android MTP doesn't support ratings and play count, Auto-Sync is unable to sync them, so you can use this script instead.
How does it work?
The script looks up all tracks from the last Auto-Sync of a device in MediaMonkey. It works for format converted songs as well, e.g. ape on PC and mp3 on portable device.
Unchanged or empty (no star) ratings are ignored. If a Play count, skip count (needs MM 4) or last played date value is higher than in MM it is copied to MM, otherwise it is copied from MM. New files from the device are ignored (e.g. tracks downloaded to a phone).
If you have several synced devices, you can choose which one to sync.
Instructions
Download and execute the installation package SyncMusicStatsXML.mmip
"Sync Music Stats XML" will be shown in the corresponding menu item in Tools or in the pop up of the main tree (press right mouse key).
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.
In PlayerPro, select Settings, Music library, Rating system, PlayerPro.
Only with this setting it is possible to import ratings from the XML to PlayerPro. With other rating systems they are ignored.
How to sync play statistics:
- In MM, go to Tools, Options, Portable/Audio Devices, Sync Music Stats XML, and enter the folder (incl. the drive letter) where the XML is, e.g. C:\SyncMusicStatsXML.
- If you want to use MSC, go to Tools, Options, Portable/Audio Devices, Sync Music Stats XML, and check "Show MSC devices as well"
- 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.
- With MTP devices, you have to copy the XML file manually from the device to the PC.
Open Windows Explorer, navigate to the folder "\PlayerPro\Stats\" on the device and copy the newest file named like "exported_*_Songbird.xml" to the specified folder on the PC. - Start "Sync Music Stats XML".
- With MTP devices, you have to copy the XML file manually from the PC to the device.
Open Windows Explorer, navigate to the specified folder on the PC and copy the file import.xml to the folder "\PlayerPro\Stats\" on the device. - Detach the device.
- In PlayerPro, Import music stats, External library.
After an auto-sync do steps 3-9 before playing any music in order to import stats from MM first.
To update or uninstall, go to menu Tools->Extensions.
Remarks
This script is not a perfect solution yet. Why?
- This has to be executed manually. As VB Script doesn't support MTP, the file has to be copied manually.
- If artist, album and title info was changed after the last auto-sync, the track can't be found in the XML. A better matching via the device node should be possible, but would be slower.
Code: Select all
'----------------------------------------------------------------------------------------------------------------
' Sync music statistics (ratings and play count) with Android Player Pro according to last executed sync
'
' 24. Feb. 2013
' First created 07. Oct. 2012
' by Aff
'
' For details please visit the MediaMonkey forum:
' http://www.mediamonkey.com/forum/
'
' 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 Music Stats XML"
Const AppID = "SyncMusicStatsXML"
Const AppVersion = "1.1"
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 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 SyncMusicStatsXML(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 aDevN() 'DeviceCaption (name)
Dim aDevIdTg() 'ID and Target (music folder)
'Get devices, last synched will be selected in DropDown
Dim sSQL
sSQL = "SELECT DeviceCaption, ID FROM Devices WHERE DeviceCaption <> '' AND (PluginName LIKE 'd\_WMDM.dll' ESCAPE '\' "
If SDB.IniFile.BoolValue(AppID, "ShowMSC") Then sSQL = sSQL & "OR PluginName LIKE 'd\_USBMass_.dll' ESCAPE '\' "
sSQL = sSQL & ") AND LastAutoSynch > 0 ORDER BY LastAutoSynch DESC"
Dim DevIt
Set DevIt = SDB.Database.OpenSQL(sSQL)
While Not DevIt.EOF
ReDim Preserve aDevN(DevC)
ReDim Preserve aDevIdTg(1, DevC)
DevName = DevIt.StringByIndex(0)
DevId = DevIt.StringByIndex(1)
WriteLog DevName
aDevN(DevC) = DevName
aDevIdTg(0, DevC) = DevId
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 Windows Media Device Manager (WMDM) or optional for MSC (USBMass) with your device and Auto-Sync first.", 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)
WriteLog "Selected: " & DevName
End If
prog.Text = AppTitle & ": Initialising - getting song list from last auto-sync..."
'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
'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 sXMLFolder
sXMLFolder = SDB.IniFile.StringValue(AppID, "XMLFolder")
If sXMLFolder = "" Then
SDB.MessageBox AppTitle & ": XML folder not specified." & vbCrLf & _
"Please go to options and set the path to the folder containing the XML file first.", mtError, Array(mbOK)
Exit Sub
Else
prog.Text = AppTitle & ": Initialising - looking for the XML file in " & sXMLFolder & "..."
'Get the newest file, e.g. "exported_Di._Okt_25_110412_Songbird.xml"
Dim oFSO, oDrive, oFolder, oFile, sXMLFile, sXMLFileFolder, dNewestDate, sDrives
Const sFileNameL = "exported_", sFileNameR = "_songbird.xml"
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Search for the latest file
WriteLog "Searching XML on " & sXMLFolder
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
Else
SDB.MessageBox AppTitle & ": XML folder not found: " & vbCrLf & _
sXMLFolder & vbCrLf & _
"Please check the path to the folder containing the XML file, set in options.", mtError, Array(mbOK)
Exit Sub
End If
If sXMLFile = "" Then
SDB.MessageBox AppTitle & ": no statistics file found " & vbCrLf & sXMLFolder & sFileNameL & "*" & sFileNameR & 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
prog.Text = AppTitle & ": Initialising - getting statistics from XML file..."
'Read 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(6, 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
aDevXMLStat(6, i) = RatingXML2MM(CDbl(0 & oXmlChildNode.getElementsByTagName("rating")(0).Text)) 'Trick to avoid type mismatch error if there is no rating
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", "Rating ")
rsSort aMulticolList, aHeader, aHeader 'sort from left to right column
For iDupl = 0 To UBound(aMulticolList, 2)
aMulticolList(6, iDupl) = String(RatingMM2XML(aMulticolList(6, iDupl)), "*")
Next
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 aiUpdRating()
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 sDevicePath
sDevicePath = ""
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 & "..."
sDevicePath = DevTrackIt.StringByName("DevicePath")
WriteLog DevTrackIt.StringByName("IDTrack") & " " & sDevicePath
'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: " & sDevicePath, mtError, Array(mbOK)
Else
'check if stats have to be synced to MM
Dim iNewPlaycount
iNewPlaycount = 0
Dim iNewSkipcount
iNewSkipcount = 0
Dim dNewLastPlayed
dNewLastPlayed = CDate(0)
Dim iNewRating
iNewRating = -1
'...and if there are changes to be imported in Player Pro
Dim bImpStatsTrack
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 path from last auto-sync as well)
'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(SongsIt.Item.ArtistName, "; ", "/"))) And _
( _
LCase(aDevXMLStat(1, iaD)) = LCase(Trim(SongsIt.Item.Title)) Or _
( _
(LCase(Right(sDevicePath, 4)) <> ".mp3" Or SongsIt.Item.Title = "") And _
LCase(aDevXMLStat(1, iaD)) = LCase(WOExtension(FileNameWOPath(sDevicePath))) _
) _
) And _
(LCase(aDevXMLStat(2, iaD)) = LCase(Trim(SongsIt.Item.AlbumName)) Or _
(SongsIt.Item.AlbumName = "" And _
LCase(aDevXMLStat(2, iaD)) = LCase(AlbumFromPath(sDevicePath)))) 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
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
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
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
'Is rating different to MM?
If aDevXMLStat(6, iaD) <> SongsIt.Item.Rating Then
If aDevXMLStat(6, iaD) > -1 And _
aDevXMLStat(6, iaD) <> DevTrackIt.StringByName("Rating") Then 'Is there any rating? Has it changed on the device (since the last autosync)?
iNewRating = aDevXMLStat(6, iaD)
WriteLog "Rating XML > MM: " & iNewRating & " for: " & SongsIt.Item.Title
iRatingsUpd = iRatingsUpd + 1
ElseIf SongsIt.Item.Rating > -1 Then 'Change XML according to MM
oXmlChildNodes.Item(iaD).getElementsByTagName("rating")(0).Text = RatingMM2XML(SongsIt.Item.Rating)
WriteLog "Rating MM > XML: " & SongsIt.Item.Rating & " for: " & SongsIt.Item.Title
bImpStatsTrack = True
End If
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) = SongsIt.Item.ArtistName
aMulticolList(1, iUnMatched) = SongsIt.Item.AlbumName
aMulticolList(2, iUnMatched) = SongsIt.Item.Title
aMulticolList(3, iUnMatched) = Right(sDevicePath, 4)
iUnMatched = iUnMatched + 1
WriteLog "Not found in XML: " & SongsIt.Item.ArtistName & " | " & SongsIt.Item.AlbumName & " | " & SongsIt.Item.Title & _
" | " & Right(sDevicePath, 4)
End If
'Add song to lists if a tag has to be synced back
If iNewRating > 0 Or iNewPlaycount > 0 Or iNewSkipcount > 0 Or dNewLastPlayed > 0 Then
'Add to songlist
oSonglistUpd.Add (SongsIt.Item)
'Remember if rating has to be changed
ReDim Preserve aiUpdRating(iSongsUpd)
aiUpdRating(iSongsUpd) = iNewRating
'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
End If
Set SongsIt = Nothing
DevTrackIt.Next
Wend
Set DevTrackIt = Nothing
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 tracks were renamed in MM after the last auto-sync or different tag interpretation by PlayerPro.", _
AppTitle & ": Unmatched Tracks", aHeader, aMulticolList, False
ReDim aMulticolList(3, 0) 'Clean up
End If
'Write import for PlayerPro (even if there is no change to the export because user could try to import anyway)
Dim sImportFile
sImportFile = sXMLFileFolder & "\import.xml"
prog.Text = AppTitle & ": Writing " & sImportFile
WriteLog sImportFile
oXmlFile.Save sImportFile
Dim sMsg
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
'Update in MM (ask user)
If iSongsUpd > 0 Then
ReDim aMulticolList(7, 0)
Dim iP
For iP = 0 To oSonglistUpd.Count - 1
'Fill list for report
ReDim Preserve aMulticolList(7, 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 aiUpdRating(iP) > 0 Then aMulticolList(4, iP) = String(RatingMM2XML(aiUpdRating(iP)), "*")
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)
Next
aHeader = Array("Artist ", "Album ", "Title ", "Path ", "Rating ", "Play count", "Skip count", "Last played ")
rsSort aMulticolList, aHeader, aHeader 'sort from left to right column
sMsg = sMsg & "Ratings (" & iRatingsUpd & ")"
sMsg = sMsg & ", play count (" & iPlaycountsUpd & ")"
If SDB.VersionHi >= 4 Then sMsg = sMsg & ", skip count (" & iSkipcountsUpd & ")"
sMsg = sMsg & " or last played (" & iLastPlayedUpd & ")"
'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 aiUpdRating(iP) > 0 Then oSonglistUpd.Item(iP).Rating = aiUpdRating(iP)
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
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 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.NewLabel(oSheet)
With oCtrl
.Common.SetRect 10, 20, 500, 20 'L, T, W, H
.Common.ControlName = "lbXMLFolder"
.Caption = "Folder of the XML file in the Songbird RatingFile AddOn format (SRF):"
End With
Set oCtrl = SDB.UI.NewEdit(oSheet)
With oCtrl
.Text = SDB.IniFile.StringValue(AppID, "XMLFolder")
.Common.SetRect 10, 40, 470, 20 'L, T, W, H
.Common.ControlName = "edXMLFolder"
.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 & vbCrLf & _
"With MTP, you have to copy the file manually from your device!"
End With
Set oCtrl = SDB.UI.NewButton(oSheet)
With oCtrl
.Caption = "..."
.Common.SetRect 490, 40, 20, 20 'L, T, W, H
.Common.ControlName = "btXMLFolder"
Script.RegisterEvent .Common, "OnClick", "btXMLFolderClick"
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 10, 80, 500, 20 'L, T, W, H
.Common.ControlName = "cbShowDuplicates"
.Common.Hint = "Duplicates can cause unsynchronised tags"
End With
Set oCtrl = SDB.UI.NewCheckBox(oSheet)
With oCtrl
.Checked = SDB.IniFile.BoolValue(AppID, "ShowMSC")
.Caption = "Show MSC devices as well"
.Common.SetRect 10, 110, 500, 20 'L, T, W, H
.Common.ControlName = "cbShowMSC"
.Common.Hint = "You can force this script to work with MSC as well." & vbCrLf & _
"But if your device is able to use MSC (d_USBMass1.dll), another script is recommended: Sync back ratings & play counts (MSC)"
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, 140, 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 btXMLFolderClick(oCtrl)
'Get the folder from user dialog
With oCtrl.Common.TopParent.Common.ChildControl("edXMLFolder")
.Text = SDB.SelectFolder(.Text, "Folder for the XML file (exported_*_Songbird.xml)")
End With
End Sub
Sub SaveSheet(oSheet)
Dim sXMLFolder
sXMLFolder = oSheet.Common.ChildControl("edXMLFolder").Text
If Len(sXMLFolder) > 0 And Right(sXMLFolder, 1) <> "\" Then sXMLFolder = sXMLFolder & "\"
SDB.IniFile.StringValue(AppID, "XMLFolder") _
= sXMLFolder
SDB.IniFile.BoolValue(AppID, "ShowDuplicates") _
= oSheet.Common.ChildControl("cbShowDuplicates").Checked
SDB.IniFile.BoolValue(AppID, "ShowMSC") _
= oSheet.Common.ChildControl("cbShowMSC").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 RatingXML2MM(iRating)
'PlayerPro doesn't support bomb yet and always writes 0 to the XML if rating is empty or had a MM bomb
If iRating > 0 Then
RatingXML2MM = iRating * 20
Else
RatingXML2MM = -1
End If
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.1 (2012-10-07)
- Initial alpha release
0.2 (2012-10-08)
- Message about tracks not found was shown even if there was no mismatch
1.0 (2012-10-15)
- Improved matching of tracks (derived from the path on the device for some cases)
- Detailed reports
1.0.1 (2012-10-16)
- Improved report layout
1.0.2 (2012-12-16)
- Error message fixed for track not found in MM
1.1 (2013-02-24)
- Check and optionally show duplicate tracks in XML
- Ignore case for XML look up
- XML folder selection dialog