VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Historie
30.07.2004	Code um 30-40% beschleunigt (nach Denkanstoss von Elmar Denkmann)
15.05.2002	Code an die fehlerhafte Replace-Funktion von VB6 angepaßt
03.07.2001	Hilfsfunktion Hex2 optimiert
28.05.2001	Umkehrfunktionen: HTMLDecode und URLDecode
10.05.2001	Korrektur: HTML-Encode für Zeichen mit Asc>=160 (Hinweis von Ralf Neas)
30.04.2001	Erste Version (nach einer Idee von Francesco Balena)

Einleitung

Motivation

Sollen HTML-Seiten aus einem VB-Programm (oder aus einem ASP-Skript) heraus generiert werden, oder soll eine andere Internet-Seite mit Parametern aufgerufen werden (s.a. HTML-Formulare mit VB ausfüllen), so müssen in HTML bzw. URL reservierte Sonderzeichen durch spezielle Codes ersetzt werden.

In ASP selbst gibt es dafür die Methoden des globalen Server-Objekts. (Aber auch dort fehlen die Umkehrfunktionen!)

Für VB müssen wir uns etwas anderes einfallen lassen: Mit den unten vorgestellten Routinen wird ein übergebener Text ebenso wie unter ASP ersetzt (ich empfehle übrigens meine schnelle Replace-Funktion).

Beispiele

MsgBox HTMLEncode("Hallo<ß") 'Hallo&lt;&#223;'
MsgBox HTMLDecode("Hallo&lt;&#223;") 'Hallo<ß'
MsgBox URLEncode("Hallo/ß Welt") 'Hallo%2F%DF+Welt'
MsgBox URLPathEncode("Hallo/ß Welt") 'Hallo/%DF%20Welt'
MsgBox URLDecode("Hallo+Welt%21") 'Hallo Welt!'
MsgBox URLPathDecode("Hallo+Welt%21") 'Hallo+Welt!'

Code für HTML-Kodierung

HTMLEncode - Text HTML-konform konvertieren

Diese Funktion kodiert einen Text derart, dass er innerhalb von HTML-Tags stehen kann:

' ©2004 by Jost Schwider, http://vb-tec.de/
Public Function HTMLEncode(ByRef Text As String) As String

  Dim i As Long
  Dim Char As Integer

  'HTML-Spezies ersetzen:
  HTMLEncode = Text
  ReplaceDo HTMLEncode, "&", "&"
  ReplaceDo HTMLEncode, """", """
  ReplaceDo HTMLEncode, "<", "&lt;"
  ReplaceDo HTMLEncode, ">", "&gt;"

  'Sonderzeichen durch Asc-Code ersetzen:
  For i = Len(HTMLEncode) To 1 Step -1

    Char = Asc(Mid$(HTMLEncode, i, 1))
    Select Case Char: Case Is < 32, Is >= 160

      HTMLEncode _
        = Left$(HTMLEncode, i - 1) _
        & "&#" & Char & ";" _
        & Mid$(HTMLEncode, i + 1)

    End Select

  Next i

End Function

HTMLDecode - HTML-Text in Klartext konvertieren

Diese Funktion ist die Umkehrfunktion zu der gerade gezeigten HTMLEncode-Funktion:

' ©2004 by Jost Schwider, http://vb-tec.de/
Public Function HTMLDecode(ByRef Text As String) As String

  Dim i As Long
  Dim j As Long

  'Ascii-Codes restaurieren:
  HTMLDecode = Text
  i = InStr(Text, "&#") + 2
  Do While i > 2

    j = InStr(i, HTMLDecode, ";")
    If j = 0 Then Exit Do
    Select Case j - i: Case 1 To 3

      HTMLDecode _
        = Left$(HTMLDecode, i - 3) _
        & Chr$(Val(Mid$(HTMLDecode, i, j - i))) _
        & Mid$(HTMLDecode, j + 1)

    End Select
    i = InStr(j, HTMLDecode, "&#") + 2

  Loop

  'HTML-Spezies ersetzen:
  ReplaceDo HTMLDecode, ">", ">"
  ReplaceDo HTMLDecode, "&lt;", "<"
  ReplaceDo HTMLDecode, "&quot;", """"
  ReplaceDo HTMLDecode, "&amp;", "&"


End Function

Code für URL-Kodierung

URLEncode - Text für URL-Parameter konvertieren

Diese Funktion kodiert einen Text derart, dass er als Parameter in einer URL stehen kann (vgl. etwa "Bankleitzahlen und co."):

' ©2004 by Jost Schwider, http://vb-tec.de/
Public Function URLEncode(ByRef Text As String) As String

  Dim i As Long
  Dim Char As Integer

  URLEncode = Text
  For i = Len(Text) To 1 Step -1

    Char = Asc(Mid$(Text, i, 1))
    Select Case Char
    Case 97 To 122, 48 To 57, 65 To 90
      'Kleinbuchstaben, Zahlen und Großbuchstaben
    Case 32

      'Leerzeichen durch "+" ersetzen:
      Mid$(URLEncode, i, 1) = "+"

    Case Else

      'Sonderzeichen durch Hex-Code ersetzen:
      URLEncode _
        = Left$(Text, i - 1) _
        & ("%" & Hex2(Char)) _
        & Mid$(URLEncode, i + 1)

    End Select

  Next i

End Function

URLPathEncode - Text URL-konform konvertieren

Diese Funktion kodiert einen Text derart, dass er als Pfad in einer URL (etwa bei href oder mailto) stehen kann:

' ©2004 by Jost Schwider, http://vb-tec.de/
Public Function URLPathEncode(ByRef Text As String) As String

  Dim i As Long
  Dim Char As Integer

  URLPathEncode = Text
  For i = Len(Text) To 1 Step -1

    Char = Asc(Mid$(Text, i, 1))
    Select Case Char
    Case 97 To 122, 48 To 57, 65 To 90
      'Kleinbuchstaben, Zahlen und Großbuchstaben
    Case 45 To 47, 95, 126, 38, 58, 63, 64, 35, 33, 36, 42, 43
      'Andere erlaubte Zeichen: -./_~&:?@#!$*+
    Case Else

      'Sonderzeichen durch Hex-Code ersetzen:
      URLPathEncode _
        = Left$(Text, i - 1) _
        & ("%" & Hex2(Char)) _
        & Mid$(URLPathEncode, i + 1)

    End Select

  Next i

End Function

URLPathDecode - URL-Pfad in Klartext konvertieren

Diese Funktion ist die Umkehrfunktionen zur gerade gezeigten URLPathEncode-Funktion:

' ©2004 by Jost Schwider, http://vb-tec.de/
Public Function URLPathDecode(ByRef Text As String) As String

  Dim i As Long
  
  URLPathDecode = Text
  i = InStr(Text, "%")
  Do While i
  
    URLPathDecode _
      = Left$(URLPathDecode, i - 1) _
      & Chr$(Val("&H" & Mid$(URLPathDecode, i + 1, 2))) _
      & Mid$(URLPathDecode, i + 3)
    i = InStr(i + 1, URLPathDecode, "%")
  
  Loop

End Function

URLDecode - URL-Parameter in Klartext konvertieren

Diese Funktion ist die Umkehrfunktionen zur oben gezeigten URLEncode-Funktion:

' ©2004 by Jost Schwider, http://vb-tec.de/
Public Function URLDecode(ByRef Text As String) As String
  URLDecode = URLPathDecode(Replace(Text, "+", " "))
End Function

Man beachte, dass URLDecode wie URLPathDecode funktioniert, nur dass vorher alle "+" durch Leerzeichen ersetzt werden.

Hilfsfunktion

Hex2 - Zahl in 2-stelligen Hexcode konvertieren

Diese Funktion wandelt eine Ganzzahl in eine zweistellige Hex-Zahl um:

' ©2004 by Jost Schwider, http://vb-tec.de/
Public Function Hex2(ByVal n As Long) As String

  If n And &HF0& Then
    Hex2 = Hex$(n)
  Else
    Hex2 = "0" & Hex$(n)
  End If

End Function