My language of choice can't decode an URIEncoded string

JohanS — Fri, 16 Mar 2007 11:25:00 GMT

Problem:

Some time ago I was asked to help in decoding an URI Encoded string from VB6. URL Decoding is simple enough, but when you're working with Greek, Hebrew, etc. that just isn't enough.

Resolution:

A quick search revealed a truckload of samples on how to do URL Decoding, but URI Decoding is a bit harder. I decided to stand on the shoulders of geniuses and ran Reflector on the Microsoft.JScript.dll. The code was fairly easy to convert, but I thought I'd share it in case you don't want to do it yourself. :)

I've commented out (but otherwise left intact) all the spots where .NET would throw an exception, since this would be a good spot to implement your own error handler.

Anyway, bring on the code!

/ Johan

Private Function Encode2(ByVal Text1 As String) As String
      Dim builder1 As String
      builder1 = ""
      Dim num1 As Integer
      num1 = 0
      Do While (num1 < Len(Text1))
            Dim ch1 As String
            ch1 = Mid(Text1, num1 + 1, 1)
            If InURISet(ch1, 2) Then
                  builder1 = builder1 & (ch1)
            Else
                  Dim num2 As Integer
                  num2 = AscW(ch1)
                  If ((num2 >= 0) And (num2 <= 127)) Then
                        Call AppendInHex(builder1, num2)
                  ElseIf ((num2 >= 128) And (num2 <= 2047)) Then
                        Call AppendInHex(builder1, (RShiftWord(num2, 6) Or 192))
                        Call AppendInHex(builder1, ((num2 And 63) Or 128))
                  ElseIf ((num2 < 55296) Or (num2 > 57343)) Then
                        Call AppendInHex(builder1, (RShiftWord(num2, 12) Or 224))
                        Call AppendInHex(builder1, ((RShiftWord(num2, 6) And 63) Or 128))
                        Call AppendInHex(builder1, ((num2 And 63) Or 128))
                  Else
                        If ((num2 >= 56320) And (num2 <= 57343)) Then
'                              Throw New JScriptException(JSError.URIEncodeError)
                        End If
                        If (num1 >= Len(Text1)) Then
'                              Throw New JScriptException(JSError.URIEncodeError)
                        End If
                        Dim num3 As Integer
                        num3 = Mid(Text1, num1 + 1, 1)
                        If ((num3 < 56320) Or (num3 > 57343)) Then
'                              Throw New JScriptException(JSError.URIEncodeError)
                        End If
                        num2 = ((LShiftWord((num2 - 55296), 10) + num3) + 9216)
                        Call AppendInHex(builder1, (RShiftWord(num2, 18) Or 240))
                        Call AppendInHex(builder1, ((RShiftWord(num2, 12) And 63) Or 128))
                        Call AppendInHex(builder1, ((RShiftWord(num2, 6) And 63) Or 128))
                        Call AppendInHex(builder1, ((num2 And 63) Or 128))
                  End If
            End If
            num1 = num1 + 1
      Loop
      Encode2 = builder1
End Function

Private Function Decode2(ByVal Text1 As String) As String
      Dim builder1 As String
      Dim num1 As Integer
      num1 = 0
      Do While (num1 < Len(Text1))
            Dim ch1 As String
            ch1 = Mid(Text1, (num1) + 1, 1)
            If (ch1 <> "%") Then
                  builder1 = builder1 & (ch1)
            Else
                  Dim ch2 As String
                  Dim num2 As Integer
                num2 = num1
                  If ((num1 + 2) >= Len(Text1)) Then
'                        Throw New JScriptException(JSError.URIDecodeError)
                  End If
                  Dim num3 As Byte
                  num3 = HexValue(Mid(Text1, (num1 + 2), 1), Mid(Text1, (num1 + 3), 1))
                  num1 = (num1 + 2)
                  If ((num3 And 128) = 0) Then
                        ch2 = Chr(num3)
                  Else
                        Dim num4 As Integer
                        num4 = 1
                        Do While ((LShiftWord(num3, (num4 And 31)) And 128) <> 0)
                              num4 = num4 + 1
                        Loop
                        If (((num4 = 1) Or (num4 > 4)) Or ((num1 + ((num4 - 1) * 3)) >= Len(Text1))) Then
