by Aff » Fri Oct 12, 2012 9:03 pm
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
[size=150][b]What is it about?[/b][/size]
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).
[b]If you are looking for device sync, please use [url=http://www.mediamonkey.com/forum/viewtopic.php?f=2&t=59888]Sync back ratings & play counts (MSC)[/url] (or [url=http://www.mediamonkey.com/forum/viewtopic.php?f=2&t=68076]Sync stats for Android PlayerPro XML (MTP)[/url]) instead![/b]
[size=150][b]How does it work?[/b][/size]
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.
[size=150][b]Instructions[/b][/size]
Download and execute the installation package [size=120][b][url=http://www.ber-sd.com/ImportMusicStatsXML.mmip]ImportMusicStatsXML.mmip[/url][/b][/size]
"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.
[size=150][u]Updates or Uninstall[/u][/size]
To update or uninstall, go to menu Tools->Extensions.
[size=150]Source Code (ImportMusicStatsXML.vbs)[/size]
[code]'----------------------------------------------------------------------------------------------------------------
' 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
[/code]
[size=150][b]History[/b][/size]
0.1 (2012-10-13)
- Initial release
1.0 (2012-10-15)
- Detailed reports
- Quotation marks allowed in names