Private Sub Command1_Click()
 
Dim Text As String
Text = Text1.Text
Text2.Text = HTMLEncode(Text)
 
End Sub
 
Public Function HTMLEncode(StringToEncode As String, Optional _
  UsePlusRatherThanHexForSpace As Boolean = False) As String
 
  Dim TempAns As String
TempAns = StringToEncode
Dim lngLastDoEvents As Long
Dim CurChr As Long
  For CurChr = 1 To Len(StringToEncode)
    Select Case Asc(Mid$(StringToEncode, CurChr, 1))
      Case 0 To 9, 11 To 12, 14 To 20, 22 To 31
        TempAns = TempAns & Mid$(StringToEncode, CurChr, 1)
      Case 32, 10, 13
        If UsePlusRatherThanHexForSpace = True Then
          TempAns = TempAns & "+"
        Else
          TempAns = TempAns & "%" & Hex(32)
          TempAns = TempAns & "%0" & Hex(10)
          TempAns = TempAns & "%0" & Hex(13)
        End If
 
      Case Else
        TempAns = TempAns & "%" & Hex(Asc(Mid$(StringToEncode, CurChr, 1)))
    End Select
    If CurChr - lngLastDoEvents > 100 Then
        DoEvents
        Label1.Caption = Format((100 / Len(StringToEncode)) * CurChr, "00.00") _
          & " Prozent"
        ProgressBar1.Value = (100 / Len(StringToEncode)) * CurChr
        lngLastDoEvents = CurChr
    End If
    Next CurChr
HTMLEncode = TempAns
Label1.Caption = "Fertig"
ProgressBar1.Value = 100
End Function