The following code is stripped from the kesion system, which is really good and supports the UTF8 format.
Copy Code code as follows:
'================================================
' Function name: UrlDecode
' Function: URL decoding
'================================================
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 > 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)) * (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) * ^ (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
Next
UrlDecode = leftstr & Finalstr & Rightstr
End Function
Function Urldecode_hex (ByVal h)
On Error Resume Next
h = "&h" & Trim (h): Urldecode_hex =-1
If Len (h) <> 4 Then Exit Function
If isnumeric (h) Then Urldecode_hex = cInt (h)
End Function
