ScrobblerDJ v1.26, Let your music free!!!

sh1kar1 · Post by **sh1kar1** » Sun Jan 30, 2011 1:09 am

WHOA!

This is Awesome! THNX MAN!

DKazona · Post by **DKazona** » Sun Jan 30, 2011 1:17 pm

I keep getting the error: ScrobblerDJ: Could not locate artist on Last.FM.

nohitter151 · Post by **nohitter151** » Sun Jan 30, 2011 1:46 pm

DKazona wrote:I keep getting the error: ScrobblerDJ: Could not locate artist on Last.FM.

This addon is several years old and doesn't work anymore - it was designed for use with MM2.

Wop · Post by **Wop** » Mon Jan 31, 2011 6:37 am

nohitter151 wrote:
DKazona wrote:I keep getting the error: ScrobblerDJ: Could not locate artist on Last.FM.
This addon is several years old and doesn't work anymore - it was designed for use with MM2.

Is there something simmilar?

nohitter151 · Post by **nohitter151** » Mon Jan 31, 2011 9:55 am

Wop wrote:
nohitter151 wrote:
DKazona wrote:I keep getting the error: ScrobblerDJ: Could not locate artist on Last.FM.
This addon is several years old and doesn't work anymore - it was designed for use with MM2.

Is there something simmilar?

http://www.mediamonkey.com/forum/viewto ... st.fm+node

rmatiazo · Post by **rmatiazo** » Tue Mar 15, 2011 6:18 pm

hi all, after spend a few years just reading the forums i want to give a little contribution, without know the Last.Fm Node script i fixed this script. Seems that the DB model changed from MM2 to MM3 and i had to adjust a few things to run properly again.

I know that someone came up with a better and new script and the feature is kind of duplicated but i'm publishing the fix anyway. Thanks!

Fixed script:

Code: Select all

Option Explicit

' Public SDB
' Set SDB = CreateObject("SongsDB.SDBApplication")

Public TimerLoop, LineText, Line, Tmr, iArtist, iTitle, iID, defPlaylist, dummy
Public xmlDoc, DTmr, DownLoop, Timeout, Mode, InfoTime, MinLastPlayed, SQLRat, RatCond, RatingCl
Public MinMatch, WarningTimeOut, MinRating, IncludeHigherRating, IncludeUnknownRating, Artist, DebugSt
Public CurLocale

' Locale settings
CurLocale = GetLocale()
SetLocale(1033)			'Change locale to the one served by LAST.FM (US English)
        
Mode = 1
dummy = 0
TimerLoop = 0
DownLoop = 0
LineText = "Scrobbler DJ: Querying Last.FM..."
'==========================================================================
' Next Lines should not be edited anymore as there is an options Dialog to do that
defPlaylist = SDB.IniFile.StringValue("ScrobblerDJ", "DefaultPlaylist")
Timeout = SDB.IniFile.IntValue("ScrobblerDJ", "Timeout") * 2
InfoTime = SDB.IniFile.IntValue("ScrobblerDJ", "InfoTime") * 2
MinLastPlayed = SDB.IniFile.IntValue("ScrobblerDJ", "MinLastPlayed")
MinMatch = SDB.IniFile.IntValue("ScrobblerDJ", "MinMatch")
WarningTimeOut = SDB.IniFile.IntValue("ScrobblerDJ", "WarningTimeout")
MinRating = SDB.IniFile.IntValue("ScrobblerDJ", "MinRating")
IncludeHigherRating = SDB.IniFile.BoolValue("ScrobblerDJ", "IncludeHigherRating")
IncludeUnknownRating = SDB.IniFile.BoolValue("ScrobblerDJ", "IncludeUnknownRating")
DebugSt = SDB.IniFile.BoolValue("ScrobblerDJ", "Debug")
'==========================================================================

logme "---------------------------------------------------------------------------------------"
logme "User options are:"
logme "Default playlist: " & defPlaylist
logme "Timeout Settings: " & Timeout & ", Warn: " & WarningTimeOut
logme "Dont play same artist: " & MinLastPlayed
logme "Minimun match: " & MinMatch
logme "Minimum Rating: " & MinRating
logme "Include Higher Rating: " & IncludeHigherRating
logme "Include Unknown Rating: " & IncludeUnknownRating
logme "Locale: " & CurLocale
logme "<<<<<<<<<<<<<< Script Will now Proceed >>>>>>>>>>>>>>>>>"