'                              Throw New JScriptException(JSError.URIDecodeError)
                        End If
                        Dim num5 As Integer
                        num5 = (num3 And RShiftWord(255, ((num4 + 1) And 31)))
                        Do While (num4 > 1)
                              If (Mid(Text1, (num1 + 2), 1) <> "%") Then
'                                    Throw New JScriptException(JSError.URIDecodeError)
                              End If
                              num3 = HexValue(Mid(Text1, (num1 + 3), 1), Mid(Text1, (num1 + 4), 1))
                              num1 = (num1 + 3)
                              If ((num3 And 192) <> 128) Then
'                                    Throw New JScriptException(JSError.URIDecodeError)
                              End If
                              num5 = ((LShiftWord(num5, 6)) Or (num3 And 63))
                              num4 = num4 - 1
                        Loop
                        If ((num5 >= 55296) And (num5 < 57344)) Then
'                              Throw New JScriptException(JSError.URIDecodeError)
                        End If
                        If (num5 < 65536) Then
                              ch2 = (ChrW(num5))
                        Else
                              If (num5 > 1114111) Then
'                                    Throw New JScriptException(JSError.URIDecodeError)
                              End If
                              builder1 = builder1 & (Chr(((RShiftWord((num5 - 65536), 10) And 1023) + 55296)))
                              builder1 = builder1 & (Chr((((num5 - 65536) And 1023) + 56320)))
                              GoTo Label_01D4
                        End If
                  End If
                  If InURISet(ch2, 0) Then ' This can probably be omitted. It looks like it'll never be True.
                        builder1 = builder1 & Mid(Text1, num2 + 1, ((num1 - num2) + 1))
                  Else
                        builder1 = builder1 & ch2
                  End If
Label_01D4:
            End If
            num1 = num1 + 1
      Loop
      Decode2 = builder1
End Function

Private Function HexValue(ByVal ch1 As String, ByVal ch2 As String) As Byte
      Dim num1 As Integer
      Dim num2 As Integer
      num1 = HexDigit(ch1)
      num2 = HexDigit(ch2)
      If ((num1 < 0) Or (num2 < 0)) Then
'            Throw New JScriptException(JSError.URIDecodeError)
      End If
      HexValue = CByte((LShiftWord(num1, 4) Or num2))
End Function

Private Function HexDigit(ByVal c As String) As Integer
    Dim retVal As Integer
    retVal = -1
    If ((c >= "0") And (c <= "9")) Then
          retVal = (Asc(c) - Asc("0"))
    End If
    If ((c >= "A") And (c <= "F")) Then
          retVal = (((10) + Asc(c)) - Asc("A"))
    End If
    If ((c >= "a") And (c <= "f")) Then
          retVal = (((10) + Asc(c)) - Asc("a"))
    End If
    HexDigit = retVal
End Function

Function LShiftWord(ByVal w As Integer, ByVal c As Integer) As Integer
LShiftWord = w * (2 ^ c)
End Function

Function RShiftWord(w As Integer, c As Integer) As Integer
RShiftWord = w \ (2 ^ c)
End Function

Private Function InURISet(ByVal ch As String, ByVal flags As Integer) As Boolean
    Dim bRetval As Boolean
    bRetval = False
    If (flags = 2) Then
        If ((((ch >= "0") And (ch <= "9")) Or ((ch >= "A") And (ch <= "Z"))) Or ((ch >= "a") And (ch <= "z"))) Then
            bRetval = True
        End If
        Select Case ch
              Case "_", "~", "'", "(", ")", "*", "-", ".", "!"
                    bRetval = True
        End Select
    End If
    If (flags = 1) Then
        Select Case ch
              Case "#", "$", "&", "+", ",", "/", ":", ";", "=", "?", "@"
                    bRetval = True
        End Select
    End If
    InURISet = bRetval
End Function

Private Sub AppendInHex(ByRef bs As String, ByVal value As Integer)
      bs = bs & "%"
      Dim num1 As Integer
      num1 = (RShiftWord(value, 4) And 15)
      bs = bs & (IIf((num1 >= 10), Chr((num1 - 10) + 65), Chr(num1 + 48)))
      num1 = (value And 15)
      bs = bs & (IIf((num1 >= 10), Chr((num1 - 10) + 65), Chr(num1 + 48)))
End Sub

Speaking of which... : Encoding

My language of choice can't decode an URIEncoded string

Problem:

Resolution: