Page 2 of 5
Posted: Sat Mar 24, 2007 8:38 am
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
Posted: Sat Mar 24, 2007 8:42 am
by RedX
Now while building the toptracks it will automatically check if is in db and accessible this saves the step of matchtracks.
Posted: Sat Mar 24, 2007 8:53 am
by Teknojnky
I must have screwed something up, I'm getting a database error, and QueryMatch is undefined in InDB() function.
Posted: Sat Mar 24, 2007 8:56 am
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
Posted: Sat Mar 24, 2007 9:00 am
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".
Posted: Sat Mar 24, 2007 9:09 am
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

Posted: Sat Mar 24, 2007 9:11 am
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.
Posted: Sat Mar 24, 2007 9:52 am
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.
Posted: Sat Mar 24, 2007 3:12 pm
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.
Posted: Sat Mar 24, 2007 4:43 pm
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
Posted: Sat Mar 24, 2007 10:45 pm
by Teknojnky
Hah, nice! Don't forget to credit yourself on there as well!

Posted: Sun Mar 25, 2007 4:46 am
by Teknojnky
Ok, hacked on it some more from RedX's last post.
edit: moved to first post in thread
Posted: Sun Mar 25, 2007 8:38 pm
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.
Posted: Sun Mar 25, 2007 8:49 pm
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
Posted: Sun Mar 25, 2007 8:59 pm
by Teknojnky
Hah, I was just looking at that.