VB6 - URLencode & URLdecode

[Merri]

URLencode and URLdecode are functions that take a string and convert it to/from string that can be used as a GET item or it's value in a URL.

Rules:
A-Z, a-z and 0-9 are retained as-is
Space is converted to + (but %20 is also valid)
Any other character is converted to two character hex number prepended with a %
Optional: Unicode characters support (all versions below are ANSI only)



Make shorter than these:Public Function URLdecshort(ByRef Text As String) As String
Dim strArray() As String, lngA As Long
strArray = Split(Replace(Text, "+", " "), "%")
For lngA = 1 To UBound(strArray)
strArray(lngA) = Chr$("&H" & Left$(strArray(lngA), 2)) & Mid$(strArray(lngA), 3)
Next lngA
URLdecshort = Join(strArray, vbNullString)
End Function

Public Function URLencshort(ByRef Text As String) As String
Dim lngA As Long, strChar As String
For lngA = 1 To Len(Text)
strChar = Mid$(Text, lngA, 1)
If strChar Like "[A-Za-z0-9]" Then
ElseIf strChar = " " Then
strChar = "+"
Else
strChar = "%" & Right$("0" & Hex$(Asc(strChar)), 2)
End If
URLencshort = URLencshort & strChar
Next lngA
End Function


Make faster than these:Public Function URLdecode(ByRef Text As String) As String
Const Hex = "0123456789ABCDEF"
Dim lngA As Long, lngB As Long, lngChar As Long, lngChar2 As Long
URLdecode = Text
lngB = 1
For lngA = 1 To LenB(Text) - 1 Step 2
lngChar = Asc(MidB$(URLdecode, lngA, 2))
Select Case lngChar
Case 37
lngChar = InStr(Hex, MidB$(Text, lngA + 2, 2)) - 1
If lngChar >= 0 Then
lngChar2 = InStr(Hex, MidB$(Text, lngA + 4, 2)) - 1
If lngChar2 >= 0 Then
MidB$(URLdecode, lngB, 2) = Chr$((lngChar * &H10&) Or lngChar2)
lngA = lngA + 4
Else
If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
End If
Else
If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
End If
Case 43
MidB$(URLdecode, lngB, 2) = " "
Case Else
If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
End Select
lngB = lngB + 2
Next lngA
URLdecode = LeftB$(URLdecode, lngB - 1)
End Function

Public Function URLencode(ByRef Text As String) As String
Const Hex = "0123456789ABCDEF"
Dim lngA As Long, lngChar As Long
URLencode = Text
For lngA = LenB(URLencode) - 1 To 1 Step -2
lngChar = Asc(MidB$(URLencode, lngA, 2))
Select Case lngChar
Case 48 To 57, 65 To 90, 97 To 122
Case 32
MidB$(URLencode, lngA, 2) = "+"
Case Else
URLencode = LeftB$(URLencode, lngA - 1) & "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1) & MidB$(URLencode, lngA + 2)
End Select
Next lngA
End Function


Code for timing:Option Explicit

Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean

Dim m_Time As Double
Dim m_TimeFreq As Double
Dim m_TimeStart As Currency

Public Property Get Timing() As Double
Dim curTime As Currency
QueryPerformanceCounter curTime
Timing = (curTime - m_TimeStart) * m_TimeFreq + m_Time
End Property

Public Property Let Timing(ByVal NewValue As Double)
Dim curFreq As Currency, curOverhead As Currency
m_Time = NewValue
QueryPerformanceFrequency curFreq
m_TimeFreq = 1 / curFreq
QueryPerformanceCounter curOverhead
QueryPerformanceCounter m_TimeStart
m_TimeStart = m_TimeStart + (m_TimeStart - curOverhead)
End Property

Timing usage:' before benchmark
Timing = 0

' after benchmark
Debug.Print "Result: " & Format$(Timing, "0.000000")


As far as I know, you can make a shorter code than the first two examples above and you can also make (much) faster than the next two examples above :)

[dilettante]

You can also do this via API calls, with some interesting differences. See the comments in URLUtility.cls for one oddity.

I haven't timed this, but without the hack for "space to +" encoding it should be reasonably quick.

[batori]

Great!