Sub ProgTimer(Timer)

    Line.Text = LineText
    TimerLoop = TimerLoop + 1

    If TimerLoop >= InfoTime Then
        Script.UnregisterEvents Tmr
        Script.UnRegisterAllEvents
        logme "* ProgTimer Unregistered by itself (also unregistered all events..."
        Set iArtist = Nothing
        Set iTitle = Nothing
        Set Line = Nothing
    End If
End Sub

Sub DownTimer(Timer)
'Downloading status check
    DownLoop = DownLoop + 1
    TimerLoop = 0

    If xmlDoc.readyState = 4 Then
        Script.UnregisterEvents DTmr
        logme "* DownTimer Unregistered by itself (results from Last.FM returned succesfully)"
        DownLoop = 0
        logme "** Downtime is calling sub last artist in mode: " & Mode
        LastArtist Mode
    End If
    If DownLoop >= Timeout Then
        logme "* Downtimer reported Network connectivity error. Scrobbler will now exit"

        If WarningTimeOut Then
            Script.UnregisterAllEvents
            SDB.MessageBox "Request Timed Out", mtError, Array(mbOK)
        Else
            LineText = "Scrobbler DJ: Could not access Last.FM, check network connectivity or Last.FM web page status :-( .... ScrobblerDJ will add a track from the default playlist"
            Line.Text = LineText
            TimerLoop = 0
        End If
    End If
End Sub

Sub ScrobblerDJ()
    logme "* ScrobblerDJ started"
    'This is the procedure that is called everytime a playback starts...
    'check its switched On
    Dim str
    str = SDB.IniFile.StringValue("ScrobblerDJ", "Enabled")
    If Not str = "1" Then
        logme "ScrobblerDJ is disabled"
        logme "* ScrobblerDJ exited"

        Exit Sub
    End If
    'check its the last song
    Dim ind, tot
    ind = SDB.Player.CurrentSongIndex + 1
    tot = SDB.Player.CurrentSongList.Count
    If ind < tot Then
        logme "Playlist hasn't reached the last song"
        logme "* ScrobblerDJ exited"

        Exit Sub
    End If

    'Check if default playlist exits(to avoid endless loop and access errors)
    Dim CheckPlaylist
    Set CheckPlaylist = SDB.PlaylistByTitle(defPlaylist)

    If CheckPlaylist.ID = 0 Then
        SDB.MessageBox "The default playlist doesn't exists. ScrobblerDJ will now exit", mtError, Array(mbOK)
        logme "** ScrobblerDJ reported Default playlist error. ScrobblerDJ will now exit"
        TerminateMe
        Set CheckPlaylist = Nothing
        logme "* ScrobblerDJ exited"
        Exit Sub
    Else
        Set CheckPlaylist = Nothing
    End If

    logme "** All conditions met, Scrobbler will now go online"
    Initialize
    Set Line = SDB.Progress
    Line.Text = LineText

    Set Tmr = SDB.CreateTimer(500)
    logme "ScrobblerDJ will register Progtimer"
    Script.RegisterEvent Tmr, "OnTimer", "ProgTimer"
    Artist = SDB.Player.CurrentSong.ArtistName
    logme "** Feed Artist is " & Artist
    'Initiate loading of XML data
    LoadXML Artist, 1
    logme "* ScrobblerDJ exited"

End Sub

Sub LoadXML(input, out_type)
	logme "* LoadXML started. Parameters passed: " & input & " ," & out_type
    Dim XMLName, n
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")

    Select Case out_type
        Case 1    'Similar Artists
            XMLName = "http://ws.audioscrobbler.com/1.0/artist/" & URLEncode(input) & "/similar.xml"
            Set DTmr = SDB.CreateTimer(500)
            'Initiate downloading status check
            logme "LoadXML will register DownTimer"
            Script.RegisterEvent DTmr, "OnTimer", "DownTimer"
            Mode = 1
			logme "LoadXML set Mode to 1 (artist)"

        Case 2    'Artist's top tracks
            n = InStr(input, "|§|§|§")
            iArtist = Mid(input, n+6)
            iID = Left(input, n-1)
            XMLName = "http://ws.audioscrobbler.com/1.0/artist/" & URLEncode(iArtist) & "/toptracks.xml"
            Set DTmr = SDB.CreateTimer(500)
            'Initiate downloading status check
            logme "LoadXML will register DownTimer"            
            Script.RegisterEvent DTmr, "OnTimer", "DownTimer"
            Mode = 2
			logme "LoadXML set Mode to 2 (title)"
    End Select

    xmlDoc.async = True
    xmlDoc.Load (XMLName)
    Set XMLName = Nothing
    Set n = Nothing
    logme "* LoadXML exited"
End Sub

Sub LastArtist(ModeType)
'This procedure calls XML parsing, evaluates results and enumerates user with the apropiate message in status bar
	logme "* LastArtist started. Mode was " & modetype
    Dim res
    If ModeType = 1 Then    'Artist
		logme "LastArtist is calling ParseXML with parameters " & Artist & ", 1"
        res = ParseXML(Artist, 1)

        If res <> "E1" And res <> "E2" And res <> "E3" Then
        	logme "ParseXML returned " & res & " to LastArtist. LoadXML will now be called with parameters " & res & ", 2"
         	LoadXML res, 2

        Else
            logme "ParseXML returned " & res & " to LastArtist. Procceding to error evaluation"

            Select Case res
                Case "E1"
                    If PlayDefTrack(dummy) Then
                        LineText = "Scrobbler DJ: Could not locate artist on Last.FM :-( .... ScrobblerDJ added a track from the default playlist"
                        Line.Text = LineText
                        TimerLoop = 0
                        logme "Error evaluated by LastArtist. PlayDefTrack was called succesfully"
                        logme "** Scrobbler reported to user: Scrobbler DJ: Could not locate artist on Last.FM :-( .... ScrobblerDJ added a track from the default playlist"
                    Else
                        LineText = "Scrobbler DJ: Unable to add tracks, even from your default playlist :-(... Seems like you don't have enough accesible tracks"
                        Line.Text = LineText
                        TimerLoop = 0
                        logme "Error evaluated by LastArtist. PlayDefTrack was called unsuccesfully"
                        logme "** Scrobbler reported to user: Scrobbler DJ: Unable to add tracks, even from your default playlist :-(... Seems like you don't have enough accesible tracks"
                        Script.UnregisterEvents DTmr
                        logme "lastArtist unregistered DownTimer"
                    End If

                Case "E2"
                    If PlayDefTrack(dummy) Then
                        LineText = "Scrobbler DJ: Artist located on last.fm but either none of its related artists were found in your library or your settings are too tight :-( .... A track from the default playlist was added"
                        Line.Text = LineText
                        TimerLoop = 0
                        logme "Error evaluated by LastArtist. PlayDefTrack was called succesfully"
                        logme "** Scrobbler reported to user: Scrobbler DJ: Artist located on last.fm but either none of its related artists were found in your library or your settings are too tight :-( .... A track from the default playlist was added"

                    Else
                        LineText = "Scrobbler DJ: Unable to add tracks, even from your default playlist :-(... Seems like you don't have enough accesible tracks"
                        Line.Text = LineText
                        TimerLoop = 0
                        logme "Error evaluated by LastArtist. PlayDefTrack was called unsuccesfully"
                        logme "** Scrobbler reported to user: Scrobbler DJ: Unable to add tracks, even from your default playlist :-(... Seems like you don't have enough accesible tracks"
                        Script.UnregisterEvents DTmr
                        logme "LastArtist unregistered DownTimer"
                    End If
            End Select

        End If
    Else
		logme "LastArtist is calling ParseXML with parameters " & res & ", 2"
        res = ParseXML(res, 2)

        If res <> "E1" And res <> "E2" And res <> "E3" Then
	        logme "ParseXML returned " & res & " to LastArtist"
            LineText = "Scrobbler DJ: New track <" & iArtist & " - " & iTitle & "> loaded succesfully..."
            Line.Text = LineText
            TimerLoop = 0
			logme "** Last Artist: A track was loaded succefully. The track was <" & iArtist & " - " & iTitle & ">"
        Else
            logme "ParseXML returned " & res & " to LastArtist. Procceding to error evaluation"
            
            Select Case res
            Case "E1"
            logme "LastArtist will now call sub GetArtistsTrack with ID " & iID
	            If GetArtistsTrack(iID) Then
	                LineText = "Scrobbler DJ: Suggested Artist <" & iArtist & "> located in your Library but Top Tracks couldnt be retrieved from Last.FM :-( .... Scrobbler added one of the Artist's tracks you own"
	                Line.Text = LineText
	                TimerLoop = 0
	                logme "Error evaluated by LastArtist.GetArtistTrack was called succesfully"
					logme "** Scrobbler reported to user: Suggested Artist <" & iArtist & "> located in your Library but Top Tracks couldnt be retrieved from Last.FM :-( .... Scrobbler added one of the Artist's tracks you own"
		
	            Else
	                LineText = "Scrobbler DJ: Unable to add tracks, even from your default playlist :-(... Seems like you don't have enough accesible tracks"
	                Line.Text = LineText
	                TimerLoop = 0
	               logme "Error evaluated by LastArtist. GetArtistTrack was called unsuccesfully"
	               logme "** Scrobbler reported to user: Scrobbler DJ: Unable to add tracks, even from your default playlist :-(... Seems like you don't have enough accesible tracks"
	               Script.UnregisterEvents DTmr
	               logme "lastArtist unregistered DownTimer"
	            End If
            
            
            Case "E3"
            logme "LastArtist will now call sub GetArtistsTrack with ID " & iID
	            If GetArtistsTrack(iID) Then
	                LineText = "Scrobbler DJ: Suggested Artist <" & iArtist & "> located in your Library but none of his top tracks did, perhaps your settings are too tight :-( .... Scrobbler added one of the Artist's tracks you own"
	                Line.Text = LineText
	                TimerLoop = 0
	                logme "Error evaluated by LastArtist.GetArtistTrack was called succesfully"
					logme "** Scrobbler reported to user: Suggested Artist <" & iArtist & "> located in your Library but none of his top tracks did, perhaps your settings are too tight :-( .... Scrobbler added one of the Artist's tracks you own"
	
	
	            Else
	                LineText = "Scrobbler DJ: Unable to add tracks, even from your default playlist :-(... Seems like you don't have enough accesible tracks"
	                Line.Text = LineText
	                TimerLoop = 0
	               logme "Error evaluated by LastArtist. GetArtistTrack was called unsuccesfully"
	               logme "** Scrobbler reported to user: Scrobbler DJ: Unable to add tracks, even from your default playlist :-(... Seems like you don't have enough accesible tracks"
	               Script.UnregisterEvents DTmr
	               logme "lastArtist unregistered DownTimer"
	            End If
            End Select

        End If
    End If
