This script adds a Similar Artist Node to the Main Node which is feeded by Last.FM. If you select the Now Playing SubNode, the Script checks Last.FM similar artists and displays the result in the MainWindow of MediaMonkey. You have all the possibilities MediaMonkey gives you to manipulate the presentation of the results. Look at the image to see a small example
I have to thank trixmoto for some code snippest i use.
What i am planing to do in the (near) future with this script is
- get rid of occuring errors
- build in a possibility to change to Selectet Track Mode
- Write the Last.FM Infos to a local Database (only if LastFMs allows this?)
- Add an Offline Modus where the Infos come from the local Database, so you can carry them from party to party
Some Question to experienced Scripters :
I am not really satisfied with
a) The loading of the xml File, shouldn´t be there something like a Timeout?
b) All this Redim of Arrays cost performance, right?
To install this Script create a File "SimilarArtistNode.vbs" in your MediaMonkey\Scripts\Auto folder and past & copy the Code in this file.
Be sure to backup your Database as long as this is in a development state ! I won´t be responsible for losing your data. Even this doesn´t happen on my machine.
Code: Select all
'------------------------------------------------------------------------------
'Creates a SimilarArtist Node which is feeded by Last.FM
'Version: 0.5
'Date: 10/10/2007
'
'Known Issues :
' ** Don´t know what to do if Last.FM is unreachable -> Build in a Timeout
' ** If the Script falls the TempTable is not deleted -> check if it exist
' **
'ToDo in the near Future
'**Build in a possibility to change to Selectet Track Mode
'**Write the Last.FM Infos to a local Database
'**Add an Offline Modus where the Infos come from the local Database, so you can carry them from party to party :)
'**Not really satisfied with all this Redim of Arrays ->??
'**I have to thank the other Scripters for their CodeSnipetts
'------------------------------------------------------------------------------
' Writes some DebugInfos into Scriptpath.SimilarNode.log
Public Debug : Debug = False
'Number of Similart Artists
Public max : max = 10
Sub OnStartup
If Debug Then Logme("* Entering OnStartup Sub *")
'Adds the Node(s)
Dim Tree : Set Tree = SDB.MainTree
Dim Node : Set Node = Tree.CreateNode
Node.Caption = "Simliar Artists"
Node.IconIndex = 49
Node.NodeType = 12
Tree.AddNode Tree.Node_Library, Node, 1
Node.HasChildren = True
Set Subnode = Tree.CreateNode
Subnode.Caption = "Now Playing"
Subnode.IconIndex = 10
Subnode.UseScript = Script.ScriptPath
SubNode.OnFillTracksFunct = "AddTracks"
'Try
SubNode.CustomNodeID=451
Tree.AddNode Node, Subnode, 3
Subnode.HasChildren = False
'Fires an Event at Songchange
Script.RegisterEvent SDB, "OnPlay", "SDBPlay"
End Sub
Sub AddTracks(node)
If Debug Then logme("** Entering AddTracks Sub **")
Dim currArtist
currArtist = SDB.Player.CurrentSong.ArtistName
If Debug Then Logme("*** CurentArtist: " & currArtist)
'A trick to reset any added sortorder to the tracks in Main window
SDB.MainTree.CurrentNode.NodeType = 12
SDB.MainTracksWindow.Refresh
SDB.MainTree.CurrentNode.NodeType = 255
Dim Trcks,sql
Set Trcks = SDB.MainTracksWindow
'creates an Temporary Table
SDB.Database.ExecSQL ("CREATE TABLE tmpIds (IdSong integer unique)")
Dim SimilarArtists
SimilarArtists = GetSimilarTo(currArtist)
If Not SimilarArtists(0) = "" Then
'Saves all Entries from the Array in the TempTable
For each Artist in SimilarArtists
sql =" SELECT ID FROM Songs WHERE Songs.Artist ='"& FixSQL(Artist) &"'"
SDB.Database.ExecSQL ("INSERT INTO tmpIds (IdSong) "& sql)
Next
End If
'Shows the TempTable in the MainTrack Window
Trcks.AddTracksFromQuery("WHERE Songs.ID in (Select IdSong FROM tmpIds)")
Trcks.FinishAdding
'Deletes the TempTable
SDB.Database.ExecSQL ("DROP TABLE tmpIds")
End Sub
Function GetSimilarTo(Artist)
'Online Version gets Infos from Last.FM
If Debug Then LogMe("**** Entering GetSimilarTo ****")
Set xml = CreateObject("Microsoft.XMLDOM")
Dim artists()
Redim artists(0)
xml.async = False
Dim strUrl
strUrl = "http://ws.audioscrobbler.com/1.0/artist/"&fixurl(SDB.Player.CurrentSong.ArtistName)&"/similar.xml"
If Debug Then LogMe("URL : " & strURl)
If xml.Load(strURl) Then
Dim z
If xml.readyState = 4 Then
Dim ele
For Each ele In xml.getElementsByTagName("artist")
Redim Preserve artists(z)
artists(z) = ele.ChildNodes.Item(0).Text
z=z+1
if z = max Then Exit For
Next
End If
Else
If Debug Then LogMe("There is a Problem with Last.FM : " + SDB.Player.CurrentSong.ArtistName)
End If
If Debug Then
Dim strTemp : strTemp = "Found : "
For z=0 To ubound(artists) -1
strTemp= strTemp+artists(z)+";"
next
LogMe(strTemp)
End if
GetsimilarTo = artists
Set XML = Nothing
End Function
Sub SDBPlay
If sdb.MainTree.CurrentNode.CustomNodeID=451 Then
'If sdb.MainTree.CurrentNode.Caption="Now Playing" Then
AddTracks(sdb.MainTree.CurrentNode)
End if
End Sub
Sub LogMe(text)
' Logs Information
Dim fso, logf
Dim strFilePath, strPath, strFile
Dim intPos
strFilePath = Script.Scriptpath
intPos = InStrRev(strFilePath,"\")
strPath = Left(strFilePath, intPos)
strFile = Mid(strFilePath, intPos+1)
Set fso = CreateObject("Scripting.FileSystemObject")
Set logf = fso.OpenTextFile(strPath & "SimilarArtistNode.log",8,True)
logf.WriteLine text
Set fso = Nothing
Set logf = Nothing
End Sub
Function fixsql(name)
'Thanks to trixmoto
fixsql = Replace(name,"'","''")
fixsql = Replace(fixsql,"[","[[]")
fixsql = Replace(fixsql,"*","[*]")
fixsql = Replace(fixsql,"%","[%]")
End Function
Function fixurl(sRawURL)
'Thanks to trixmoto
Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\/&:'"
sRawURL = Replace(sRawURL,"+","%2B")
If Len(sRawURL) > 0 Then
Dim i : i = 1
Do While i < Len(sRawURL)+1
Dim s : s = Mid(sRawURL,i,1)
If InStr(1,sValidChars,s,0) = 0 Then
Dim d : d = Asc(s)
If d = 32 Or d > 2047 Then
s = "+"
Else
If d < 128 Then
s = DecToHex(d)
Else
s = DecToUtf(d)
End If
End If
Else
Select Case s
Case "&"
s = "%2526"
Case "/"
s = "%252F"
Case "\"
s = "%5C"
Case ":"
s = "%3A"
Case "'"
s = "%27"
End Select
End If
fixurl = fixurl&s
i = i + 1
Loop
End If
If UCase(Right(fixurl,6)) = " (THE)" Then
fixurl = "The "&Left(fixurl,Len(fixurl)-6)
End If
If UCase(Right(fixurl,5)) = ", THE" Then
fixurl = "The "&Left(fixurl,Len(fixurl)-5)
End If
End Function
Function DecToHex(d)
'Thanks to trixmoto
If d < 16 Then
DecToHex = "0"&CStr(Hex(d))
Else
DecToHex = CStr(Hex(d))
End If
End Function
Function DecToUtf(d)
'Thanks to trixmoto
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 DecToBin(intDec)
'Thanks to trixmoto
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 BinToHex(strBin)
'Thanks to trixmoto
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