This script has been tested on MM4 only, but should work on MM3 as well. As per usual, the installation package can be downloaded from my website. The code is below if you're interested...
Code: Select all
'
' MediaMonkey Script
'
' NAME: NapsterTagger 1.0
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 03/09/2011
'
' INSTALL: Copy to Scripts\Napster directory along with the images, then add the following to Scripts.ini
' Don't forget to remove comments (') and set the order appropriately
'
' [NapsterTagger]
' FileName=Napster\NapsterTagger.vbs
' ProcName=NapsterTagger
' Order=30
' DisplayName=Napster Tagger
' Description=Tag albums using Napster
' Language=VBScript
' ScriptType=3
'
Option Explicit
Dim Debug : Debug = False
Dim api : api = "FSeYcEPTiVTvlSaFnWch"
Dim cod : cod = "GB" 'CA=Canada, DE=Germany, GB=United Kingdom, JP=Japan, US=United States
Dim ids : Set ids = SDB.NewStringList
Sub StartSearch(Panel,SearchTerm,SearchArtist,SearchAlbum)
'initialise
If Debug Then
Call clear()
Call out("StartSearch(Panel,"""&SearchTerm&""","""&SearchArtist&""","""&SearchAlbum&""")")
End If
'build display
Dim WB : Set WB = SDB.UI.NewActiveX(Panel,"Shell.Explorer")
WB.Common.Align = 5
WB.Common.ControlName = "WB"
WB.Common.BringToFront
Set SDB.Objects("Napster-WB") = WB
'create session
Dim xml : Set xml = SendQuery("createSession","")
If xml Is Nothing Then
Exit Sub
End If
Dim sss : sss = GetText(xml,"sessionKey")
If sss = "" Then
Exit Sub
End If
SDB.IniFile.StringValue("NapsterTagger","Session") = sss
'perform search
Set xml = SendQuery("search/albums","maxResults=100&searchTerm="&FixUtf8(Replace(SearchAlbum," ","+")))
If xml Is Nothing Then
Exit Sub
End If
Dim res : Set res = SDB.NewStringList
Dim ele : Set ele = Nothing
For Each ele In xml.getElementsByTagName("album")
Dim nam : nam = GetText(ele,"artistName")
If nam = "" Then
nam = GetText(ele,"name")
Else
nam = nam&" - "&GetText(ele,"name")
End If
Dim dat : dat = GetText(ele,"releaseDate")
If Not (dat = "") Then
nam = nam&" ("&Left(dat,4)&")"
End If
Call res.Add(nam)
Call ids.Add(GetText(ele,"id"))
Next
'show results
If res.Count = 0 Then
Call res.Add(SearchAlbum)
End If
Call SDB.Tools.WebSearch.SetSearchResults(res)
SDB.Tools.WebSearch.ResultIndex = 0
End Sub
Sub ShowResult(i)
If Debug Then Call out("ShowResult("&i&")")
If (i > -1) And (i < ids.Count) Then
Call SDB.Tools.WebSearch.ClearTracksData()
Dim WB : Set WB = SDB.Objects("Napster-WB")
If Not (WB Is Nothing) Then
Dim xml : Set xml = SendQuery("albums/"+ids.Item(i),"")
If Not (xml Is Nothing) Then
Dim j : j = 0
Dim res : Set res = SDB.NewStringList
Dim ele : Set ele = Nothing
For Each ele In xml.getElementsByTagName("track")
Call res.Add(GetText(ele,"trackName"))
Next
Dim art : art = GetText(xml,"artistName")
Dim alb : alb = GetText(xml,"name")
Dim dat : dat = Left(GetText(xml,"releaseDate"),4)
Dim lab : lab = GetText(xml,"label")
Dim img : img = "http://connect.napster.com/rest/1.2/images/album/"+ids.Item(i)+"/coverArt?format=xml&explicit=Y&countryCode="&cod
img = img&"&imageSize=IMG_600_600&sessionKey="&SDB.IniFile.StringValue("NapsterTagger","Session")
'display details
Dim htm : htm = "<html><body bgcolor=""#3044B5""><style type=""text/css"">"
htm = htm&".tabletext{font-family:Arial,Helvetica,sans-serif;font-size:8pt;}</style>"
htm = htm&"<table width=""100%"" border=""1"" cellpadding=""0"" cellspacing=""0"" bordercolor=""#777772"" bgcolor=""#3044B5"">"
htm = htm&"<tr><td><table width=""100%"" cellpadding=""0"" cellspacing=""0"" bgcolor=""#FFFFFF""><tr><td>"
htm = htm&"<table width=""100%"" cellspacing=""0"" cellpadding=""0""><tr><td bgcolor=""#61BB47"">"
htm = htm&"<table width=""100%"" cellspacing=""2"" cellpadding=""2"" class=""tabletext""><tr><td>"
htm = htm&"<input type=""checkbox"" id=""album"" checked=""checked"" style=""display:none"" />Album: "&alb&"<br />"
htm = htm&"<input type=""checkbox"" id=""artist"" checked=""checked"" style=""display:none"" />Artist(s): "&art
htm = htm&"</td></tr></table></td><td bgcolor=""#61BB47"">"
htm = htm&"<table width=""100%"" cellspacing=""2"" cellpadding=""2"" class=""tabletext""><tr><td>"
htm = htm&"<input type=""checkbox"" id=""year"" checked=""checked"" style=""display:none"" />Release: "&dat&"<br />"
htm = htm&"<input type=""checkbox"" id=""label"" checked=""checked"" style=""display:none"" />Label: "&lab
htm = htm&"</td></tr></table></td></tr><tr><td valign=""top"">"
htm = htm&"<table width=""100%"" cellspacing=""2"" cellpadding=""2"" class=""tabletext""><tr><td valign=""top"">"
htm = htm&"<input type=""checkbox"" id=""cover"" checked=""checked"" style=""display:none"" />Cover:<br />"
htm = htm&"<img id=""coverimg"" src="""&img&""" border=""0"" /><br /></td></tr></table></td><td valign=""top"">"
htm = htm&"<table width=""100%"" cellspacing=""2"" cellpadding=""2"" class=""tabletext""><tr><td valign=""top"">"
htm = htm&"<img src=""http://trixmoto.net/files/napster.jpg"" border=""0"" align=""right"" /></td></tr><tr><td valign=""top"">"
htm = htm&"<input type=""checkbox"" id=""tracks"" checked=""checked"" style=""display:none"" />Tracks:<br />"
For j = 0 To res.Count-1
htm = htm&(j+1)&". "&res.Item(j)&"<br />"
Next
htm = htm&"</td></tr></table></td></tr></table></td></tr></table></td></tr></table></body></html>"
Call WB.SetHTMLDocument(htm)
'update tracks
If res.Count > 0 Then
Dim WS : Set WS = SDB.Tools.WebSearch
Dim NT : Set NT = WS.NewTracks
Dim max : max = NT.Count-1
For j = 0 To max
Dim itm : Set itm = NT.Item(j)
itm.ArtistName = art
itm.AlbumName = alb
itm.Year = dat
itm.Publisher = lab
Next
WS.AlbumArtURL = img
Call WS.SmartUpdateTracks(res)
Call WS.RefreshViews()
End If
End If
End If
End If
End Sub
Sub FinishSearch(Panel)
If Debug Then Call out("FinishSearch(Panel)")
Dim WB : Set WB = SDB.Objects("Napster-WB")
If Not (WB Is Nothing) Then
Call WB.Common.DestroyControl()
Set WB = Nothing
End If
Set SDB.Objects("Napster-WB") = Nothing
Set ids = SDB.NewStringList
End Sub
Sub clear()
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim loc : loc = SDB.TemporaryFolder
If Right(loc,1) = "\" Then
loc = loc&"Napster.log"
Else
loc = loc&"\Napster.log"
End If
Dim logf : Set logf = fso.CreateTextFile(loc,True)
Call logf.Close()
End Sub
Sub out(txt)
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim loc : loc = SDB.TemporaryFolder
If Right(loc,1) = "\" Then
loc = loc&"Napster.log"
Else
loc = loc&"\Napster.log"
End If
Dim logf : Set logf = fso.OpenTextFile(loc,8,True)
Call logf.WriteLine(Time&Chr(9)&SDB.ToAscii(txt))
Call logf.Close()
End Sub
Sub Install()
Dim inip : inip = SDB.ScriptsPath&"Scripts.ini"
Dim inif : Set inif = SDB.Tools.IniFileByPath(inip)
If Not (inif Is Nothing) Then
inif.StringValue("NapsterTagger","Filename") = "Napster\NapsterTagger.vbs"
inif.StringValue("NapsterTagger","Procname") = "NapsterTagger"
inif.StringValue("NapsterTagger","Order") = "30"
inif.StringValue("NapsterTagger","DisplayName") = "Napster Tagger"
inif.StringValue("NapsterTagger","Description") = "Tag albums using Napster"
inif.StringValue("NapsterTagger","Language") = "VBScript"
inif.StringValue("NapsterTagger","ScriptType") = "3"
Call SDB.RefreshScriptItems()
End If
' Dim ini : Set ini = SDB.IniFile
' Dim s : s = ini.StringValue("AlbumBrowser","RunningScriptName")
' If Not (s = "Napster\NapsterTagger.vbs") Then
' s = "Napster Tagger: Would you like to make this your default 'Auto-tag from Web' source?"
' Dim i : i = SDB.MessageBox(s,mtConfirmation,Array(mbYes,mbNo))
' If i = mrYes Then
' ini.StringValue("AlbumBrowser","RunningScriptName") = "Napster\NapsterTagger.vbs"
' Call ini.Flush()
' End If
' End If
End Sub
Function SendQuery(ope,par)
Dim url : url = ""
Dim req : req = ""
If ope = "createSession" Then
url = "https://connect-ssl.napster.com/rest/1.2/security/createSession?format=xml&explicit=Y&countryCode="&cod
url = url&"&apiKey="&api&"&deviceId="&GetMAC()
Else
url = "http://connect.napster.com/rest/1.2/"&ope&"?format=xml&explicit=Y&countryCode="&cod
url = url&"&sessionKey="&SDB.IniFile.StringValue("NapsterTagger","Session")
If Not (par = "") Then
url = url&"&"&par
End If
End If
If Debug Then Call out("@"&url)
Dim xml : Set xml = CreateObject("Microsoft.XMLHTTP")
Call xml.open("GET",url,true)
Call xml.Send()
Dim cnt : cnt = 0
While (xml.readyState < 4) And (cnt < 300)
Call SDB.Tools.Sleep(100)
SDB.ProcessMessages
cnt = cnt+1
WEnd
If Not (xml.readyState = 4) Then
If Debug Then Call out("@ReadyState="&xml.readyState)
Set SendQuery = Nothing
Else
If Not (xml.status = 200) Then
If Debug Then
Call out("@StatusCode="&xml.status)
Call out("@StatusText="&xml.statusText)
Call out("@ResponseText="&xml.responseText)
End If
Set SendQuery = Nothing
Else
Dim str : str = xml.responseText
Set xml = CreateObject("Microsoft.XMLDOM")
Call xml.LoadXML(str)
If Not (xml.parseError.errorCode = 0) Then
If Debug Then
Call out("@ErrorCode="&xml.parseError.errorCode)
Call out("@ErrorMess="&xml.parseError.reason)
Call out("@ErrorLine="&xml.parseError.line)
Call out("@ErrorChar="&xml.parseError.linepos)
Call out("@ErrorText="&xml.parseError.srcText)
End If
Set SendQuery = Nothing
Else
Set SendQuery = xml
End If
End If
End If
End Function
Function GetText(xml,tag)
GetText = ""
If Not (xml Is Nothing) Then
If Not (tag = "") Then
Dim ele : Set ele = xml.getElementsByTagName(tag).Item(0)
If Not (ele Is Nothing) Then
GetText = Replace(ele.Text,"&","&")
End If
End If
End If
End Function
Function FixUtf8(sRawURL)
Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
If Len(sRawURL) > 0 Then
Dim i : i = 1
Dim url : url = sRawURL
Do While i < Len(url)+1
Dim s : s = Mid(url,i,1)
If InStr(1,sValidChars,s,0) = 0 Then
Dim d : d = AscW(s)
If d > 65536 Then
s = "%5F"
Else
If d < 128 Then
s = DecToHex(d)
ElseIf d < 2048 Then
s = DecToUtf(d)
Else
s = DecToUtf2(d)
End If
End If
End If
FixUtf8 = FixUtf8&s
i = i + 1
Loop
End If
End Function
Function HexToDec(h)
HexToDec = 0
Dim i : i = 0
For i = Len(h) To 1 Step -1
Dim d : d = Mid(h,i,1)
d = Instr("0123456789ABCDEF",UCase(d))-1
If d >= 0 Then
HexToDec = HexToDec+(d*(16^(Len(h)-i)))
Else
HexToDec = 0
Exit For
End If
Next
End Function
Function DecToBin(intDec)
DecToBin = ""
Dim d : d = intDec
Dim e : e = 1024
While e >= 1
If d >= e Then
d = d - e
DecToBin = DecToBin&"1"
Else
DecToBin = DecToBin&"0"
End If
e = e / 2
Wend
End Function
Function DecToBin2(intDec)
DecToBin2 = ""
Dim d : d = intDec
Dim e : e = 65536
While e >= 1
If d >= e Then
d = d - e
DecToBin2 = DecToBin2&"1"
Else
DecToBin2 = DecToBin2&"0"
End If
e = e / 2
Wend
End Function
Function BinToHex(strBin)
Dim d : d = 0
Dim i : i = 0
For i = Len(strBin) To 1 Step -1
Select Case Mid(strBin,i,1)
Case "0"
'do nothing
Case "1"
d = d + (2^(Len(strBin)-i))
Case Else
BinToHex = "00"
Exit Function
End Select
Next
BinToHex = DecToHex(d)
End Function
Function DecToHex(d)
If d < 16 Then
DecToHex = "%0"&CStr(Hex(d))
Else
DecToHex = "%"&CStr(Hex(d))
End If
End Function
Function DecToUtf(d)
Dim b : b = DecToBin(d)
Dim a : a = "110"&Left(b,5)
b = "10"&Mid(b,6)
DecToUtf = BinToHex(a)&BinToHex(b)
End Function
Function DecToUtf2(d)
Dim b : b = DecToBin2(d)
Dim a : a = "1110"&Left(b,4)
Dim c : c = "10"&Mid(b,11,6)
b = "10"&Mid(b,5,6)
DecToUtf2 = BinToHex(a)&BinToHex(b)&BinToHex(c)
End Function
Function GetMAC()
GetMAC = ""
Dim wsh : Set wsh = CreateObject("WScript.Shell")
Dim str : str = wsh.ExpandEnvironmentStrings("%COMPUTERNAME%")
If Not (str = "") Then
Dim wmi : Set wmi = GetObject("winmgmts:\\"&str&"\root\cimv2")
Dim col : Set col = wmi.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
Dim itm : Set itm = Nothing
For Each itm In col
GetMAC = itm.MACAddress
Next
End If
End Function