logme "* LastArtist exited"
End Sub

Function ParseXML(input, out_type)
logme "* ParseXML has started with parameters " & input & ", " & out_type
'This procedure at first parses XML and then it calls the auxiliary procedures to check for the various limitations
    Dim XDict, XElmnt, i, n, RNumber, res, similarArtists
    Set XDict = CreateObject("Scripting.Dictionary")
    	logme "ParseXML is tranfering XML data to a dictionary"

    Select Case out_type
        Case 1
            For Each XElmnt In xmlDoc.getElementsByTagName("artist")
				similarArtists = similarArtists & XElmnt.ChildNodes.Item(0).Text & "(" & XElmnt.ChildNodes.Item(2).Text & ")" & ", "
				
				If XElmnt.ChildNodes.Item(2).Text <> "" Then
	                If CInt(XElmnt.ChildNodes.Item(2).Text)*100 > MinMatch Then
	                	XDict.Add i, XElmnt.ChildNodes.Item(0).Text
	                End If
       			Else
                 	XDict.Add i, XElmnt.ChildNodes.Item(0).Text
				End If
                i = i + 1
                TimerLoop = 0
            Next
			
			logme "Similar artists:" & similarArtists

        Case 2
            For Each XElmnt In xmlDoc.getElementsByTagName("name")
                XDict.Add i, XElmnt.Text
                i = i + 1
                TimerLoop = 0
            Next
    End Select
		logme "ParseXML tranfered XML data to dictionary succefully"
		xmlDoc.save(Script.ScriptPath&"ScrobblerDJ.xml")


    Randomize

    If XDict.Count = 0 Then
    	logme "** ParseXML detected an empty dictionary. ParseXML will return E1 and exit"
        ParseXML = "E1"
        Set xmlDoc = Nothing
        Set XDict = Nothing
        Exit Function
    End If

    Select Case out_type
        Case 1
            i = 0
            n = XDict.Count

            Do
                RNumber = Int(XDict.Count * Rnd)
                logme "ParseXML will now call NotTooSoon with parameters " & XDict.Item(RNumber)
                If Not NotTooSoon(XDict.Item(RNumber)) Then 
                	ParseXML = "E2"
	                logme "** NotTooSoon was False. ParseXML will return E2 and Exit"
	                Exit Do
                End If
                logme "ParseXML will now call sub CheckExist with parameters " & XDict.Item(RNumber) & ", 0, " & out_type
                res = CheckExist(XDict.Item(RNumber), 0, out_type)
                logme "CheckExist returned " & res & " to ParseXML"
                If Len(res) <> 0 Then
                	    ParseXML = res & "|§|§|§" & XDict.Item(RNumber)
                	 	logme "** ParseXML will return " & ParseXML
                        Exit Do
                End If

                If i = n Then
                	logme "** ParseXML tried too many times (" & i & "). It will return E2 code and exit"
                    ParseXML = "E2"
                    Exit Do
                End If
                i = i + 1
                TimerLoop = 0
                SDB.ProcessMessages

            Loop

        Case 2
            i = 0
            n = XDict.Count
            Do
                RNumber = Int(XDict.Count * Rnd)
                logme "ParseXML will now call sub CheckExist with parameters " & iID & ", " & XDict.Item(RNumber) & ", " & out_type
                res = CheckExist(iID, XDict.Item(RNumber), out_type)
                logme "CheckExist returned " & res & " to ParseXML"

                If res <> 0 Then
                    ParseXML = res
                    logme "** ParseXML will return " & ParseXML

                    Exit Do
                End If
                If i = n Then
                	logme "** ParseXML tried too many times (" & i & "). It will return E3 code and exit"
                    ParseXML = "E3"
                    Exit Do
                End If
                i = i + 1
                TimerLoop = 0
			 SDB.ProcessMessages
            Loop

    End Select


    Set xmlDoc = Nothing
    Set XDict = Nothing
    Set i = Nothing
    Set n = Nothing
    Set RNumber = Nothing
    Set res = Nothing
    logme "* ParseXML exited"
