Binaryworld - URLEncodeEx - Apply URL encoding rules ... [ VB -> Internet ]

' Applies URL encoding rules to the specified Text and returns the result
' (similar to Server.URLEncode)

Public Function URLEncodeEx(ByVal Text As String) As String

  Dim abytTokens() As Byte
  Dim lngTotal As Long
  Dim lngCount As Long
  Dim astrReturn() As String
  Dim strReturn As String

  strReturn = Text

  If Trim$(strReturn) <> "" Then
    ' convert to an array
    abytTokens = StrConv(Text, vbFromUnicode)

    lngTotal = UBound(abytTokens)

    ' dimension enough space for the return
    ReDim astrReturn(lngTotal)

    For lngCount = 0 To lngTotal
      Select Case abytTokens(lngCount)
        Case 48 To 57, 65 To 90, 97 To 122
          ' don't touch alphanumeric chars
          astrReturn(lngCount) = Chr$(abytTokens(lngCount))
        Case 32
          astrReturn(lngCount) = "+"
        Case Else
          If abytTokens(lngCount) < 16 Then
            astrReturn(lngCount) = "%0" & Hex$(abytTokens(lngCount))
          Else
            astrReturn(lngCount) = "%" & Hex$(abytTokens(lngCount))
          End If
      End Select
    Next ' lngCount
    strReturn = Join(astrReturn, "")

    Erase astrReturn
    Erase abytTokens
  End If

  ' join the return tokens together
  URLEncodeEx = strReturn

End Function