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

[RedX]

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]

Now while building the toptracks it will automatically check if is in db and accessible this saves the step of matchtracks.

[Teknojnky]

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

Code: Select all

snipped

[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]

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]

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]

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]

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]

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]

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]

Hah, nice! Don't forget to credit yourself on there as well!

[Teknojnky]

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

edit: moved to first post in thread

[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]

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]

Hah, I was just looking at that.