End Function

Function CheckExist(cArtist, cTitle, out_type)
logme "* CheckExist has started with parameters " & cArtist & ", " & cTitle & ", " & out_type
'This procedure checks avalaibily of tracks, it also calls some other auxiliary functions to evaluate the various limits
    Dim SQL, iter, SQL1, iter1
    Select Case out_type
        Case 1    'Check for Artist
            CheckExist = 0
            SQL = "SELECT Artist, Artist FROM Artists Where Artist like '" & CorrectSt(cArtist) & "'"

			logme "CheckExist will call CheckRating with parameters " & cArtist & ", " & dummy & ", 1"
            If Not CheckRating(cArtist, dummy, 1) Then 
            logme "Rating Control for artist " & cArtist & " failed. CheckExist will return 0 and exit"
            Exit Function 
            End If   'if rating control on artist level fails exit function
            logme "CheckExist is querying database. SQL is: " & SQL
            Set iter = SDB.Database.OpenSQL(SQL)
            While Not iter.EOF
                SQL1 = "AND (Songs.Artist ='" & iter.ValueByIndex(0) & "')"
                logme "CheckExist is sub-querying database. SQL is: " & SQL1
                Set iter1 = SDB.Database.QuerySongs(SQL1)
                Do While Not iter1.EOF
                logme "CheckExist will call IsAccessible for " & iter1.item.Title
                    If IsAccessible(iter1.Item) Then    'check if artist has accesible tracks
                        logme "** " & iter1.item.Title & " was accessible"
                        CheckExist = iter.ValueByIndex(0)
                        Exit Function
                    End If
                    iter1.Next
                    TimerLoop = 0
					SDB.ProcessMessages
                Loop
                iter.Next
                TimerLoop = 0
                SDB.ProcessMessages
            Wend


        Case 2    'Check for title

            CheckExist = 1
            iTitle = cTitle
			
			logme "CheckExist will call CheckRating with parameters " & cArtist & ", " & cTitle & ", 2"
            If CheckRating(cArtist, cTitle, 2) Then 
            logme "** RatingCheck passed for " & cArtist & " - " & cTitle
            Exit Function
            End If
            logme "** RatingCheck failed for " & cArtist & " - " & cTitle

            CheckExist = 0


    End Select

    Set SQL = Nothing
    Set iter = Nothing
    Set SQL1 = Nothing
    Set iter1 = Nothing
    logme "* CheckExist will now exit"
End Function

