Need help optimizing URLEncode, or rewriting it

[INF3RN0666]

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?

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

[rnd me]

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

[Joacim Andersson]

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).

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.

[INF3RN0666]

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!

[Merri]

You can also always get entirely rid of the slow string processing routines, such as Mid$:

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...

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.

[INF3RN0666]

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!

[Merri]

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