Similar Artists 1.5 [MM2+3]

[trixmoto]

This is a new script that was requested by Balance to be part of the MonkeyRok script, but I decided it should be separate.

This script loops through the artists of all the selected (or visible) tracks. For each one it creates a playlist and fills it with tracks from related artists, found by querying Last.Fm. Don't forget to play with the settings as there are some limits in there to stop massive playlists being created.

The installer can be downloaded from my website. Let me know what you think!

Code: Select all

'
' MediaMonkey Script
'
' NAME: SimilarArtists 1.5
'
' AUTHOR: trixmoto (http://trixmoto.net)
' DATE : 11/04/2008
'
' INSTALL: Copy to Scripts\Auto directory and add the following to Scripts.ini
'          Don't forget to remove comments (') and set the order appropriately
'
' [SimilarArtists]
' FileName=Auto\SimilarArtists.vbs
' ProcName=SimilarArtists
' Order=50
' DisplayName=&Similar Artists
' Description=Creates a playlist of similar artists
' Language=VBScript
' ScriptType=0
'
' FIXES: Fixed "navigate to new playlist" not working recursively
'        Added toolbar button to toggle the auto option on/off
'

Option Explicit

Sub OnStartup
  'default settings
  Dim ini : Set ini = SDB.IniFile
  If ini.StringValue("SimilarArtists","Toolbar") = "" Then
    ini.IntValue("SimilarArtists","Toolbar") = 1 '0=none 1=run 2=auto 3=both
  End If
  If ini.StringValue("SimilarArtists","Confirm") = "" Then
    ini.BoolValue("SimilarArtists","Confirm") = True
  End If 
  If ini.StringValue("SimilarArtists","Sort") = "" Then
    ini.BoolValue("SimilarArtists","Sort") = False
  End If 
  If ini.StringValue("SimilarArtists","Limit") = "" Then
    ini.IntValue("SimilarArtists","Limit") = 5
  End If
  If ini.StringValue("SimilarArtists","Name") = "" Then
    ini.StringValue("SimilarArtists","Name") = "Artists similar to %"
  End If
  If ini.StringValue("SimilarArtists","TPA") = "" Then
    ini.IntValue("SimilarArtists","TPA") = 9999
  End If
  If ini.StringValue("SimilarArtists","TPL") = "" Then
    ini.IntValue("SimilarArtists","TPL") = 9999
  End If
  If ini.StringValue("SimilarArtists","Random") = "" Then
    ini.BoolValue("SimilarArtists","Random") = False
  End If 
  If ini.StringValue("SimilarArtists","Seed") = "" Then
    ini.BoolValue("SimilarArtists","Seed") = False
  End If 
  If ini.StringValue("SimilarArtists","Best") = "" Then
    ini.BoolValue("SimilarArtists","Best") = False
  End If 
  If ini.StringValue("SimilarArtists","Rating") = "" Then
    ini.IntValue("SimilarArtists","Rating") = 0
  End If
  If ini.StringValue("SimilarArtists","Unknown") = "" Then
    ini.BoolValue("SimilarArtists","Unknown") = True
  End If   
  If ini.StringValue("SimilarArtists","Overwrite") = "" Then
    ini.BoolValue("SimilarArtists","Overwrite") = False
  End If   
  If ini.StringValue("SimilarArtists","Enqueue") = "" Then
    ini.BoolValue("SimilarArtists","Enqueue") = False
  End If     
  If ini.StringValue("SimilarArtists","Navigate") = "" Then
    ini.BoolValue("SimilarArtists","Navigate") = False
  End If       
  If ini.StringValue("SimilarArtists","OnPlay") = "" Then
    ini.BoolValue("SimilarArtists","OnPlay") = False
  Else
    If ini.BoolValue("SimilarArtists","OnPlay") Then
      Call Event_OnPlay
    End If
  End If
  ini.IntValue("SimilarArtists","OnIconIndex") = SDB.RegisterIcon("Scripts\Auto\sa_auto_on.ico",0)
  ini.IntValue("SimilarArtists","OffIconIndex") = SDB.RegisterIcon("Scripts\Auto\sa_auto_off.ico",0)   
   
  'hide old toolbar buttons
  Dim but : Set but = SDB.Objects("SAToolbarButton")
  If but Is Nothing Then
    Call SDB.UI.AddOptionSheet("SimilarArtists Settings",Script.ScriptPath,"InitSheet","SaveSheet",-3) 
    Call Script.RegisterEvent(SDB,"OnPlay","Event_OnPlay")         
  Else
    but.Visible = False
  End If
  Dim but2 : Set but2 = SDB.Objects("SAToolbarButton2")
  If Not (but2 Is Nothing) Then
    but2.Visible = False
  End If 
   
  'add new tollbar buttons
  Set but = SDB.UI.AddMenuItem(SDB.UI.Menu_TbStandard,0,0)
  but.Caption = "SimilarArtists"
  but.IconIndex = 31
  Call Script.RegisterEvent(but,"OnClick","Toolbar")     
  Set but2 = SDB.UI.AddMenuItem(SDB.UI.Menu_TbStandard,0,0)
  but2.Caption = "SimilarArtists (Auto On/Off)"
  If ini.BoolValue("SimilarArtists","OnPlay") Then
    but2.IconIndex = ini.IntValue("SimilarArtists","OnIconIndex")
  Else
    but2.IconIndex = ini.IntValue("SimilarArtists","OffIconIndex")
  End If
  Call Script.RegisterEvent(but2,"OnClick","Toolbar2")     
  Select Case ini.IntValue("SimilarArtists","Toolbar")
    Case 0
      but.Visible = False     
      but2.Visible = False
    Case 1
      but.Visible = True
      but2.Visible = False       
    Case 2
      but.Visible = False
      but2.Visible = True
    Case 3
      but.Visible = True
      but.Visible = True
  End Select
  Set SDB.Objects("SAToolbarButton") = but
  Set SDB.Objects("SAToolbarButton2") = but2   
End Sub

Sub Event_OnPlay
  If SDB.IniFile.BoolValue("SimilarArtists","OnPlay") Then
    If SDB.Player.CurrentSongIndex+2 > SDB.Player.CurrentSongList.Count Then
      If Not (SDB.Player.CurrentSong Is Nothing) Then
        Dim list : Set list = SDB.NewSongList
        Call list.Add(SDB.Player.CurrentSong)
        Set SDB.Objects("SimilarArtistsPlay") = list.Artists
        Call SimilarArtists
      End If
    End If
  End If
End Sub

Sub Toolbar(but)
  Set SDB.Objects("SimilarArtistsPlay") = Nothing
  Call SimilarArtists
End Sub

Sub Toolbar2(but2)
  Dim ini : Set ini = SDB.IniFile
  If ini.BoolValue("SimilarArtists","OnPlay") Then
    ini.BoolValue("SimilarArtists","OnPlay") = False
    but2.IconIndex = ini.IntValue("SimilarArtists","OffIconIndex")
  Else
    ini.BoolValue("SimilarArtists","OnPlay") = True
    but2.IconIndex = ini.IntValue("SimilarArtists","OnIconIndex")
  End If
End Sub

Sub SimilarArtists
  'check not already running
  Dim list : Set list = SDB.Objects("SimilarArtistsList")
  If Not (list Is Nothing) Then
    Exit Sub
  End If
 
  'check onplay
  Set list = SDB.Objects("SimilarArtistsPlay")
  If list Is Nothing Then
    'get selected artists
    Set list = SDB.SelectedSongList
    If list.Count = 0 Then
      Set list = SDB.AllVisibleSongList
      If list.Count = 0 Then
        Call SDB.MessageBox("SimilarArtists: There are no selected tracks to process.",mtError,Array(mbOk))
        Exit Sub
      End If       
    End If
    Set list = list.Artists
  End If
  Set SDB.Objects("SimilarArtistsList") = list
  Set SDB.Objects("SimilarArtistsPlay") = Nothing
 
  'set progress bar
  Dim prog : Set prog = SDB.Progress
  prog.Text = "SimilarArtists: Initialising script..."
  prog.Value = 0
  prog.MaxValue = list.Count
  Set SDB.Objects("SimilarArtistsProgress") = prog
 
  'create queue
  Dim ini : Set ini = SDB.IniFile
  Dim que : Set que = CreateObject("Scripting.Dictionary")
  que.Item("beg") = Timer
  que.Item("lst") = Timer-1
  que.Item("sts") = "READY"
  que.Item("cur") = 0
  que.Item("max") = list.Count
  que.Item("lim") = ini.IntValue("SimilarArtists","Limit")
  que.Item("nam") = ini.StringValue("SimilarArtists","Name")
  que.Item("con") = ini.IntValue("SimilarArtists","Confirm")
  que.Item("tpa") = ini.IntValue("SimilarArtists","TPA")
  que.Item("tpl") = ini.IntValue("SimilarArtists","TPL")
  que.Item("rem") = que.Item("tpl")
  que.Item("par") = ini.StringValue("SimilarArtists","Parent")
  que.Item("bla") = ini.StringValue("SimilarArtists","Black")
  If ini.BoolValue("SimilarArtists","Random") Then
    Randomize
    que.Item("ran") = 1
  Else
    que.Item("ran") = 0
  End If
  que.Item("see") = ini.StringValue("SimilarArtists","Seed")
  If ini.BoolValue("SimilarArtists","Best") Then
    que.Item("bes") = "Rating DESC,"
  Else
    que.Item("bes") = ""
  End If
  Dim rat : rat = ini.IntValue("SimilarArtists","Rating")
  If ini.BoolValue("SimilarArtists","Unknown") Then
    If rat = 0 Then
      que.Item("rat") = ""
    Else
      que.Item("rat") = " AND (Rating < 0 OR Rating > "&(rat-5)&")"
    End If
  Else
    If rat = 0 Then
      que.Item("rat") = " AND (Rating > -1 AND Rating < 101)"
    Else
      que.Item("rat") = " AND (Rating > "&(rat-5)&" AND Rating < 101)"
    End If 
  End If
  Dim str : str = ini.StringValue("SimilarArtists","Genre")
  If str = "" Then
    que.Item("gen") = ""
  Else
    If InStr(str,",") = 0 Then
      str = "SELECT IDGenre FROM Genres WHERE GenreName = '"&fixsql(str)&"'"
    Else
      Dim i : i = 0
      Dim arr : arr = Split(str,",")
      str = "SELECT IDGenre FROM Genres WHERE GenreName = '"&fixsql(arr(0))&"'"
      For i = 1 To UBound(arr)
        str = str&" OR GenreName = '"&fixsql(arr(i))&"'"
      Next
    End If
    Dim dit : Set dit = SDB.Database.OpenSQL(str)
    If dit.EOF Then
      que.Item("gen") = ""
    Else
      str = dit.StringByIndex(0)
      dit.Next
      While Not dit.EOF
        str = str&","&dit.StringByIndex(0)
        dit.Next
      WEnd
      If SDB.VersionHi > 2 Then
        que.Item("gen") = " AND (GenresSongs.IDGenre NOT IN ("&str&"))"
      Else
        que.Item("gen") = " AND (Genre NOT IN ("&str&"))"
      End If
    End If
  End If
  If ini.BoolValue("SimilarArtists","Overwrite") Then
    que.Item("ovr") = 1
  Else
    que.Item("ovr") = 0
  End If
  If ini.BoolValue("SimilarArtists","Enqueue") Then
    que.Item("enq") = 1
  Else
    que.Item("enq") = 0
  End If 
  If ini.BoolValue("SimilarArtists","Navigate") Then
    que.Item("nav") = 1
  Else
    que.Item("nav") = 0
  End If   
 
  'build blacklist
  Dim j : j = 0
  Dim a : a = Split(que.Item("bla"),",")
  Dim bla : Set bla = CreateObject("Scripting.Dictionary")
  For j = 0 To UBound(a)
    bla.Item(a(j)) = "bla"
  Next
 
  'build list
  Dim k,l,itmID,sql,iter
  For l = 0 To list.Count-1
    Dim itm : Set itm = list.Item(l)
    a = Split(itm.Name,"; ")
    For j = 0 To UBound(a)
      If Not (bla.Exists(a(j))) Then
        If SDB.VersionHi > 2 Then
          sql = "SELECT Id FROM Artists WHERE Artist = '"&Replace(a(j),"'","''")&"'"
          Set iter = SDB.Database.OpenSQL(sql)
          If iter.EOF Then
            itmID = 0
          Else
            itmID = iter.ValueByIndex(0)
          End If
          Set iter = Nothing
        Else
          itmID = itm.ID
        End If       
        If itmID > 0 Then       
          k = k+1     
          que.Item("#"&k) = a(j)&"~"&itmID
          bla.Item(a(j)) = "dup"
        End If
      End If
    Next
  Next
  que.Item("max") = k
  prog.MaxValue = k
  If SDB.IniFile.BoolValue("SimilarArtists","Sort") Then
    Call SortArtists(que)
  End If 
  Set SDB.Objects("SimilarArtistsQueue") = que 
 
  'set controller
  Dim tmr : Set tmr = SDB.CreateTimer(250)
  Set SDB.Objects("SimilarArtistsTimer1") = tmr
  Call Script.RegisterEvent(tmr,"OnTimer","Controller")
End Sub

Sub SortArtists(que)
  'extract artists from queue
  Dim a : a = que.Keys
  Dim i : i = 0
  Dim art : Set art = CreateObject("Scripting.Dictionary")
  For i = 0 To UBound(a)
    If Left(a(i),1) = "#" Then
      art.Item(que.Item(a(i))) = Mid(a(i),2)
      Call que.Remove(a(i))
    End If
  Next
  a = art.Keys
 
  'sort artists
  Dim boo : boo = False
  Dim tmp : tmp = ""
  Do
    boo = True
    For i = 0 To UBound(a)-1
      If a(i+1) < a(i) Then
        boo = False
        tmp = a(i)
        a(i) = a(i+1)
        a(i+1) = tmp
      End If
    Next
  Loop Until boo
 
  'return artists to queue
  For i = 0 To UBound(a)
    que.Item("#"&(i+1)) = a(i)
  Next
End Sub

Sub Controller(tmr)
  'get progress
  Dim prog : Set prog = SDB.Objects("SimilarArtistsProgress")
  If prog Is Nothing Then
    Call ClearUp("Sorry, the progress bar has been lost.",mtError)
    Exit Sub
  End If 
 
  'check cancelled
  If prog.Terminate Then
    Call ClearUp("Process cancelled by user.",mtInformation)
    Exit Sub
  End If 
 
  'get queue
  Dim que : Set que = SDB.Objects("SimilarArtistsQueue")
  If que Is Nothing Then
    Call ClearUp("Sorry, the queue has been lost.",mtError)
    Exit Sub
  End If
 
  'check status
  Select Case que.Item("sts")
    Case "READY"
      'continue
    Case "BUSY"
      'check xml
      Dim xml2 : Set xml2 = SDB.Objects("SimilarArtistsXML")
      If xml2 Is Nothing Then
        Call ClearUp("Sorry, the xml object has been lost.",mtError)
      End If 
      Exit Sub
    Case "EXIT"
      Call ClearUp("Process cancelled by user.",mtInformation)
      Exit Sub     
    Case Else
      Call ClearUp("Sorry, unknown status '"&que.Item("sts")&"'.",mtError)
      Exit Sub
  End Select
 
  'check items left
  Dim cur : cur = Int(que.Item("cur"))
  Dim max : max = Int(que.Item("max"))
  If Not (cur < max) Then
    prog.Value = max
    If Int(que.Item("con")) = 1 Then
      If max = 1 Then
        Call ClearUp("Artist has been processed.",mtInformation)
      Else
        Call ClearUp("All "&max&" artists have been processed.",mtInformation)     
      End If
    Else
      Call ClearUp("",mtInformation)
    End If
    Exit Sub
  End If 
 
  'check last query time
  If Timer < (que.Item("lst")+1) Then
    Exit Sub
  End If
 
  'update queue
  cur = cur + 1
  que.Item("sts") = "BUSY"
  que.Item("lst") = Timer
  que.Item("cur") = cur
  que.Item("rem") = que.Item("tpl")
 
  'get item
  Dim itmName : itmName = que.Item("#"&cur)
  itmName = Left(itmName,InStrRev(itmName,"~")-1)
 
  'update progress
  prog.Text = "SimilarArtists: Processing artist '"&itmName&"' ("&cur&"/"&max&")..."
  prog.Value = cur - 1
  SDB.ProcessMessages
 
  'send query to last.fm
  Dim xml : Set xml = CreateObject("Microsoft.XMLDOM")
  xml.async = True
  Dim url : url = "http://ws.audioscrobbler.com/1.0/artist/"&fixurl(itmName)&"/similar.xml"
  Call xml.Load(url)
  Set SDB.Objects("SimilarArtistsXML") = xml
 
  'wait for response
  Dim res : Set res = SDB.CreateTimer(100)
  Set SDB.Objects("SimilarArtistsTimer2") = res
  Call Script.RegisterEvent(res,"OnTimer","Response")   
End Sub

Sub Response(tmr) 
  'get query
  Dim xml : Set xml = SDB.Objects("SimilarArtistsXML")
  If xml Is Nothing Then
    Call Script.UnregisterEvents(tmr)
    Exit Sub
  End If

  'check status 
  If Not (xml.readyState = 4) Then
    Exit Sub
  End If
  Call Script.UnregisterEvents(tmr)
 
  'get queue
  Dim que : Set que = SDB.Objects("SimilarArtistsQueue")
  If que Is Nothing Then
    Call Script.UnregisterEvents(tmr)
    Exit Sub
  End If
 
  'get item
  Dim cur : cur = que.Item("cur")
  Dim itmName : itmName = que.Item("#"&cur)
  Dim itmID : itmID = Mid(itmName,InStrRev(itmName,"~")+1)
  itmName = Left(itmName,InStrRev(itmName,"~")-1)
   
  'create playlist
  cur = 1
  Dim nam : nam = Replace(que.Item("nam"),"%",itmName)
  Dim tmp : tmp = nam
  Dim ply : Set ply = SDB.PlaylistByTitle(tmp)
  If Int(que.Item("ovr")) = 1 Then
    If Not (ply Is Nothing) Then
      ply.Clear
    End If
  Else
    While Not (ply.Title = "")
      cur = cur + 1
      tmp = nam&"_"&cur
      Set ply = SDB.PlaylistByTitle(tmp)
    WEnd
  End If
  If Int(que.Item("con")) = 1 Then
    Select Case SDB.MessageBox("SimilarArtists: Do you wish to create playlist '"&tmp&"'?",mtConfirmation,Array(mbYes,mbNo,mbYesToAll,mbNoToAll))
      Case mrNo
        que.Item("sts") = "READY"
        Exit Sub
      Case mrYesToAll
        que.Item("con") = "0"
      Case mrNoToAll
        que.Item("sts") = "EXIT"
        Exit Sub       
    End Select
  End If
  Dim par : Set par = SDB.PlaylistByTitle(que.Item("par"))
  If par Is Nothing Then
    Set par = SDB.PlaylistByTitle("")
  End If
  Set ply = par.CreateChildPlaylist(tmp) 
 
  'get settings
  Dim ele : Set ele = Nothing
  Dim tot : tot = Int(que.Item("lim"))
  Dim tpa : tpa = Int(que.Item("tpa"))
  Dim tpl : tpl = Int(que.Item("rem"))
  Dim bes : bes = que.item("bes")
  Dim rat : rat = que.item("rat")
  Dim gen : gen = que.item("gen")
  Dim sql : sql = ""
  cur = 0
 
  'include seed
  If que.item("see") = "1" Then
    If SDB.VersionHi > 2 Then
      If gen = "" Then
        sql = "SELECT Songs.Id FROM Songs,ArtistsSongs WHERE Songs.ID = ArtistsSongs.IDSong AND ArtistsSongs.PersonType = 1 AND ArtistsSongs.IDArtist = "&itmID&rat&" ORDER BY "&bes&"Random(Songs.Id)"
      Else
        sql = "SELECT Songs.Id FROM Songs,ArtistsSongs,GenresSongs WHERE Songs.ID = GenresSongs.IDSong AND Songs.ID = ArtistsSongs.IDSong AND ArtistsSongs.PersonType = 1 AND ArtistsSongs.IDArtist = "&itmID&rat&gen&" ORDER BY "&bes&"Random(Songs.Id)"
      End If
    Else
      sql = "SELECT Id FROM Songs WHERE Songs.IDArtist="&itmID&rat&gen&" ORDER BY "&bes&"RND(Id)"
    End If
    Dim qit : Set qit = SDB.Database.OpenSQL(sql)
    If Not qit.EOF Then
      Dim j : j = 0
      cur = cur + 1 
      While (Not qit.EOF) And (j < tpa) And (tpl > 0)
        j = j + 1
        tpl = tpl - 1
        Call ply.AddTrackById(qit.StringByIndex(0))
        qit.Next
      WEnd     
    End If
  End If
 
  'read responses
  If cur < tot Then
    For Each ele In xml.getElementsByTagName("artist")
      Dim art : art = ele.ChildNodes.Item(0).Text     
      If Not IsInList(que.Item("bla"),art) Then
        sql = "SELECT Id FROM Artists WHERE Artist = '"&fixsql(art)&"'"
        Dim dit : Set dit = SDB.Database.OpenSQL(sql)
        If Not dit.EOF Then 
          If SDB.VersionHi > 2 Then
            If gen = "" Then
              sql = "SELECT Songs.Id FROM Songs,ArtistsSongs WHERE Songs.ID = ArtistsSongs.IDSong AND ArtistsSongs.PersonType = 1 AND ArtistsSongs.IDArtist = "&dit.StringByIndex(0)&rat&" ORDER BY "&bes&"Random(Songs.Id)"
            Else
              sql = "SELECT Songs.Id FROM Songs,ArtistsSongs,GenresSongs WHERE Songs.ID = GenresSongs.IDSong AND Songs.ID = ArtistsSongs.IDSong AND ArtistsSongs.PersonType = 1 AND ArtistsSongs.IDArtist = "&dit.StringByIndex(0)&rat&gen&" ORDER BY "&bes&"Random(Songs.Id)"
            End If
          Else
            sql = "SELECT Id FROM Songs WHERE Songs.IDArtist="&dit.StringByIndex(0)&rat&gen&" ORDER BY "&bes&"RND(Id)"
          End If
          Dim sit : Set sit = SDB.Database.OpenSQL(sql)
          If Not sit.EOF Then         
            Dim i : i = 0
            cur = cur + 1 
            While (Not sit.EOF) And (i < tpa) And (tpl > 0)
              i = i + 1
              tpl = tpl - 1
              Call ply.AddTrackById(sit.StringByIndex(0))
              sit.Next
            WEnd
          End If
        End If
      End If
      If (cur = tot) Or (tpl = 0) Then
        Exit For
      End If
    Next
  End If
 
  'randomise
  If Int(que.Item("ran")) = 1 Then
    Call RandomisePlaylist(ply)
  End If
 
  'enqueue
  If Int(que.Item("enq")) = 1 Then
    Call EnqueuePlaylist(ply)
  End If
 
  'navigate
  If Int(que.item("nav")) = 1 Then
    Call NavigatePlaylist(ply)
  End If
 
  'finished
  que.Item("rem") = tpl
  que.Item("sts") = "READY"
End Sub

Sub ClearUp(mes,typ)
  Dim tmr : Set tmr = SDB.Objects("SimilarArtistsTimer1")
  If Not (tmr Is Nothing) Then
    Call Script.UnregisterEvents(tmr)
    Set SDB.Objects("SimilarArtistsTimer1") = Nothing
  End If
  Set tmr = SDB.Objects("SimilarArtistsTimer2")
  If Not (tmr Is Nothing) Then
    Call Script.UnregisterEvents(tmr)
    Set SDB.Objects("SimilarArtistsTimer2") = Nothing
  End If   
  Set SDB.Objects("SimilarArtistsQueue") = Nothing
  Set SDB.Objects("SimilarArtistsProgress") = Nothing
  Set SDB.Objects("SimilarArtistsList") = Nothing
  Set SDB.Objects("SimilarArtistsItem") = Nothing
  Set SDB.Objects("SimilarArtistsXML") = Nothing
  If Not (mes = "") Then
    Call SDB.MessageBox("SimilarArtists: "&mes,typ,Array(mbOk))
  End If
End Sub

Function fixsql(name)
  fixsql = Replace(name,"'","''")
End Function

Function fixurl(sRawURL)
  Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\/&:"
  Dim url : url = Replace(sRawURL,"+","%2B")
  If UCase(Right(url,6)) = " (THE)" Then
    url = "The "&Left(url,Len(url)-6)
  End If
  If UCase(Right(url,5)) = ", THE" Then
    url = "The "&Left(url,Len(url)-5)
  End If 
 
  If Len(url) > 0 Then
    Dim i : i = 1
    Do While i < Len(url)+1
      Dim s : s = Mid(url,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"
        End Select
      End If
      fixurl = fixurl&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 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

Sub InitSheet(Sheet)
  Dim ini : Set ini = SDB.IniFile 
  Dim ui : Set ui = SDB.UI
  Dim edt : Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 10, 50, 20
  edt.Caption = "Toolbar buttons:"
  edt.Autosize = False 
 
  Set edt = ui.NewDropdown(Sheet)
  edt.Common.SetRect 85, 7, 100, 20
  edt.Common.ControlName = "SAToolbar"
  edt.Style = 2
  edt.AddItem("None")
  edt.AddItem("Run script")
  edt.AddItem("Auto on/off")
  edt.AddItem("Both")
  edt.ItemIndex = ini.IntValue("SimilarArtists","Toolbar")
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 5, 35, 200, 20
  edt.Common.ControlName = "SAConfirm"
  edt.Caption = "Show confirmation prompt?"
  edt.Checked = ini.BoolValue("SimilarArtists","Confirm") 
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 5, 60, 200, 20
  edt.Common.ControlName = "SASort"
  edt.Caption = "Sort artists before processing?"
  edt.Checked = ini.BoolValue("SimilarArtists","Sort") 
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 205, 10, 200, 20
  edt.Common.ControlName = "SARandom"
  edt.Caption = "Randomise playlists?"
  edt.Checked = ini.BoolValue("SimilarArtists","Random") 
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 205, 35, 200, 20
  edt.Common.ControlName = "SASeed"
  edt.Caption = "Include seed artist?"
  edt.Checked = ini.BoolValue("SimilarArtists","Seed")   
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 205, 60, 200, 20
  edt.Common.ControlName = "SABest"
  edt.Caption = "Select highest rated?"
  edt.Checked = ini.BoolValue("SimilarArtists","Best")   
 
  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 85, 50, 20
  edt.Caption = "Playlist name:"
  edt.Autosize = False
 
  Set edt = ui.NewEdit(Sheet)
  edt.Common.SetRect 85, 82, 300, 20
  edt.Common.ControlName = "SAName"
  edt.Common.Hint = "Use % to represent the artist name"
  edt.Text = ini.StringValue("SimilarArtists","Name")
 
  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 110, 50, 20
  edt.Caption = "Artist limit:"
  edt.Autosize = False
 
  Set edt = ui.NewSpinEdit(Sheet)
  edt.Common.SetRect 85, 107, 50, 20
  edt.Common.ControlName = "SALimit"
  edt.MinValue = 0
  edt.MaxValue = 9999
  edt.Value = ini.IntValue("SimilarArtists","Limit")
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 205, 110, 200, 20
  edt.Common.ControlName = "SAOverwrite"
  edt.Caption = "Overwrite existing playlist?"
  edt.Checked = ini.BoolValue("SimilarArtists","Overwrite")     
 
  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 135, 50, 20
  edt.Caption = "Tracks/artist:"
  edt.Autosize = False
 
  Set edt = ui.NewSpinEdit(Sheet)
  edt.Common.SetRect 85, 132, 50, 20
  edt.Common.Hint = "Maximum number of tracks from a single artist in a playlist"
  edt.Common.ControlName = "SATPA"
  edt.MinValue = 0
  edt.MaxValue = 9999
  edt.Value = ini.IntValue("SimilarArtists","TPA") 
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 205, 135, 200, 20
  edt.Common.ControlName = "SAEnqueue"
  edt.Caption = "Automatically enqueue tracks?"
  edt.Checked = ini.BoolValue("SimilarArtists","Enqueue")       
 
  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 160, 50, 20
  edt.Common.Hint = "Maximum number of tracks in total in a playlist"
  edt.Caption = "Tracks/playlist:"
  edt.Autosize = False
 
  Set edt = ui.NewSpinEdit(Sheet)
  edt.Common.SetRect 85, 158, 50, 20
  edt.Common.ControlName = "SATPL"
  edt.MinValue = 0
  edt.MaxValue = 9999
  edt.Value = ini.IntValue("SimilarArtists","TPL")   
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 205, 160, 200, 20
  edt.Common.ControlName = "SANavigate"
  edt.Caption = "Navigate to new playlist?"
  edt.Checked = ini.BoolValue("SimilarArtists","Navigate")         
 
  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 185, 50, 20
  edt.Caption = "Parent playlist:"
  edt.Autosize = False
 
  Set edt = ui.NewDropdown(Sheet)
  edt.Common.SetRect 85, 182, 300, 20
  edt.Common.Hint = "Please select a playlist"
  edt.Common.ControlName = "SAParent"
  edt.Style = 2
  edt.AddItem("[Playlists]") 
  edt.ItemIndex = 0
  Call AddPlaylists(edt,ini.StringValue("SimilarArtists","Parent"))
 
  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 210, 50, 20
  edt.Caption = "Exclude artists:"
  edt.Autosize = False
 
  Set edt = ui.NewEdit(Sheet)
  edt.Common.SetRect 85, 207, 300, 20
  edt.Common.ControlName = "SABlack"
  edt.Common.Hint = "Comma separated list of artists names"
  edt.Text = ini.StringValue("SimilarArtists","Black")
 
  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 235, 50, 20
  edt.Caption = "Exclude genres:"
  edt.Autosize = False
 
  Set edt = ui.NewEdit(Sheet)
  edt.Common.SetRect 85, 232, 300, 20
  edt.Common.ControlName = "SAGenre"
  edt.Common.Hint = "Comma separated list of genres"
  edt.Text = ini.StringValue("SimilarArtists","Genre")
 
  Set edt = ui.NewLabel(Sheet)
  edt.Common.SetRect 5, 260, 50, 20
  edt.Caption = "Minimum rating:"
  edt.Autosize = False
 
  Set edt = ui.NewDropdown(Sheet)
  edt.Common.SetRect 85, 257, 100, 20
  edt.Common.ControlName = "SARating"   
  edt.Common.Hint = "Select minimum rating stars"
  edt.Style = 2
  edt.AddItem("0 stars")
  edt.AddItem("0.5 stars")
  edt.AddItem("1 star")
  edt.AddItem("1.5 stars")
  edt.AddItem("2 stars")
  edt.AddItem("2.5 stars")
  edt.AddItem("3 stars")
  edt.AddItem("3.5 stars")
  edt.AddItem("4 stars")
  edt.AddItem("4.5 stars")
  edt.AddItem("5 stars")
  edt.ItemIndex = ini.IntValue("SimilarArtists","Rating")\10
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 205, 260, 200, 20
  edt.Common.ControlName = "SAUnknown"
  edt.Caption = "Include unknown rating?"
  edt.Checked = ini.BoolValue("SimilarArtists","Unknown") 
 
  Set edt = ui.NewCheckBox(Sheet)
  edt.Common.SetRect 5, 285, 400, 20
  edt.Common.ControlName = "SAOnPlay"
  edt.Caption = "Automatically run the script when playing the last track?"
  edt.Checked = ini.BoolValue("SimilarArtists","OnPlay")   
End Sub

Sub AddPlaylists(drp,nam)
  'find names
  Dim dic : Set dic = CreateObject("Scripting.Dictionary")
  Call AddPlaylistsRec(dic,"")
  'sort them
  Dim i : i = 0
  Dim a : a = dic.Keys
  Dim b : b = True
  Dim m : m = ""
  While b
    b = False
    For i = 0 To UBound(a)-1
      If a(i+1) < a(i) Then
        b = True
        m = a(i)
        a(i) = a(i+1)
        a(i+1) = m
      End If
    Next
  WEnd
  'add to list
  For i = 0 To UBound(a)
    drp.AddItem(a(i))
    If a(i) = nam Then
      drp.ItemIndex = i+1
    End If
  Next
End Sub

Sub AddPlaylistsRec(dic,nam)
  Dim i : i = 0
  Dim list : Set list = SDB.PlaylistByTitle(nam)
  If Not (list Is Nothing) Then
    If Len(nam) > 0 Then
      dic.Item(nam) = nam
    End If
    Dim kids : Set kids = list.ChildPlaylists
    For i = 0 To kids.Count-1
      Call AddPlaylistsRec(dic,kids.Item(i).Title)
    Next
  End If
End Sub

Sub SaveSheet(Sheet)
  Dim ini : Set ini = SDB.IniFile
 
  ini.StringValue("SimilarArtists","Name") = Sheet.Common.ChildControl("SAName").Text
  ini.IntValue("SimilarArtists","Limit") = Sheet.Common.ChildControl("SALimit").Value
  ini.IntValue("SimilarArtists","TPA") = Sheet.Common.ChildControl("SATPA").Value
  ini.IntValue("SimilarArtists","TPL") = Sheet.Common.ChildControl("SATPL").Value
  ini.BoolValue("SimilarArtists","Confirm") = Sheet.Common.ChildControl("SAConfirm").Checked
  ini.IntValue("SimilarArtists","Toolbar") = Sheet.Common.ChildControl("SAToolbar").ItemIndex
  ini.BoolValue("SimilarArtists","Sort") = Sheet.Common.ChildControl("SASort").Checked
  ini.StringValue("SimilarArtists","Parent") = Sheet.Common.ChildControl("SAParent").Text
  ini.StringValue("SimilarArtists","Black") = Sheet.Common.ChildControl("SABlack").Text
  ini.BoolValue("SimilarArtists","Random") = Sheet.Common.ChildControl("SARandom").Checked
  ini.BoolValue("SimilarArtists","Seed") = Sheet.Common.ChildControl("SASeed").Checked
  ini.BoolValue("SimilarArtists","Best") = Sheet.Common.ChildControl("SABest").Checked
  ini.IntValue("SimilarArtists","Rating") = Sheet.Common.ChildControl("SARating").ItemIndex*10
  ini.BoolValue("SimilarArtists","Unknown") = Sheet.Common.ChildControl("SAUnknown").Checked
  ini.StringValue("SimilarArtists","Genre") = Sheet.Common.ChildControl("SAGenre").Text
  ini.BoolValue("SimilarArtists","Overwrite") = Sheet.Common.ChildControl("SAOverwrite").Checked
  ini.BoolValue("SimilarArtists","Enqueue") = Sheet.Common.ChildControl("SAEnqueue").Checked
  ini.BoolValue("SimilarArtists","Navigate") = Sheet.Common.ChildControl("SANavigate").Checked
  ini.BoolValue("SimilarArtists","OnPlay") = Sheet.Common.ChildControl("SAOnPlay").Checked
 
  If ini.BoolValue("SimilarArtists","OnPlay") Then
    Call Event_OnPlay
  End If 
 
  Dim but : Set but = SDB.Objects("SAToolbarButton")
  Dim but2 : Set but2 = SDB.Objects("SAToolbarButton2")
  If Not (but Is Nothing) And Not (but2 Is Nothing) Then
    Select Case ini.IntValue("SimilarArtists","Toolbar")
      Case 0
        but.Visible = False     
        but2.Visible = False
      Case 1
        but.Visible = True
        but2.Visible = False       
      Case 2
        but.Visible = False
        but2.Visible = True
      Case 3
        but.Visible = True
        but.Visible = True
    End Select
  End If   
End Sub

Function IsInList(lst,str)
  IsInList = False
  If str = "" Or lst = "" Then
    Exit Function
  End If
  Dim i : i = 0
  Dim tmp : tmp = UCase(str)
  Dim arr : arr = Split(lst,",")
  For i = 0 To UBound(arr)
    If UCase(arr(i)) = tmp Then
      IsInList = True
      Exit Function
    End If
  Next
End Function

Sub RandomisePlaylist(p)
  Dim t : Set t = p.Tracks
  p.Clear
  While t.Count > 0
    Dim n : n = Int(t.Count*Rnd)
    Call p.AddTrack(t.Item(n))
    Call t.Delete(n)
  WEnd
End Sub

Sub EnqueuePlaylist(p)
  Call SDB.Player.PlaylistAddTracks(p.Tracks)
End Sub

Sub NavigatePlaylist(p)
  On Error Resume Next   
  Set SDB.Objects("SimilarArtistsNode") = Nothing
  Dim node : Set node = SDB.MainTree.Node_Playlists
  If NavRec(p.Title,node) Then
    Dim n : Set n = SDB.Objects("SimilarArtistsNode")
    If Not (n Is Nothing) Then
      SDB.MainTree.CurrentNode = n
      n.Expanded = True 
    End If
  End If 
  Set SDB.Objects("SimilarArtistsNode") = Nothing
  On Error Goto 0
End Sub

Function NavRec(title,node)
  NavRec = False
  Dim exp : exp = node.Expanded
  node.Expanded = True
  If node.HasChildren = False Then
    Exit Function   
  End If
  Dim kid : Set kid = SDB.MainTree.FirstChildNode(node)
  Dim boo : boo = True
  While (boo)
    If (Err.Number = 0) And Not (kid Is Nothing) Then   
      If kid.Caption = title Then
        Set SDB.Objects("SimilarArtistsNode") = kid
        NavRec = True     
        boo = False
      Else
        If NavRec(title,kid) Then
          NavRec = True
          boo = False
        Else
          Set kid = SDB.MainTree.NextSiblingNode(kid)
        End If
      End If
    Else
      Err.Clear
      boo = False
    End If
  WEnd
  node.Expanded = exp
End Function

Sub out(txt)
  Dim wsh : Set wsh = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim loc : loc = wsh.ExpandEnvironmentStrings("%TEMP%")&"\SimilarArtists.log"
  Dim logf : Set logf = fso.OpenTextFile(loc,8,True)
  logf.WriteLine(SDB.ToAscii(txt))
  logf.Close
End Sub

Sub Install()
  Dim inip : inip = SDB.ApplicationPath&"Scripts\Scripts.ini"
  Dim inif : Set inif = SDB.Tools.IniFileByPath(inip)
  If Not (inif Is Nothing) Then
    inif.StringValue("SimilarArtists","Filename") = "Auto\SimilarArtists.vbs"
    inif.StringValue("SimilarArtists","Procname") = "SimilarArtists"
    inif.StringValue("SimilarArtists","Order") = "50"
    inif.StringValue("SimilarArtists","DisplayName") = "Similar Artists"
    inif.StringValue("SimilarArtists","Description") = "Creates a playlist of similar artists"
    inif.StringValue("SimilarArtists","Language") = "VBScript"
    inif.StringValue("SimilarArtists","ScriptType") = "0"
    SDB.RefreshScriptItems
  End If
  Call onStartup()
End Sub

[Teknojnky]

Very sweet.

Your almost there with a replacmenet/alternate implemntation of scrobblerdj...

All you need is an algorythm for selecting a random track or subset of tracks, and to auto-enqueue on the start of the last now playing track.

[holterpolter]

Great work, i like this script. Impressive how fast the playlists are created.
If you need a few ideas what you can improve for further versions.
a) There shoul be an option to create a subnode in the playlistnode called "Artist like ..." (or customize it via options) where each of the created playlists are stored to keep the original playlist node cleaner
b) a blacklist could be a nice option. If you start searching with a song from a sampler your script tries to find similar artist to "various artist" which does not make much sense.
c) a small summary screen, which tells you how many tracks your script found for a artist would be nice. Or something like this?