Function IsAccessible(SongObj)
    If SongObj Is Nothing Then
	    logme "* IsAccessible has started but the passed parameter was empty"
	    logme "* IsAccessble will now call sub ScrobblerDJ and exit"
        ScrobblerDJ
        Exit Function
    End If
  	logme "* IsAccessible has started for song (" & SongObj.ID & ") " & SongObj.ArtistName & " - " & SongObj.Title

    If (Left(SongObj.Path, 1) <> "?") Or (SongObj.Cached) Then
        IsAccessible = True
    Else
        IsAccessible = False
    End If
    logme "* IsAccessible will return " & IsAccessible & " and exit"
End Function

Function NotTooSoon(ChArtist)
    logme "* NotTooSoon has started with parameters " & ChArtist
    Dim SQL, iter, songdate

    SQL = "SELECT Songs.Artist, Played.PlayDate FROM Songs INNER JOIN Played ON Songs.ID = Played.IdSong"
    SQL = SQL & " WHERE Songs.Artist Like '" & CorrectSt(chArtist) & "' "
    SQL = SQL & " ORDER BY Played.PlayDate DESC"
	logme "NotTooSoon will query database with SQL: " & SQL
    Set iter = SDB.Database.OpenSQL(SQL)
    NotTooSoon = True
    If Not iter.EOF Then
        songdate = CDbl(iter.ValueByIndex(1))
        If songdate > CDbl(DateAdd("n", -MinLastPlayed, Now())) Then NotTooSoon = False
    End If
    Set SQL = Nothing
    Set iter = Nothing
    Set songdate = Nothing
    logme "* NotTooSoon will retunn " & NotTooSoon & " and exit"
End Function

Function CheckRating(cArtist, cTitle, out_type)    
   	logme "* CheckRating has started with parameters " & cArtist & ", " & cTitle & ", " & out_type
    Dim SQL, iter, SQL1, iter1
    Select Case out_type
        Case 1    'Check for Artist
            CheckRating = False

            SQL = "SELECT count(Artists.Artist) FROM Artists Left Join Songs On Artists.Artist = Songs.Artist WHERE Artists.Artist like '" & CorrectSt(cArtist) & "' And (Songs.Rating " & RatingCl & ") ORDER BY Songs.Rating DESC"
            'other code here
			logme "CheckRating will query database with SQL: " & SQL
            Set iter = SDB.Database.OpenSQL(SQL)
            'If Not iter.EOF Then
			If iter.ValueByIndex(0) > 1 Then
	            SQL1 = "AND (Songs.Artist ='" & CorrectSt(cArtist) & "') And (Songs.Rating " & RatingCl & ")"
    			logme "CheckRating will sub-query database with SQL: " & SQL1
                Set iter1 = SDB.Database.QuerySongs(SQL1)
                Do While Not iter1.EOF
                	logme "CheckRating will call IsAccesible for " & iter1.Item.id
                    If IsAccessible(iter1.Item) Then
                    	logme "** " & iter1.Item.id & " was accessible"
                        CheckRating = True
                        logme "* CheckRating will return TRUE and exit"
                        Exit Function
                    End If
                    iter1.Next
                    TimerLoop = 0
					SDB.ProcessMessages
                Loop
            End If

        Case 2
            'Check for title
            CheckRating = False
            SQL = "AND (Songs.SongTitle Like '" & CorrectSt(cTitle) & "') AND (Songs.Artist ='" & cArtist & "') And (Rating " & RatingCl & ")"
			logme "CheckRating will query database with SQL: " & SQL

            Set iter = SDB.Database.QuerySongs(SQL)
            While Not iter.EOF
            logme "CheckRating will call IsAccesible for " & iter.Item.id
                If IsAccessible(iter.Item) Then
                    logme "** " & iter.Item.id & " was accessible. CheckRating will now pass it to AddTrack"
                    AddTrack (iter.Item)
                    CheckRating = True
                    logme "* CheckRating will return TRUE and exit"
                    Exit Function
                End If
                iter.Next
                TimerLoop = 0
				SDB.ProcessMessages
            Wend



    End Select

    Set SQL = Nothing
    Set iter = Nothing
    Set SQL1 = Nothing
    Set iter1 = Nothing
     logme "* CheckRating will return False and exit"
End Function

'Action funtions

