Artist TOP TRACKS via last.fm (v1.10c) MM 2.5

Download and get help for different MediaMonkey for Windows 4 Addons.

Moderators: Peke, Gurus

RedX
Posts: 366
Joined: Wed Dec 27, 2006 10:32 am
Location: Germany

Post by RedX »

Teknojnky wrote:Why trying to query for all tracks in one query, instead of iterating thru the toptrack list and querying each individually and adding them to the matched list if we find an accessible match?
Exactly what i thought :)
replace

Code: Select all

      If Not TopTracksDict.Exists(TrackTitle)Then
      	count = count+1
      	TopTracksDict.Add count, TrackTitle
      	If count = MaxTracks Then
      		Exit For
      	End if
      End If
with

Code: Select all

      If Not TopTracksDict.Exists(TrackTitle) And InDB(artist,TrackTitle,True)=True Then
      	count = count+1
      	TopTracksDict.Add count, TrackTitle
      	If count = MaxTracks Then
      		Exit For
      	End if
      End If
and add

Code: Select all

'This function checks if a track exists in the db and also checks if is accessible
Function InDB(Artist,SongTitle,CheckAccess)
	InDB = False
	Dim SQL
	If artist <> "" Then
		SQL = "Artists.Artist = '" & artist & "' "
	End If
	If Songtitle = "" Then
		MsgBox "No track title specified!"
		Exit Function
	End If
	
	If SQL <> "" Then
		SQL = SQL & " AND songs.songtitle like '" & songtitle & "'"
	Else
		SQL = "songs.songtitle like '" & songtitle & "'"
	End If
	
	'only do for 1 item!
  Set QueryMatch = SDB.Database.QuerySongs (SQL)  
  if Not QueryMatch.EOF Then
  	If checkaccess = True Then
    	If IsAccessible(QueryMatch.item) Then
      	InDB  = True
      	Exit Function
    	End If
    Else
    	InDB = True
    	Exit Function
    End If
	End If
	InDB = False
End Function
and update in Matchtracks

Code: Select all

  Do While Not QueryMatch.EOF Or i = MaxTracks
to

Code: Select all

  Do While Not QueryMatch.EOF AND i <= MaxTracks
RedX
Posts: 366
Joined: Wed Dec 27, 2006 10:32 am
Location: Germany

Post by RedX »

Now while building the toptracks it will automatically check if is in db and accessible this saves the step of matchtracks.
Teknojnky
Posts: 5537
Joined: Tue Sep 06, 2005 11:01 pm
Contact:

Post by Teknojnky »

I must have screwed something up, I'm getting a database error, and QueryMatch is undefined in InDB() function.

Code: Select all

snipped
Last edited by Teknojnky on Sun Mar 25, 2007 3:11 am, edited 1 time in total.
RedX
Posts: 366
Joined: Wed Dec 27, 2006 10:32 am
Location: Germany

Post by RedX »

Code: Select all

'==========================================================================
'
' MediaMonkey Script
'
' NAME: TopTracks
' DESCRIPTION: Enqueue artist tracks based on last fm charts
'
' AUTHOR: Teknojnky
' DATE  : March 2007
'
' INSTALL:
' - Copy script to MM directory scripts\auto
'
' TODO:
' - configurable number of tracks to enqueue
' - configurable chart (last week or 6 months)
' - configurable by popularity or randomized
' - configurable enqueue next/last/default
' - configurable use selected or current playing
' - configurable show status progress bar'
' - check for existing duplicate tracks in now playing'

'==========================================================================
'
Option Explicit

Dim Debug, Shuffle, MaxTracks, Status

Debug = True 'pop up message boxes'
Shuffle = False 'True to shuffle the list, False for popularity'
MaxTracks = 5 'max tracks to enqueue'
Status = False 'show status progress bar'

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
   
'   Set MatchedTracks = 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)
 
  'process list and add found tracks to enqueue list'
  Set MatchedTracks = MatchTopTracks(Artist,TopTracksList)
 
  'randomize the final list if enabled'
'   If Shuffle Then MatchedTracks = ShuffleTopTracksList(MatchedTracks)
 
  'enqueue final list to now playing'
'   If MatchedTracks.count = 0 Then
'     If Debug Then msgbox ("Hmm didn't get any matched tracks to enqueue...")
'   Else
' '   SDB.PlaylistAddTracks(MatchedTracks)
'   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()")
 
  'query lastfm data feed
  Dim xmlArtistTopTracksFeedURL, xmlDoc, TopTracksDict
  xmlArtistTopTracksFeedURL = "http://ws.audioscrobbler.com/1.0/artist/" & Artist & "/toptracks.xml"
  Set xmlDoc = CreateObject("Microsoft.XMLDOM")
  Set TopTracksDict = CreateObject("Scripting.Dictionary")
  xmlDoc.Async = False 'false for simplicity'
 
  If xmlDoc.Load (xmlArtistTopTracksFeedURL) Then
    If Debug then msgbox ("artist top tracks feed loaded")
    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)
      If Not TopTracksDict.Exists(TrackTitle) And InDB(artist,TrackTitle,True)=True Then
      	count = count+1
      	TopTracksDict.Add count, TrackTitle
      	If count = MaxTracks Then
      		Exit For
      	End if
      End If
    Next
    Set GetTopTracks = TopTracksDict

		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
    End With
    MsgBox strErrText, vbExclamation
		logme "GetTopTracks exit bad"    
  End If
End Function

