Import music stats from Songbird XML v1.0 2012-10-15

Download and get help for different MediaMonkey for Windows 4 Addons.

Moderators: Peke, Gurus

Aff
Posts: 307
Joined: Sun Oct 05, 2008 4:46 pm
Location: Switzerland

Import music stats from Songbird XML v1.0 2012-10-15

Post by Aff »

What is it about?

This is to import your rating tags and play statistics based on an XML file in Songbird RatingFile AddOn format (SRF) (also used by Android Music PlayerPro).

If you are looking for device sync, please use Sync back ratings & play counts (MSC) (or Sync stats for Android PlayerPro XML (MTP)) instead!

How does it work?

The script looks up all tracks from the selected XML file in MediaMonkey by artist, album and title.
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.

Instructions

Download and execute the installation package ImportMusicStatsXML.mmip

"Import MusicStats XML" will be shown in the corresponding menu item in Tools or in the pop up of the main tree (press right mouse key).
You can select the XML file you'd like to import.

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.

Updates or Uninstall

To update or uninstall, go to menu Tools->Extensions.

Source Code (ImportMusicStatsXML.vbs)

Code: Select all

'----------------------------------------------------------------------------------------------------------------
'  Import music statistics (ratings and play count) from XML in Songbird RatingFile AddOn format (SRF)
'
'  15. Oct. 2012
'  First created 13. 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 = "Import Music Stats XML"
Const AppID = "ImportMusicStatsXML"
Const AppVersion = "1.0"

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 Library sheet and store ID for uninstall
    SDB.IniFile.IntValue(AppID, "OptionSheet") = _
        SDB.UI.AddOptionSheet(AppTitle, Script.ScriptPath, "InitSheet", "SaveSheet", -3)

End Sub

