Binaryworld - HTMLEncodeEx - Applies HTML encoding rules to the specified Text ... [ VB -> Internet ]

' Applies HTML encoding rules to the specified Text and returns the result
'
' Optionally specify if we're encoding a HREF link and the character
' to use for encoding - the default is the standard ampersand
' e.g. Server.HTMLEncode
' i.e. Call MsgBox(HTMLEncodeEx("<Sample HTML encoded text>"))

Public Function HTMLEncodeEx(ByVal Text As String, Optional ByVal vfHREFEncode _
  As Boolean = False, Optional ByVal vstrAmpChar 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 32
          If vfHREFEncode Then
            astrReturn(lngCount) = "%20"
          Else
            astrReturn(lngCount) = vstrAmpChar & "nbsp;"
          End If
        Case 34
          astrReturn(lngCount) = vstrAmpChar & "quot;"
        Case 38
          astrReturn(lngCount) = vstrAmpChar & "amp;"
        Case 60
          astrReturn(lngCount) = vstrAmpChar & "lt;"
        Case 62
          astrReturn(lngCount) = vstrAmpChar & "gt;"
        Case 32 To 127
          ' don't touch alphanumeric chars
          astrReturn(lngCount) = Chr$(abytTokens(lngCount))
        Case Else
          astrReturn(lngCount) = vstrAmpChar & "#" & CStr(abytTokens _
            (lngCount)) & ";"
      End Select
    Next ' lngCount
    strReturn = Join(astrReturn, "")

    Erase astrReturn
  End If

  ' join the return tokens together
  HTMLEncodeEx = strReturn

End Function