Function MatchTopTracks(Artist, TopTracksList)
	logme "MatchTopTracks start"
  'match up the last.fm track chart dictionary to available local library tracks'
  if debug then msgbox ("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 i: i=0
	Dim sql:sql=""
	Dim QueryMatch:QueryMatch = ""
	For i = 1 To TopTracksList.count
		If i=1 Then
				sql = "songs.songtitle LIKE '" & Toptrackslist.item(i) & "'"
		Else
				sql = sql & " OR songs.songtitle LIKE '" & Toptrackslist.item(i) & "'"
		End if
	Next
	If Debug Then MsgBox sql
	logme sql
	i=0
  Set QueryMatch = SDB.Database.QuerySongs ("AND (Artists.Artist LIKE '"&Artist & "' AND(  "& sql & "))")  
  Do While Not QueryMatch.EOF and i <= MaxTracks
    If IsAccessible(QueryMatch.item) Then
      MatchTopTracks.Add (QueryMatch.Item)
      i = i + 1
    End If
    QueryMatch.next
  Loop
  logme "MatchTopTracks exit"
End Function 

Function ShuffleTopTracksList (TopTracksList)
  'if enabled, shuffle the current toptrackslist'
  if debug then msgbox ("entering ShuffleTopTracksList()")
End Function


Function IsAccessible(SongObj)
	logme "IsAccessible start"
    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
        If Debug Then MsgBox "SongObj was empty"
        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
    'If Debug Then MsgBox "Isaccesible: " & IsAccessible & " " &songobj.title
    logme "IsAccessible exit:" & IsAccessible & " " & songobj.artistname & "-" & songobj.title
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"
	InDB = False
	Dim SQL
	If artist <> "" Then
		SQL = " AND Artists.Artist = '" & artist & "' "
	End If
	If Songtitle = "" Then
		MsgBox "No track title specified!"
		Exit Function
	End If
	
	If SQL <> "" Then
		SQL = SQL & " AND songs.songtitle like '" & songtitle & "'" 
	Else
		SQL = " AND songs.songtitle like '" & 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
	End If
	InDB = False
End Function

Sub logme(msg)
   If Debug 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
Teknojnky
Posts: 5537
Joined: Tue Sep 06, 2005 11:01 pm
Contact:

Post by Teknojnky »

Adding Dim QueryMatch to InDB()

There was a problem querying the database
42000 MS OBDC driver: syntax error (missing operator) in query expression ' Songs.IDAlbum=Albums.ID AND Songs.IDArtist AND AlbArt.ID=Albums.IDArtist
Artists.Artist = 'Metallica' AND songs.songtitle like 'Enter Sandman".
RedX
Posts: 366
Joined: Wed Dec 27, 2006 10:32 am
Location: Germany

Post by RedX »

Are you sure you copied the code from above? I don't get any error msg atm when i press the button om MM interface.

Weird. Can't help atm cause i'm off now, g2g learning :)

If you can't figure it out for yourself i can take a look at the code again in the later tonight.

Happy coding :)
Teknojnky
Posts: 5537
Joined: Tue Sep 06, 2005 11:01 pm
Contact:

Post by Teknojnky »

Yea still get problems with database error with the above copied.

I'll try to get it figured out, thanks alot for your help!

Wierd. I re copied/pasted, compacted library, restarted and now it seems to be not giving errors..

However it seems like it is still querying all tracks instead of iterating through a single track at a time.
holterpolter
Posts: 292
Joined: Wed Feb 01, 2006 7:29 am
Location: Germany

Post by holterpolter »

You have to check that there are no invalid Charakters in the Sql Query
I tried your Script and produced an error when there is an inverted comma in the SongName.
Perhaps you can replace all invalid Charakters with a wildcard.
RedX
Posts: 366
Joined: Wed Dec 27, 2006 10:32 am
Location: Germany

Post by RedX »

holterpolter wrote:You have to check that there are no invalid Charakters in the Sql Query
I tried your Script and produced an error when there is an inverted comma in the SongName.
Perhaps you can replace all invalid Charakters with a wildcard.
@holterpolter: do you mean inverted comma as a "hoch komma"? ( ' )

@Teknojnky: well actually you could remove the matchtracks part if you add make the toptracsk a playlist since almost everything that needs to be done is done there. It does not enqueue the whole list but only Maxtracks.
RedX
Posts: 366
Joined: Wed Dec 27, 2006 10:32 am
Location: Germany

Post by RedX »

Here is a working version of the script but it's still ALPHA. Many things are still missing or incomplete and all settings are edited directly in the file

It will enqueue at the end of your current playlist as default.

Just copy into your scripts/Auto folder and restart MM

http://www.frankonia-czernowitz.de/mm/TopTracks.vbs
Teknojnky
Posts: 5537
Joined: Tue Sep 06, 2005 11:01 pm
Contact:

Post by Teknojnky »

Hah, nice! Don't forget to credit yourself on there as well! 8)
Teknojnky
Posts: 5537
Joined: Tue Sep 06, 2005 11:01 pm
Contact:

Post by Teknojnky »

Ok, hacked on it some more from RedX's last post.

edit: moved to first post in thread
Teknojnky
Posts: 5537
Joined: Tue Sep 06, 2005 11:01 pm
Contact:

Post by Teknojnky »

Looks it fails on certain artists, I'm thinking its either the last.fm url or query.

example:

Crosby, Stills, Nash & Young


edit: looks like the url as the last.fm feed doesnt appear to return anything.
RedX
Posts: 366
Joined: Wed Dec 27, 2006 10:32 am
Location: Germany

Post by RedX »

Problem fixed.
(Use URLEncode)

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
Teknojnky
Posts: 5537
Joined: Tue Sep 06, 2005 11:01 pm
Contact:

Post by Teknojnky »

Hah, I was just looking at that.
Post Reply