Function UrlDecode(ByVal urlcode) Dim start, final, length, char, i, butf8, pass Dim leftstr, rightstr, finalstr Dim b0, b1, bx, blength, position, u, utf8 On Error Resume Next
b0 = Array(192, 224, 240, 248, 252, 254) urlcode = Replace(urlcode, "+", " ") pass = 0 utf8 = -1 length = Len(urlcode): start = InStr(urlcode, "%"): final = InStrRev(urlcode, "%") If start = 0 Or length < 3 Then UrlDecode = urlcode: Exit Function leftstr = Left(urlcode, start - 1): rightstr = Right(urlcode, length - 2 - final)For i = start To final char = Mid(urlcode, i, 1) If char = "%" Then bx = URLDecode_Hex(Mid(urlcode, i + 1, 2)) If bx > 31 And bx < 128 Then i = i + 2 finalstr = finalstr & ChrW(bx) ElseIf bx > 127 Then i = i + 2 If utf8 < 0 Then butf8 = 1: blength = -1: b1 = bx For position = 4 To 0 Step -1 If b1 >= b0(position) And b1 < b0(position + 1) Then blength = position Exit For End If Next If blength > -1 Then For position = 0 To blength b1 = URLDecode_Hex(Mid(urlcode, i + position * 3 + 2, 2)) If b1 < 128 Or b1 > 191 Then butf8 = 0: Exit For Next Else butf8 = 0 End If If butf8 = 1 And blength = 0 Then butf8 = -2 If butf8 > -1 And utf8 = -2 Then i = start - 1: finalstr = "": pass = 1 utf8 = butf8 End If If pass = 0 Then If utf8 = 1 Then b1 = bx: u = 0: blength = -1 For position = 4 To 0 Step -1 If b1 >= b0(position) And b1 < b0(position + 1) Then blength = position b1 = (b1 Xor b0(position)) * 64 ^ (position + 1) Exit For End If Next If blength > -1 Then For position = 0 To blength bx = URLDecode_Hex(Mid(urlcode, i + 2, 2)): i = i + 3 If bx < 128 Or bx > 191 Then u = 0: Exit For u = u + (bx And 63) * 64 ^ (blength - position) Next If u > 0 Then finalstr = finalstr & ChrW(b1 + u) End If Else b1 = bx * &H100: u = 0 bx = URLDecode_Hex(Mid(urlcode, i + 2, 2)) If bx > 0 Then u = b1 + bx i = i + 3 Else If Left(urlcode, 1) = "%" Then u = b1 + Asc(Mid(urlcode, i + 3, 1)) i = i + 2 Else u = b1 + Asc(Mid(urlcode, i + 1, 1)) i = i + 1 End If End If finalstr = finalstr & Chr(u) End If Else pass = 0 End If End If Else finalstr = finalstr & char End If DoEvents Next UrlDecode = leftstr & finalstr & rightstr End Function
Dim start, final, length, char, i, butf8, pass
Dim leftstr, rightstr, finalstr
Dim b0, b1, bx, blength, position, u, utf8
On Error Resume Next
b0 = Array(192, 224, 240, 248, 252, 254)
urlcode = Replace(urlcode, "+", " ")
pass = 0
utf8 = -1 length = Len(urlcode): start = InStr(urlcode, "%"): final = InStrRev(urlcode, "%")
If start = 0 Or length < 3 Then UrlDecode = urlcode: Exit Function
leftstr = Left(urlcode, start - 1): rightstr = Right(urlcode, length - 2 - final)For i = start To final
char = Mid(urlcode, i, 1)
If char = "%" Then
bx = URLDecode_Hex(Mid(urlcode, i + 1, 2))
If bx > 31 And bx < 128 Then
i = i + 2
finalstr = finalstr & ChrW(bx)
ElseIf bx > 127 Then
i = i + 2
If utf8 < 0 Then
butf8 = 1: blength = -1: b1 = bx
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
b1 = URLDecode_Hex(Mid(urlcode, i + position * 3 + 2, 2))
If b1 < 128 Or b1 > 191 Then butf8 = 0: Exit For
Next
Else
butf8 = 0
End If
If butf8 = 1 And blength = 0 Then butf8 = -2
If butf8 > -1 And utf8 = -2 Then i = start - 1: finalstr = "": pass = 1
utf8 = butf8
End If
If pass = 0 Then
If utf8 = 1 Then
b1 = bx: u = 0: blength = -1
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
b1 = (b1 Xor b0(position)) * 64 ^ (position + 1)
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
bx = URLDecode_Hex(Mid(urlcode, i + 2, 2)): i = i + 3
If bx < 128 Or bx > 191 Then u = 0: Exit For
u = u + (bx And 63) * 64 ^ (blength - position)
Next
If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
End If
Else
b1 = bx * &H100: u = 0
bx = URLDecode_Hex(Mid(urlcode, i + 2, 2))
If bx > 0 Then
u = b1 + bx
i = i + 3
Else
If Left(urlcode, 1) = "%" Then
u = b1 + Asc(Mid(urlcode, i + 3, 1))
i = i + 2
Else
u = b1 + Asc(Mid(urlcode, i + 1, 1))
i = i + 1
End If
End If
finalstr = finalstr & Chr(u)
End If
Else
pass = 0
End If
End If
Else
finalstr = finalstr & char
End If
DoEvents
Next
UrlDecode = leftstr & finalstr & rightstr
End Function