Function GetArtistsTrack(GArtist)
	logme "* GetArtistTrack has started with parameters " & GArtist
    Dim iter, SQL
    sql = "AND (Songs.Artist ='"&GArtist&"') ORDER BY Songs.Rating DESC"
    logme "GetArtistTrack will query database with SQL: " & SQL
    Set iter = SDB.Database.QuerySongs(SQL)
    GetArtistsTrack = False
    While Not iter.EOF
    	logme "GetArtistTrack will call IsAccessible for " & GArtist & " - " & iter.item.title
        If IsAccessible(iter.Item) Then
        	logme "** " & iter.item.title & " was accessible"
        	logme "GetArtistTrack will call AddTrack for " & GArtist & " - " & iter.item.title & "(" & iter.item.id & ")"
            AddTrack (iter.Item)
            GetArtistsTrack = True
            logme "* GetArtistTrack will return TRUE and exit"
            Exit Function
        End If
        iter.Next
        TimerLoop = 0
        SDB.ProcessMessages
    Wend
    Set iter = Nothing
    logme "* GetArtistTrack will return false and exit"
End Function

Function PlayDefTrack(anobject)
	logme "* PlayDefTrack has started"
    Dim Playlist, x, n, i
    Set Playlist = SDB.PlaylistByTitle(defPlaylist)
    n = Playlist.Tracks.Count
    logme "PlayDefTrack will use " & defPlaylist & " playlist which contains a total of " & n & " tracks"
    PlayDefTrack = False
    Randomize
    x = 0

    Do
        i = Int(n * Rnd)
        logme "PlayDefTrack initialized checking for accessible files"
        If IsAccessible(Playlist.Tracks.Item(i)) Then
        	logme "** PlayDefTrack: track (" & Playlist.Tracks.Item(i).ID & ") " & Playlist.Tracks.Item(i).ArtistName & " - " & Playlist.Tracks.Item(i).Title & " was accessible and was added in the playing que"
            SDB.Player.PlaylistAddTrack (Playlist.Tracks.Item(i))
            PlayDefTrack = True
            logme "* PlayDefTrack will return TRUE and exit"
            Exit Do
        End If
        If x >= n Then Exit Do
        x = x + 1
        TimerLoop = 0
    Loop
    logme "** PlayDefTrack couldn't locate an accessible track from the default playlist"
    logme "* PlayDefTrack will return FALSE and exit"
    Set Playlist = Nothing
    Set x = Nothing
    Set n = Nothing
    Set i = Nothing
End Function

Sub AddTrack(SongObj)
	logme "* AddTrack has started for track " & SongObj.ID
    SDB.Player.PlaylistAddTrack (SongObj)
    logme "* AddTrack added track to playlist and will exit"
End Sub


'Auxiliary functions

Sub Initialize()
logme "* Initialization started"
If IncludeHigherRating Then
    RatCond = ">="
Else
    RatCond = "="
End If

Select Case MinRating
    Case 0
        RatingCl = ">=0"
    Case 1
        RatingCl = "<0"
    Case 2
        RatingCl = RatCond & 100
    Case 3
        RatingCl = RatCond & 90
    Case 4
        RatingCl = RatCond & 80
    Case 5
        RatingCl = RatCond & 70
    Case 6
        RatingCl = RatCond & 60
    Case 7
        RatingCl = RatCond & 50
    Case 8
        RatingCl = RatCond & 40
    Case 9
        RatingCl = RatCond & 30
    Case 10
        RatingCl = RatCond & 20
    Case 11
        RatingCl = RatCond & 10
    Case 12
        RatingCl = RatCond & 0
End Select

If IncludeUnknownRating Then RatingCl = RatingCl & " OR SONGS.RATING = -1"
logme "* Initialization finished"

End Sub

Sub logme(msg)
   If DebugSt 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 ConstructSQL(inSQL)
	'obsolete
	logme "* ConstructSQL started with parameters " & inSQL
    Dim RatingClause
    Dim RatCond
    Dim PlayUnr

    If IncludeHigherRating Then
        RatCond = ">="
    Else
        RatCond = "="
    End If

    Select Case MinRating
        Case 1
            RatingClause = " AND (SONGS.RATING < 0)"
        Case 2
            RatingClause = " AND (SONGS.RATING " & RatCond & " 100)"
        Case 3
            RatingClause = " AND (SONGS.RATING " & RatCond & " 90)"
        Case 4
            RatingClause = " AND (SONGS.RATING " & RatCond & " 80)"
        Case 5
            RatingClause = " AND (SONGS.RATING " & RatCond & " 70)"
        Case 6
            RatingClause = " AND (SONGS.RATING " & RatCond & " 60)"
        Case 7
            RatingClause = " AND (SONGS.RATING " & RatCond & " 50)"
        Case 8
            RatingClause = " AND (SONGS.RATING " & RatCond & " 40)"
        Case 9
            RatingClause = " AND (SONGS.RATING " & RatCond & " 30)"
        Case 10
            RatingClause = " AND (SONGS.RATING " & RatCond & " 20)"
        Case 11
            RatingClause = " AND (SONGS.RATING " & RatCond & " 10)"
        Case 12
            RatingClause = " AND (SONGS.RATING " & RatCond & " 0)"
    End Select

    If IncludeUnknownRating Then RatingClause = RatingClause & " OR (SONGS.RATING = -1)"

    ConstructSQL = inSQL & RatingClause
    logme "Constructed SQL was " & ContsructSQL
    logme "* ContructSQL will now exit"

