HTML Encoding

sorry - mener selvfølgelig HTTP encoding

Er det ikke URLEncode() eller URLDecode() du mener?


Public Function URLDecode(ByVal strUrl As String) As String
Dim ci As Integer
Dim strOut As String
Dim strOne As String
  While Not (ci >= Len(strUrl))
    ci = ci + 1
    strOne = Mid$(strUrl, ci, 1)
    Select Case strOne
          Case "+"
            strOut = strOut & " "
          Case "%"
            ci = ci + 1
            strOut = strOut & _
            Chr$(CLng("&H" & Mid$(strUrl, ci, 2)))
            ci = ci + 1
          Case Else
            strOut = strOut & strOne
    End Select
  Wend
URLDecode = strOut
End Function

Public Function URLEncode(ByVal bstrIn As String) As String
Dim i      As Long
Dim lngHex As Long
Dim strHex As String
Dim strOne As String
  For i = Len(bstrIn) To 1 Step -1
    strOne = Mid$(bstrIn, i, 1)
    Select Case Asc(UCase$(strOne))
          Case vbKey0 To vbKey9, vbKeyA To vbKeyZ
          Case 32
            Mid$(bstrIn, i, 1) = "+"
          Case Else
            lngHex = Asc(strOne)
            If lngHex And &HF0& Then
              strHex = ("%" & Hex$(lngHex))
                Else
              strHex = ("%0" & Hex$(lngHex))
            End If
            bstrIn = Left$(bstrIn, i - 1) & strHex & _
                    Mid$(bstrIn, i + 1)
    End Select
  Next i
URLEncode = bstrIn
End Function

Ellers er den her..

Public Function HTMLEncode(ByVal bstrIn As String) As String
Dim i As Long
Dim Ascii As Long
  i = InStr(bstrIn, "&")
  If i Then bstrIn = Replace(bstrIn, "&", "&", i)
  i = InStr(bstrIn, """")
  If i Then bstrIn = Replace(bstrIn, """", """, i)
  i = InStr(bstrIn, "<")
  If i Then bstrIn = Replace(bstrIn, "<", "&lt;", i)
  i = InStr(bstrIn, ">")
  If i Then bstrIn = Replace(bstrIn, ">", "&gt;", i)
  For i = Len(bstrIn) To 1 Step -1
    Ascii = Asc(Mid$(bstrIn, i, 1))
    If Ascii >= 160 Then
      bstrIn = Left$(bstrIn, i - 1) & "&#" & CStr(Ascii) & ";" & Mid$(bstrIn, i + 1)
    End If
  Next i
HTMLEncode = bstrIn
End Function

Sker der noget her...

Undskyld ventetiden. Det var denne løsning jeg var ude efter:

Function escapeString(aStr As String) As String
    Dim validChars As String
    Dim i As Integer
   
    validChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-%@*/_."
   
    aStr = replaceSubstring(aStr, "%", "%" + Hex$(Asc("%")))
   
    i = 1
    While i <= Len(aStr)
        If InStr(validChars, Mid$(aStr, i, 1)) = 0 Then
            If Asc(Mid$(aStr, i, 1)) < 32 Then
                aStr = Mid$(aStr, 1, i - 1) + Mid$(aStr, i + 1, Len(aStr) - i)
            Else
                aStr = Mid$(aStr, 1, i - 1) + "%" + Hex$(Asc(Mid$(aStr, i, 1))) + Mid$(aStr, i + 1, Len(aStr) - i)
                i = i + 3
            End If
        Else
            i = i + 1
        End If
    Wend
   
    escapeString = aStr
End Function

Function replaceSubstring(source As String, fromStr As String, toStr As String) As String
    Dim i As Integer
    Dim temp As String
   
    temp = source
    If fromStr <> "" Then
        If fromStr <> toStr Then
            i = InStr(temp, fromStr)
            While i <> 0
                If toStr <> "" Then
                    temp = Left$(temp, i - 1) + toStr + Right$(temp, Len(temp) - i - Len(fromStr) + 1)
                Else
                    temp = Left$(temp, i - 1) + Right$(temp, Len(temp) - i - Len(fromStr) + 1)
                End If
               
                i = InStr(i + Len(toStr), temp, fromStr)
            Wend
        End If
    End If
    replaceSubstring = temp
End Function

Men da jeg har formuleret mig temmelige ringe ;o) så får du dine point alligevel.

Hvorfor virker dette ikke?

<form name="form1" method="post" action="decode.asp">
  <p>
    <textarea name="indput" wrap="VIRTUAL" id="indput"></textarea>
    <input type="submit" name="Submit" value="overs&aelig;t">
  </p>
  <p>
    <textarea name="textarea2" wrap="VIRTUAL"><%response.Write(escapeString(request.form("indput")))%>
</textarea>
  </p>
</form>

<%
Function escapeString(aStr As String) As String
    Dim validChars As String
    Dim i As Integer
   
    validChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-%@*/_."
   
    aStr = replaceSubstring(aStr, "%", "%" + Hex$(Asc("%")))
   
    i = 1
    While i <= Len(aStr)
        If InStr(validChars, Mid$(aStr, i, 1)) = 0 Then
            If Asc(Mid$(aStr, i, 1)) < 32 Then
                aStr = Mid$(aStr, 1, i - 1) + Mid$(aStr, i + 1, Len(aStr) - i)
            Else
                aStr = Mid$(aStr, 1, i - 1) + "%" + Hex$(Asc(Mid$(aStr, i, 1))) + Mid$(aStr, i + 1, Len(aStr) - i)
                i = i + 3
            End If
        Else
            i = i + 1
        End If
    Wend
   
    escapeString = aStr
End Function

Function replaceSubstring(source As String, fromStr As String, toStr As String) As String
    Dim i As Integer
    Dim temp As String
   
    temp = source
    If fromStr <> "" Then
        If fromStr <> toStr Then
            i = InStr(temp, fromStr)
            While i <> 0
                If toStr <> "" Then
                    temp = Left$(temp, i - 1) + toStr + Right$(temp, Len(temp) - i - Len(fromStr) + 1)
                Else
                    temp = Left$(temp, i - 1) + Right$(temp, Len(temp) - i - Len(fromStr) + 1)
                End If
               
                i = InStr(i + Len(toStr), temp, fromStr)
            Wend
        End If
    End If
    replaceSubstring = temp
End Function
%>

Den siger:
Microsoft VBScript compilation error '800a03ee'

Expected ')'

/tool/decode.asp, line 12

Function escapeString(aStr As String) As String
---------------------------^

det er nok "As Stirig" det virker ikke i ASP

du skal nok fjerne:
As Integer
As Stirig

men nu det er ASP kan du så ikke bruge:

<%
  response.write(Server.URLEncode("din tekst her"))
%>

eller var det..
<%
  response.write(Server.HTMLEncode("<code></code>"))
%>

ja, og flere ting jeg opgiver det snart...
Microsoft VBScript compilation error '800a0408'

Invalid character

/tool/decode.asp, line 18

aStr = replaceSubstring(aStr, "%", "%" + Hex$(Asc("%")))
--------------------------------------------^

Kan du ikke bruge dem her..

<%
  response.write(Server.URLEncode("din tekst her"))
  response.write(Server.HTMLEncode("<code></code>"))
%>

Prøv dem på en ny asp-side

jeg vil decode!
er der ikke nogle som kender en online service som kan gøre dette (en form et sted!)?

øhh havd mener du så med at decode?? er det så man ikke kan læse det eller hvad??