Need help optimizing URLEncode, or rewriting it

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