[Diabolic-Destiny]

sweet will use it soon

[trixmoto]

Thanks guys, I'm glad you like!

@holterpolter - suggestions noted for the next version.

[jsummers]

A big thumbs up to the script,

Comments suggestions:

1. Could there be a option / setting to have the play list randomized? Currently it plays one artist for all there songs then all songs from the next artist in the play list. I would not want to loose this but would like it if I could have it random too, just complete random order of the similar artists selected by the script.

2. Could ratings be added to the sort also, I am not sure the best way. Maybe highest rated songs from that artist or only tracks with X number of stars?

All in all I like the script very much and as usual you have found something I did not know I wanted.... needed. So for that thanks

[Big_Berny]

Sometimes it's really hard to use MM3...

[trixmoto]

Thanks, I'm glad you like. Thanks also for the suggestions, I'll see what I can do.

[Guest]

Great script. An option to restrict the number of times an artist can appear would be good too.

[trixmoto]

I'm not sure what you mean. There's both an artist limit and a tracks per artist limit - what else are you suggesting I restrict?

[JeffV64]

Trix, this is great, thanks. I have but one suggestion --- it would be great if the selected artist could be part of the list using the same rules as the rest. So for example if I create a list of artists like The White Stripes it would be great if they could also be on that list. Make sense?

