下面的代码是从kesion系统扒下的，确实不错，支持utf8格式。
- '================================================
- '函数名：URLDecode
- '作 用：URL解码
- '================================================
- 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
- 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
|
