Need help optimizing URLEncode, or rewriting it
Hey, check out the following function. I did some testing on it and I think it could be a little faster. Now I don't know what else I can do to make it faster. I tried replacing the StrConv function to CopyMemoryStringToAny, and that did VERY LITTLE difference on a 100000 loop (like 100 ms at the most). Is there a better way to do it all together?
VB Code:
Public Function UrlEncode(ByVal urlText As String) As String
Dim ANSI() As Byte
Dim ASCII As Long
Dim encText As String
Dim I As Long
On Error GoTo UrlEncode_Error
ANSI = StrConv(urlText, vbFromUnicode)
For I = 0 To UBound(ANSI)
ASCII = (ANSI(I) + 2) Mod 256 'Roll over back to 0 past 255, else HEX and CHR won't work
Select Case ASCII
Case 48 To 57, 65 To 90, 97 To 122 'Letters and Numbers
encText = encText & Chr(ASCII)
Case 32 'Spaces
encText = encText & "+"
Case 0 To 16 'Low Hex characters
encText = encText & "%0" & Hex(ASCII)
Case Else 'Special Characters
encText = encText & "%" & Hex(ASCII)
End Select
Next I
UrlEncode = encText
Exit Function
UrlEncode_Error:
MsgBox "Error #:" & Err.Number & vbCrLf & "Procedure [UrlEncode] of Module [mNetFunctions]" & vbCrLf & "Description: " & Err.Description, vbOKOnly, "Error Handling"
End Function
Re: Need help optimizing URLEncode, or rewriting it
have you seen:
http://vbnet.mvps.org/index.html?cod...apicompare.htm
then navigate to code library, internet, look for article called :
UrlCanonicalize: Proper URL Path Encoding and Decoding
Re: Need help optimizing URLEncode, or rewriting it
I don't know why your adding 2 on this line: ASCII = (ANSI(I) + 2) Mod 256, but assuming that you need to do that for some reason I would use the following code since the big bulk is the string concatenation (my changes is shown in bold).
VB Code:
Public Function UrlEncode(ByVal urlText As String) As String
Dim ANSI() As Byte
Dim ASCII As Long
Dim encText As String
Dim I As Long
[b] Dim nPos As Long [/b]
On Error GoTo UrlEncode_Error
[b] encText = Space$(Len(urlText) * 3) 'create a buffer big enough for the result
nPos = 1[/b]
ANSI = StrConv(urlText, vbFromUnicode)
For I = 0 To UBound(ANSI)
ASCII = (ANSI(I) + 2) Mod 256 'Roll over back to 0 past 255, else HEX and CHR won't work
Select Case ASCII
Case 48 To 57, 65 To 90, 97 To 122 'Letters and Numbers
[b] Mid(encText, nPos) = Chr(ASCII)
nPos = nPos + 1 [/b]
Case 32 'Spaces
[b] Mid(encText, nPos) = "+"
nPos = nPos + 1 [/b]
Case 0 To [b]15[/b] 'Low Hex characters [b](16 is 10 in hex)[/b]
[b] Mid(encText, nPos) = "%0"
Mid(encText, nPos + 2) = Hex(ASCII)
nPos = nPos + 3 [/b]
Case Else 'Special Characters
[b] Mid(encText, nPos) = "%"
Mid(encText, nPos + 1) = Hex(ASCII)
nPos = nPos + 3 [/b]
End Select
Next I
UrlEncode =[b] Left$(encText, nPos - 1)[/b]
Exit Function
UrlEncode_Error:
MsgBox "Error #:" & Err.Number & vbCrLf & "Procedure [UrlEncode] of Module [mNetFunctions]" & vbCrLf & "Description: " & Err.Description, vbOKOnly, "Error Handling"
End Function
The above should run a lot quicker.
Re: Need help optimizing URLEncode, or rewriting it
Awesome, thx, i'll test it out and respost my timing results. I never even knew that mid could be assigned a value! LOL i'm a nooob once again!
Re: Need help optimizing URLEncode, or rewriting it
You can also always get entirely rid of the slow string processing routines, such as Mid$:
VB Code:
Public Function URLencode_Merri(ByRef URL As String) As String
Static barOut() As Byte, barURL() As Byte
Dim lngA As Long, bytChar As Byte, bytNew As Byte, lngPos As Long
' check length
If LenB(URL) = 0 Then Exit Function
' convert input string to byte array
barURL = URL
' reserve space for output string
ReDim Preserve barOut(LenB(URL) * 3 - 1)
' happily loop ever after
For lngA = 0 To UBound(barURL) Step 2
' minimal optimization trick
bytChar = barURL(lngA)
' check what we have here
Select Case bytChar
' numbers and letters
Case 48 To 57, 65 To 90, 97 To 122
barOut(lngPos) = bytChar
lngPos = lngPos + 2
' space
Case 32
barOut(lngPos) = 43 ' "+"
lngPos = lngPos + 2
' anything else
Case Else
barOut(lngPos) = 37 ' "%"
' four upper bits
bytNew = ((bytChar And &HF0) \ &H10) Or 48
If bytNew < 58 Then
barOut(lngPos + 2) = bytNew
Else
barOut(lngPos + 2) = bytNew + 7
End If
' four lower bits
bytNew = (bytChar And &HF) Or 48
If bytNew < 58 Then
barOut(lngPos + 4) = bytNew
Else
barOut(lngPos + 4) = bytNew + 7
End If
' next starting position
lngPos = lngPos + 6
End Select
Next lngA
' error check
If lngPos = 0 Then Exit Function
' resize output
ReDim Preserve barOut(lngPos - 1)
' convert output to a string
URLencode_Merri = CStr(barOut)
End Function
Compile and you're closer to programmer's heaven. Closer, but not there.
If you still need more...
VB Code:
Option Explicit
Dim URLencode_table(255) As Byte
Dim HexTableUpper(255) As Byte
Dim HexTableLower(255) As Byte
Public Sub Init_URLencode_table()
Dim bytNew As Byte, lngA As Long
For lngA = 0 To 255
Select Case lngA
Case 48 To 57, 65 To 90, 97 To 122
URLencode_table(lngA) = CByte(lngA)
Case 32
URLencode_table(lngA) = 43
Case Else
URLencode_table(lngA) = 37
End Select
bytNew = ((lngA And &HF0) \ &H10) Or 48
If bytNew < 58 Then
HexTableUpper(lngA) = bytNew
Else
HexTableUpper(lngA) = bytNew + 7
End If
bytNew = (lngA And &HF) Or 48
If bytNew < 58 Then
HexTableLower(lngA) = bytNew
Else
HexTableLower(lngA) = bytNew + 7
End If
Next lngA
End Sub
Public Function URLencode_Merri(ByRef URL As String) As String
Static barOut() As Byte, barURL() As Byte
Dim lngA As Long, bytChar As Byte, lngPos As Long
' init the table we need
If URLencode_table(0) = 0 Then Init_URLencode_table
' check length
If LenB(URL) = 0 Then Exit Function
' convert input string to byte array
barURL = URL
' reserve space for output string
ReDim Preserve barOut(LenB(URL) * 3 - 1)
' happily loop ever after
For lngA = 0 To UBound(barURL) Step 2
bytChar = URLencode_table(barURL(lngA))
barOut(lngPos) = bytChar
If bytChar <> 37 Then
lngPos = lngPos + 2
Else
barOut(lngPos + 2) = HexTableUpper(barURL(lngA))
barOut(lngPos + 4) = HexTableLower(barURL(lngA))
lngPos = lngPos + 6
End If
Next lngA
' error check
If lngPos = 0 Then Exit Function
' resize output
ReDim Preserve barOut(lngPos - 1)
' convert output to a string
URLencode_Merri = CStr(barOut)
End Function
Minimizing all calculations within the loop.
Re: Need help optimizing URLEncode, or rewriting it
Wow, truely amazing code by both of you guys. Ranked by speed, Merri's was slightly faster for 10000 executions by 70 ms (at 430 ms on my CPU), and joacim's ran at 500ms on my cpu, and mine runs at 640. so basically i cut down 200 ms for 10000 records. I don't think I'll be processing that much, but evey bit helps. thanks to both of you!
Re: Need help optimizing URLEncode, or rewriting it
I assume you didn't try it compiled with all advanced optimizations turned on, because on my computer it handled 10000 urls in 30 ms when I did that :)