Sub ImportMusicStatsXML(v)
    
    Dim aHeader 'for ReportMulticolList
    ReDim aMulticolList(3, 0) 'first used for report of unmatched
           
    'create progress bar
    Dim prog: Set prog = SDB.Progress
    prog.Value = 0
    prog.MaxValue = 1
    WriteLog AppID & " " & AppVersion
      
    'Get the file from user dialog
    prog.Text = AppTitle & ": Initialising - asking for XML file..."
    Dim dlg: Set dlg = SDB.CommonDialog
    dlg.Title = "Please select the XML file in the Songbird RatingFile AddOn format"
    dlg.DefaultExt = "xml"
    dlg.Filter = "XML files (*.xml)|*.xml|All files (*.*)|*.*"
    dlg.InitDir = SDB.IniFile.StringValue(AppID, "XMLFolder")
    dlg.ShowOpen
    If Not dlg.Ok Then
      Exit Sub   ' if cancel was pressed, exit
    End If
    
    'Get track statistics from XML on device for play count (search loop on array is 100x faster than on xml node objects!)
    prog.Text = AppTitle & ": Initialising - getting statistics from XML file..."
    
    ' Get the selected filename
    Dim sXMLFile: sXMLFile = dlg.FileName
    WriteLog sXMLFile
    If Not SDB.Tools.FileSystem.FileExists(sXMLFile) Then
        SDB.MessageBox AppTitle & ": XML not found: " & vbCrLf & sXMLFile, mtError, Array(mbOK)
        Exit Sub
    End If

    '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)
    Dim i
    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
    
    '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 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 iMatched
    iMatched = 0
    Dim iUnMatched
    iUnMatched = 0
    
    'Loop through XML
    Dim iDevXMLStatCount
    iDevXMLStatCount = UBound(aDevXMLStat, 2)
    prog.MaxValue = iDevXMLStatCount
    i = 0
    Dim iaD
    For iaD = 0 To iDevXMLStatCount
        
        '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
        Dim bMatched
        bMatched = False
        
        'Find song in MM
        i = i + 1
        prog.Value = i
        prog.Text = AppTitle & ": Checking track " & i & " of " & iDevXMLStatCount & "..."
        WriteLog aDevXMLStat(0, iaD) & " | " & aDevXMLStat(2, iaD) & " | " & aDevXMLStat(1, iaD)
        
        Set SongsIt = SDB.Database.QuerySongs("AND Songs.Artist = """ & sEncloseQuotMarks(aDevXMLStat(0, iaD)) & _
                                              """ AND Songs.SongTitle = """ & sEncloseQuotMarks(aDevXMLStat(1, iaD)) & _
                                              """ AND Songs.Album = """ & sEncloseQuotMarks(aDevXMLStat(2, iaD)) & """")
        If SongsIt.EOF Then
            WriteLog "Not found in MM!!"
            'Fill list for report
            ReDim Preserve aMulticolList(3, iUnMatched)
            aMulticolList(0, iUnMatched) = aDevXMLStat(0, iaD)
            aMulticolList(1, iUnMatched) = aDevXMLStat(2, iaD)
            aMulticolList(2, iUnMatched) = aDevXMLStat(1, iaD)
            aMulticolList(3, iUnMatched) = String(RatingMM2XML(aDevXMLStat(6, iaD)), "*")
            iUnMatched = iUnMatched + 1
        Else
            bMatched = True
            iMatched = iMatched + 1
            '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
            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
                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
            End If
            'Is rating different to MM?
            If aDevXMLStat(6, iaD) <> SongsIt.Item.Rating Then
                If aDevXMLStat(6, iaD) > -1 Then 'Is there any rating?
                            iNewRating = aDevXMLStat(6, iaD)
                            WriteLog "Rating XML > MM: " & iNewRating & " for: " & SongsIt.Item.Title
                            iRatingsUpd = iRatingsUpd + 1
                End If
            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
    Next

    If iMatched < iDevXMLStatCount Then
        aHeader = Array("Artist            ", "Album              ", "Title                ", "Rating")
        rsSort aMulticolList, aHeader, aHeader 'sort from left to right column
        ReportMulticolList "Only " & iMatched & " of " & iDevXMLStatCount & " tracks found in MediaMonkey." & vbCrLf & _
                                    "This happens if artist, album or title in the XML are different from MediaMonkey.", _
                                    AppTitle & ": Unmatched Tracks", aHeader, aMulticolList, False
        ReDim aMulticolList(3, 0) 'Clean up
    End If

    Dim sMsg
    '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 XML 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 XML.", mtInformation, Array(mbOK)
    End If
    
    prog.Text = AppTitle & ": Finished"
    WriteLog "Finished"
    
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, 700, 500 '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) * (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 = "Default 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, 500, 20 'L, T, W, H
        .Common.ControlName = "edXMLFolder"
        .Common.Hint = "The file dialog will start with this folder"
    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, 80, 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 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, "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 sEncloseQuotMarks(ByVal s)
    sEncloseQuotMarks = Replace(s, """", """""")
End Function

History

0.1 (2012-10-13)
- Initial release

1.0 (2012-10-15)
- Detailed reports
- Quotation marks allowed in names
Last edited by Aff on Mon Oct 15, 2012 4:01 pm, edited 1 time in total.
thiagorobis
Posts: 10
Joined: Sun Sep 30, 2012 6:08 pm

Re: Import music stats from Songbird XML v0.1 2012-10-13

Post by thiagorobis »

Works like a charm! ;D
Congratulations!
H3X
Posts: 3
Joined: Thu Oct 11, 2012 1:39 pm

Song title bug and Date Added request

Post by H3X »

Wow, thank you so much for your effort and quick response! I cannot tell you how much I appreciate it!

I have noticed one bug: if the track title contains " then the scrip gives an error. This is not a major problem, as I have very few such songs. I can manually change the titles before I run the script and then correct them afterwards.

However, I do have one request: would it be possible to also sync Date Added? Specifically, once I add the tracks to MM, the Date Added is > than that of SB. This is critical for me as I have Smart Playlists that use Date Added as parameters and I don't want "old" songs to show up in these playlists. I am not sure if this property is stored in tags or the MM database though. If you can tell me where the script is located after install (I tried looking for it but can't find it, is it stored in the SQL database?) I would gladly try to make this change myself as I don't want to bother you.
Aff
Posts: 307
Joined: Sun Oct 05, 2008 4:46 pm
Location: Switzerland

Re: Import music stats from Songbird XML v1.0 2012-10-15

Post by Aff »

H3X wrote:if the track title contains " then the scrip gives an error.
Fixed :)
H3X wrote:However, I do have one request: would it be possible to also sync Date Added?
Is it in the XML? It's not in the XML generated by PlayerPro, and I don't have SongBird, so I don't know.
H3X wrote:I am not sure if this property is stored in tags or the MM database though.
In the database.
H3X wrote:If you can tell me where the script is located after install (I tried looking for it but can't find it, is it stored in the SQL database?) I would gladly try to make this change myself as I don't want to bother you.
As a VBS file in the auto folder, typically: MediaMonkey\Scripts\Auto\ImportMusicStatsXML.vbs. Good luck!
H3X
Posts: 3
Joined: Thu Oct 11, 2012 1:39 pm

Re: Import music stats from Songbird XML v1.0 2012-10-15

Post by H3X »

Yes, it is in die XML:
<mediaitem>
<last-played>1334539818678</last-played>
<date-added>1265133383465</date-added>
<artist>+44</artist>
<track>145</track>
<album>When Your Heart Stops Beating</album>
<duration>215379000</duration>
<rating>0</rating>
<play-count>35</play-count>
<skip-count>7</skip-count>
</mediaitem>

I already tired looking in that folder, it's not there. Can I copy the format you used to add the other properties to the song tags for Date Added as well? Or what is the syntax for writing to the database?
Aff
Posts: 307
Joined: Sun Oct 05, 2008 4:46 pm
Location: Switzerland

Re: Import music stats from Songbird XML v1.0 2012-10-15

Post by Aff »

You could do it similarly to the last played date.
http://www.mediamonkey.com/wiki/index.p ... :DateAdded
You could take the script from the MMIP as well, rename it to ZIP to open it.
berthoven
Posts: 1
Joined: Mon Oct 22, 2012 5:19 pm

Re: Import music stats from Songbird XML v1.0 2012-10-15

Post by berthoven »

Wow, this looks very handy. Good work.

Looking at the script begs a question:
- What happens if your library contains multiple versions of the same track ? (ie same artist, album, title)

I've spent a fair bit of time organising my library (tags, art, genres....) but until now had not worried about ratings.
Having just switched to Android (using PlayerPro) I'm suddenly wanting to use ratings as part of auto-playlists.

In my case, my MM library is made up of 3 main subsets:
[1] FLAC - ripped CDs. Great for listening at home streamed from NAS. (nicely organised and tagged, artwork but no ratings)
[2] MP3 converted from FLAC - Great for portable players etc (could potentially be re-converted if the need arose)
[3] MP3 from puchases & downloads etc

So I effectively have 2 copies of most albums in the library (one FLAC, one MP3 - kept in separate trees)
If I export stats from the Android phone back and import back into MM using this script, I guess I want to update **all** instances of the track.
That way, should I ever feel the need to delete and regenerate the MP3s from the FLACs, I wont lose all the ratings.
Aff
Posts: 307
Joined: Sun Oct 05, 2008 4:46 pm
Location: Switzerland

Re: Import music stats from Songbird XML v1.0 2012-10-15

Post by Aff »

The current version of this script would just process (update) the first matching track, this could be either the FLAC or the MP3.
It would be easily feasible to change it in order to process all matching tracks.

If you use one of the sync scripts (MSC/MTP, see first post), the auto-synced track will be processed. So if you auto-synced the MP3s, only those could be updated.

But why don't you use auto-conversion to let MM convert FLAC to MP3 on-the-fly during auto-sync? You would save hard disk space, time to tag as well as to convert and there wouldn't be any inconsistencies. If you don't have Gold, this is a feature that is worth it IMO.
skiersteve
Posts: 1
Joined: Tue Nov 27, 2012 5:52 am

Re: Import music stats from Songbird XML v1.0 2012-10-15

Post by skiersteve »

First off thanks very much for the script Aff. Came in very handy.

I too was wondering about importing the date added from Songbird, I would find this very useful as well.

Hex did you have any luck? I understand bits and pieces of the script but it would take a fair amount of time for me to be able to add this change.
Post Reply