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:
Code:
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:
Code:
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:
Code:
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:
Code:
' 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
It doesn't appear that any of the code above handles URLs that are encoded as UTF-8 before URL Encoding. UTF-8 is now common and standard, so be cautious.
The API calls I used don't help either, the flag needed to support UTF-8 doesn't exist until Windows 8.
I wrote a URLencode function that supports UTF8 heavily modified and tweaked from an example i found on the web. I managed to more than double the speed of the original code. As you can see it is only about 10 nanoseconds slower than the non-UTF8 functions. Dillantes API code is the fastest at the cost of no UTF8 support. I also tweaked Merri's example but only made minimal gains since URLs are generally only 50-100 characters and string caching gains arent noticeable on small data. I will edit once i get a decode function written with UTF8 support.
UTF8 encode
Code:
Public Function URLEncode_UTF8(ByVal sText As String) As String
Dim x1 As Long
Dim x2 As Long
Dim Chars() As Byte
Dim Byte1 As Byte
Dim Byte2 As Byte
Dim UTF16 As Long
For x1 = 1 To Len(sText)
CopyMemory Byte1, ByVal StrPtr(sText) + ((x1 - 1) * 2), 1
CopyMemory Byte2, ByVal StrPtr(sText) + ((x1 - 1) * 2) + 1, 1
UTF16 = Byte2 * 256 + Byte1
If UTF16 < &H80 Then
ReDim Chars(0) As Byte
Chars(0) = UTF16
ElseIf UTF16 < &H800 Then
ReDim Chars(1) As Byte
Chars(1) = &H80 + (UTF16 And &H3F)
UTF16 = UTF16 \ &H40
Chars(0) = &HC0 + (UTF16 And &H1F)
Else
ReDim Chars(2) As Byte
Chars(2) = &H80 + (UTF16 And &H3F)
UTF16 = UTF16 \ &H40
Chars(1) = &H80 + (UTF16 And &H3F)
UTF16 = UTF16 \ &H40
Chars(0) = &HE0 + (UTF16 And &HF)
End If
For x2 = 0 To UBound(Chars)
Select Case Chars(x2)
Case 48 To 57, 65 To 90, 97 To 122
URLEncode_UTF8 = URLEncode_UTF8 & Chr$(Chars(x2))
Case Else
URLEncode_UTF8 = URLEncode_UTF8 & ("%" & Hex$(Chars(x2)))
End Select
Next
Next
End Function
Tweaked Merri code
Code:
Public Function URLEncode(ByVal sText As String) As String
Const Hex As String = "0123456789ABCDEF"
Dim X As Long, lngChar As Long, lLen As Long, lIndex As Long
lLen = Len(sText)
URLEncode = Space$(lLen * 3)
lIndex = 1
For X = 1 To lLen
lngChar = Asc(Mid$(sText, X, 1))
Select Case lngChar
Case 48 To 57, 65 To 90, 97 To 122
Mid(URLEncode, lIndex, 1) = Chr$(lngChar)
lIndex = lIndex + 1
Case 32
Mid$(URLEncode, lIndex, 1) = "+"
lIndex = lIndex + 1
Case Else
Mid(URLEncode, lIndex, 3) = "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1)
lIndex = lIndex + 3
End Select
Next X
URLEncode = Left$(URLEncode, lIndex - 1)
End Function
I haven't timed it, but an alternative way to decoding the hex part might be the following:
(this is slower if Instr is faster then Asc in combination with the extra Select Case's)
Code:
'--------------------------------------------------------------
'Get next character to check if it's a hexadecimal character
lngChar = Asc(MidB$(Text, lngA + 2, 2))
Select Case lngChar
'--------------------------------------------------------------
'0-9/A-F/a-f
Case 48 To 57, _
65 To 70, _
97 To 102
'--------------------------------------------------------------
'Convert character back to number
Select Case lngChar
Case Is < 65: lngChar = lngChar - 48
Case Is < 97: lngChar = lngChar - 55 'A=10 (-65 would make it 0)
Case Else: lngChar = lngChar - 87 'a=10 (-97 would make it 0)
End Select
'--------------------------------------------------------------
'Get next character to check if it's a hexadecimal character
lngChar2 = Asc(MidB$(Text, lngA + 4, 2))
Select Case lngChar2
'--------------------------------------------------------------
'0-9/A-F/a-f
Case 48 To 57, _
65 To 70, _
97 To 102
'--------------------------------------------------------------
'Convert character back to number
Select Case lngChar2
Case Is < 65: lngChar2 = lngChar2 - 48
Case Is < 97: lngChar2 = lngChar2 - 55 'A=10 (-65 would make it 0)
Case Else: lngChar2 = lngChar2 - 87 'a=10 (-97 would make it 0)
End Select
'--------------------------------------------------------------
'add converted character
MidB$(URLdecode, lngB, 2) = Chr$((lngChar * &H10&) Or lngChar2)
lngA = lngA + 4
'--------------------------------------------------------------
'%
Case Else
'--------------------------------------------------------------
'Add original character
If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
End Select
'--------------------------------------------------------------
'%
Case Else
If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
End Select