Problem fixed.
Code: Select all
'==========================================================================
'
' MediaMonkey Script
'
' NAME: TopTracks
' DESCRIPTION: Enqueue artist tracks based on last fm charts
' VERSION: 1.0
' DATE : March 25, 2007
' AUTHOR: Teknojnky/RedX
'
' INSTALL:
' - Copy script to MM directory scripts\auto
'
' TODO:
' - configurable number of tracks to enqueue (done in script variable)
' - configurable chart (last week or 6 months)
' - configurable by popularity or randomized (done in script variable)
' - configurable enqueue next/last/default
' - configurable use selected or current playing (if a single track is selected,
' that will be used to enqueue, else the current playing track is selected)
' - configurable show status progress bar'
' - check for existing duplicate tracks in now playing'
'==========================================================================
'
Option Explicit
Dim Debug, Shuffle, MaxTracks, Status, Logging
Debug = false 'pop up message boxes'
Logging = True 'log file on/off'
Shuffle = True 'True to shuffle the list, False for popularity'
MaxTracks = 25 'max tracks to enqueue'
Status = False 'show status progress bar'
logme ""
logme "##################"
logme "Shuffle: " & Shuffle
logme "MaxTracks: " & MaxTracks
logme "Status: " & Status
logme "Debug: " & Debug
logme "##################"
Sub OnStartUp
Dim TopTracksTBB
SDB.UI.AddMenuItemSep SDB.UI.Menu_TBStandard,0,0
Set TopTracksTBB = SDB.UI.AddMenuItem(SDB.UI.Menu_TBStandard,0,0)
TopTracksTBB.Caption = SDB.Localize("Top Artist Tracks from Last.FM")
TopTracksTBB.OnClickFunc = "TopTracks"
TopTracksTBB.UseScript = Script.ScriptPath
TopTracksTBB.IconIndex = 14
' TopTracksTBB.Shortcut = "Ctrl+D"
End Sub
Sub TopTracks(TopTracksTBB)
Dim Artist, Selected, NowPlaying, Song, TopTracksList, MatchedTracks
Dim EnqueueTracks
Set EnqueueTracks = SDB.NewSongList
'find the artist of current song or current selection'
Set Selected = SDB.CurrentSongList
Set NowPlaying = SDB.Player.CurrentSong
If Selected.Count = 1 then
Set Song = Selected.Item(0)
Artist = Song.ArtistName
Else
Artist = NowPlaying.ArtistName
End If
If Debug Then msgbox ("Selected Artist: " & Artist) 'show me current artist'
'find the artist on last.fm and return the dictionary of selected list of tracks'
Set TopTracksList = GetTopTracks(Artist)
If TopTracksList is Nothing Then
Exit Sub
End If
'process list and make a playlist of it'
Set MatchedTracks = MatchTopTracks(Artist,TopTracksList)
'randomize the final list if enabled'
If Shuffle Then
Set MatchedTracks = ShuffleTopTracksList(MatchedTracks)
End If
'enqueue final list to now playing'
If MatchedTracks.count = 0 Then
If Debug Then msgbox ("Hmm didn't get any matched tracks to enqueue...")
logme "Hmm didn't get any matched tracks to enqueue..."
Else
If debug then msgbox ("Entering final enqueue")
Dim i
If MatchedTracks.count < MaxTracks Then MaxTracks = MatchedTracks.count
logme "****** final queue of " & MaxTracks
For i = 0 To MaxTracks -1
EnqueueTracks.add MatchedTracks.item(i)
logme "*** " & i+1 & ": " & EnqueueTracks.item(i).title
' logme EnqueueTracks.Item(i)
Next
If debug then
msgbox ("debug mode, enqueue disabled, check log for enqueue list")
Else
SDB.Player.PlaylistAddTracks(EnqueueTracks)
End if
End If
End Sub
Function GetTopTracks(Artist)
logme "GetTopTracks start"
'find the artist and return the track chart from last.fm'
'last.fm xml url @ http://ws.audioscrobbler.com/1.0/artist/" & Artist & "/toptracks.xml'
If Debug Then msgbox ("entering GetTopTracks()")
logme "Entering GetTopTracks()"
'query lastfm data feed
logme urlencode(artist)
Dim xmlArtistTopTracksFeedURL, xmlDoc, TopTracksDict
xmlArtistTopTracksFeedURL = "http://ws.audioscrobbler.com/1.0/artist/" & URLEncode(Artist) & "/toptracks.xml"
Dim SDB : Set SDB = CreateObject("SongsDB.SDBApplication")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set TopTracksDict = CreateObject("Scripting.Dictionary")
xmlDoc.Async = true 'false for simplicity'
xmlDoc.Load (xmlArtistTopTracksFeedURL)
Do While xmlDoc.readyState <> 4
SDB.ProcessMessages
loop
If xmlDoc.readyState = 4 Then 'hhtp return code for ok :)
If Debug then msgbox ("artist top tracks feed loaded")
logme "TopTracksFeed loaded successfully"
'let's make this a playlist
'Set TopTracksDict = SDB.NewSongList
Dim ele,TrackTitle,count
count = 0
For Each ele In xmlDoc.getElementsByTagName("name")
TrackTitle = ele.ChildNodes.Item(0).Text
'If debug then msgbox ("Top Track " & count & ": " & TrackTitle)
logme "tracktitle:" & TrackTitle
If Not TopTracksDict.Exists(TrackTitle) And InDB(artist,TrackTitle,True)=True Then
TopTracksDict.Add count, TrackTitle
'removed this count so the dict gets filled up completely with the results'
' If count = MaxTracks-1 Then
' Exit For
' End if
count = count+1
End If
Next
Set GetTopTracks = TopTracksDict
logme "toptracksdict"
Dim i
For i =0 To TopTracksDict.Count -1
logme TopTracksDict.item(i)
Next
logme "GetTopTracks exit good"
Exit Function
Else
'If Debug then msgbox ("artist top tracks feed FAILED to load")
'other failure stuff from http://msdn2.microsoft.com/en-us/library/aa468547.aspx'
Dim strErrText ' as Text
Dim xPE ' as MSxml.ixmlDOMParseError
Set xPE = xmlDoc.ParseError
With xPE
strErrText = "Your XML Document failed to load " & _
"due the following error." & vbCrLf & _
"Error #: " & .errorCode & ": " & xPE.reason & _
"Line #: " & .Line & vbCrLf & _
"Line Position: " & .linepos & vbCrLf & _
"Position In File: " & .filepos & vbCrLf & _
"Source Text: " & .srcText & vbCrLf & _
"Document URL: " & .url & vbCrLf & _
"Status: " & xmlDoc.status
End With
MsgBox strErrText, vbExclamation
Set GetTopTracks = nothing
logme "GetTopTracks exit bad"
End If
End Function
Function MatchTopTracks(Artist, TopTracksList)
'match up the last.fm track chart dictionary to available local library tracks'
if debug then msgbox ("entering MatchTopTracks()")
logme "Entering MatchTopTracks()"
Set MatchTopTracks = SDB.NewSongList
' semi-psuedocode
' loop thru TopTrackList until EOF or MaxTracks is reached
' QueryMatch = SDB.Database.QuerySongs ("AND Songs.ArtistName = Artist AND Songs.Title = TopTracksList.item")
' AddTrack(MatchTopTracks(QueryMatch.item)
' Next
Dim j,i: i=0:j=0
Dim QueryMatch:QueryMatch = ""
logme "toptrackslist.count:" & toptrackslist.count
For j= 0 To TopTracksList.count
Set QueryMatch = SDB.Database.QuerySongs ("AND (Artists.Artist LIKE '"&CorrectSt(Artist) & "' AND( Songs.songtitle LIKE '"& CorrectSt(TopTracksList.item(j)) & "'))")
if Not QueryMatch.EOF Then 'removed so that whole dict is processed >>>> and i <= MaxTracks '
If IsAccessible(QueryMatch.item) Then
MatchTopTracks.Add (QueryMatch.Item)
i = i + 1
End If
End if
Next
logme "MatchTopTracks exit"
End Function
Function ShuffleTopTracksList (TracksList)
'if enabled, shuffle the current toptrackslist'
if debug then msgbox ("entering ShuffleTopTracksList()")
logme "ShuffleTopTracksList() start"
Dim i,j,temp: Set temp = SDB.NewSongList
Dim alreadyused
logme "Trackslist"
For i=0 To trackslist.count-1
logme " " & trackslist.item(i).title
Next
Randomize Timer
If Debug Then MsgBox "trackslist.count:" & trackslist.count
For i=TracksList.count-1 To 0 Step -1
'Do
j=Int((trackslist.count-1) * Rnd)
temp.add trackslist.item(j)
trackslist.delete j
Next
logme "Temp"
For i = 0 to temp.count-1
logme " " & temp.item(i).title
Next
Set ShuffleTopTracksList = temp
logme "ShuffleTopTracksList() exit"
End Function
Function IsAccessible(SongObj)
logme "* IsAccessible has started for song (" & SongObj.ID & ") " & SongObj.ArtistName & " - " & SongObj.Title
If SongObj Is Nothing Then
If Debug Then MsgBox "SongObj was empty"
Exit Function
End If
If (Left(SongObj.Path, 1) <> "?") Or (SongObj.Cached) Then
IsAccessible = True
Else
IsAccessible = False
End If
'If Debug Then MsgBox "Isaccesible: " & IsAccessible & " " &songobj.title
logme "* IsAccessible will return " & IsAccessible & " and exit"
End Function
'This function checks if a track exists in the db and also checks if is accessible
Function InDB(Artist,SongTitle,CheckAccess)
logme "InDB start:" & artist & "-" & songtitle
InDB = False
Dim SQL
If artist <> "" Then
SQL = " AND Artists.Artist = '" & CorrectSt(artist) & "' "
End If
If Songtitle = "" Then
MsgBox "No track title specified!"
Exit Function
End If
If SQL <> "" Then
SQL = SQL & " AND songs.songtitle like '" & CorrectSt(songtitle) & "'"
Else
SQL = " AND songs.songtitle like '" & CorrectSt(songtitle) & "'"
End If
'only do for 1 item!
Dim QueryMatch
Set QueryMatch = SDB.Database.QuerySongs (SQL)
if Not QueryMatch.EOF Then
If checkaccess = True Then
If IsAccessible(QueryMatch.item) Then
InDB = True
logme "InDB exit:" & Indb
Exit Function
End If
Else
InDB = True
logme "InDB exit:" & Indb
Exit Function
End If
Else
logme " track not in DB:" & artist & "-" & songtitle
End If
InDB = False
End Function
Sub logme(msg)
If Logging Then
Dim fso, logf
Set fso = CreateObject("Scripting.FileSystemObject")
Set logf = fso.OpenTextFile(Script.ScriptPath&".log",8,True)
logf.WriteLine Now() & ": " & msg
Set fso = Nothing
Set logf = Nothing
End If
End Sub
Function CorrectSt(inString)
logme "* CorrectSt has started with parameters " & inString
CorrectSt = Replace(inString, "'", "''")
logme "* CorrectSt will return " & CorrectSt & " and exit"
End Function
Public Function URLEncode(sRawURL)
logme "* URLEncode has started with parameters " & sRawURL
Dim iLoop, sRtn, sTmp
Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\/&:"
Const sEscapeChars = "\/&:"
If Len(sRawURL) > 0 Then
' Loop through each char
iLoop = 1
Do While iLoop < Len(sRawURL)+1
sTmp = Mid(sRawURL, iLoop, 1)
'MsgBox sTmp
If InStr(1, sValidChars, sTmp, vbBinaryCompare) = 0 Then
' If not ValidChar, convert to HEX and p
' refix with %
sTmp = Hex(Asc(sTmp))
If sTmp = "20" Then
sTmp = "+"
ElseIf Len(sTmp) = 1 Then
sTmp = "%0" & sTmp
Else
sTmp = "%" & sTmp
End If
ElseIf InStr(1, sEscapeChars, sTmp, vbBinaryCompare) >0 Then
Select Case sTmp
Case "&"
sTmp = "%2526"
Case "/"
sTmp = "%252F"
Case "\"
sTmp = "%5C"
Case ":"
sTmp = "%3A"
End Select
End If
sRtn = sRtn & sTmp
' MsgBox sRtn
iLoop = iLoop +1
Loop
URLEncode = sRtn
End If
logme "* URLEncode will return " & sRtn & " and exit"
End Function