End Function

Function CorrectSt(inString)
	logme "* CorrectSt has started with parameters " & inString
    CorrectSt = Replace(inString, "'", "''")
    logme "* CorrectSt will return " & CorrectSt & " and exit"
End Function

Sub ScrobblerOnDemand()
	'Under Development
    Set Line = SDB.Progress
    Line.Text = LineText

    Set Tmr = SDB.CreateTimer(500)    ' Pop up a message in 10 seconds
    Script.RegisterEvent Tmr, "OnTimer", "ProgTimer"
    Dim Artist
    Artist = SDB.Player.CurrentSong.ArtistName

    LoadXML Artist, 1


End Sub

Sub TerminateMe()
	'obsolete
	logme "* Terminate me has started"
    Set TimerLoop = Nothing
    Set LineText = Nothing
    Set Line = Nothing
    Set Tmr = Nothing
    Set iArtist = Nothing
    Set iTitle = Nothing
    Set iID = Nothing
    Set defPlaylist = Nothing
    Set dummy = Nothing
    Set xmlDoc = Nothing
    Set DTmr = Nothing
    Set DownLoop = Nothing
    Set Timeout = Nothing
	Set Mode = Nothing
	Set InfoTime = Nothing
	Set MinLastPlayed = Nothing
	Set SQLRat = Nothing
	Set RatCond = Nothing
	Set RatingCl = Nothing
	Set MinMatch = Nothing
	Set WarningTimeOut = Nothing
	Set MinRating = Nothing
	Set IncludeHigherRating = Nothing
	Set IncludeUnknownRating = Nothing
	Set Artist = Nothing
	Set DebugSt = Nothing
	SetLocale(CurLocale) 'Revert to client locale
	logme "* TerminateMe reseted variables and will now exit"
End Sub

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

Ernieboy · Post by **Ernieboy** » Mon May 02, 2011 5:28 pm

Cool, it seems to work now! I had some problems with older versions, but this new script seems to do the trick. Great work!

Post by **Peke** » Mon May 02, 2011 5:42 pm

Anyone interested That I Make MMIP?

@rmatiazo,
Will you planning continue supporting this script. It is simpler than last.fm node and also fast enough?

EDIT: You really know how to make an entry Big Stype

Welcome

BriceGdT · Post by **BriceGdT** » Wed Aug 10, 2011 3:23 pm

rmatiazo you are a king !

The script is working again

Great job, thanks for your contribution,

Cheers

BriceGdT · Post by **BriceGdT** » Wed Aug 10, 2011 3:54 pm

Mhm... not really stable actually

I'm not good enough in vbs to correct it, but if you are still available to work on the script, I would be glad to help debugging it.

timelezz · Post by **timelezz** » Mon Sep 05, 2011 7:41 am

"Could not locate Artist on Last.fm". It never can locate. :/ What can I do to fix it?
I already removed ScrobblerDJ section from script.ini, and reinstalled the latest version of the script today. Please help.

Guest · Post by **Guest** » Sat Sep 10, 2011 2:56 pm

Peke wrote:Anyone interested That I Make MMIP?

Very

I've been experimenting with scripts available for scrobbling, came across this. It works for me but it doesn't seem fully operational.
I'm on MM 3.2 btw
And if rmatiazo's script works and improves it, then hurray.

Also, just for future reference, if someone posts a script in form of code like rmatiazo has, how would I implement it into MM?

Thanks.

Post by **Peke** » Wed Dec 26, 2012 8:20 pm

ANNOUNCEMENT: ScrobblerDJ v2.0 is here

ScrobblerDJ v1.26, Let your music free!!!

Re:

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!

Re: ScrobblerDJ v1.26, Let your music free!!!