Thanks again,

Jeff

EDIT: Ok, another suggestion -- wouldn't it be great if we could limit by rating? And, have an option addressing how unrated songs are handled?

My last.fm profile thanks you.

Jeff

[trixmoto]

Thanks for your suggestions, I'll look into adding these in the next release.

[trixmoto]

New version (1.1) is now available to download from my website. Changes include...

- Added option to specify the parent playlist
- Added option to specify blacklist of artists to exclude
- Added option to randomise the playlists created
- Added option to include seed artist in playlist
- Added option to select highest rated tracks
- Added option to specify minimum track rating

Hopefully this is all the current requests dealt with!

[Teknojnky]

Very nice, I forgot how cool this was.

A couple more ideas for your consideration...


* option to auto-navigate to newly created playlist (meaning open the playlist node and go to the new playlist) so you can see it
* option to automatically enqueue newly created playlist
* option to overwrite existing artist playlist

If/when you add the enqueue option, you basically have a nearly complete scrobbler dj/auto-dj replacement script... all you would need is to have it call the script on the last track playback start (and not create the playlist, instead just enqueue to now playing).

Also, one little nit pick... I like the overwrite confirmation, however the completion 'ok' dialog is a bit annoying and seemingly un-necessary

edit:
oh also, genere exclusion would nice too (to prevent podcasts and the like), although I suppose if the script is updated for mm3 the the filters could be utilized.

[trixmoto]

Ok, thanks. I'll add these suggestions to my to do list as well!

Is there any need for this script to function like ScrobblerDJ though? What would be the point, if it's getting the same information. I think if I was going to write my own Scrobbler I would make sure that the artist from TrackA (ArtistA) gave me a new artist (ArtistB) and therefore TrackB. Then I would try to ensure that ArtistC was on the similar list of both ArtistA and ArtistB. I think this would help keep music within a single genre, or switch genres more smoothly. This script doesn't really fit with this logic.