去伪存精——VB6上真实可用的UTF-8编码URLencode函数

  • 内容
  • 评论
  • 相关

首先,要扫盲一下,什么是URLencode,网上搜索一下规则就可以知道:

1。字母,数字,连字符不变。
2。空格转换成加号。
3。其他所有的字符转换成用百分号表示,后跟字符的两位十六进制编码。

关于UTF-8与GB2312和GBK的关系就不详说了,就只是网页编码,这次我们需要的是根据UTF-8来进行编码。
通常在网上传输参数时有用,因为如果字符串中包含“&”或"%"这些字符,就会被错误解释整串字符,所以需要重新编码再解码。
如果在VB上想实现,百度搜搜一堆,但实际没有一个可用,真的,没有一个可用!
先说说搜索出来最多的,是这个:

Public Function UTF8_URLEncoding(szInput)
    Dim wch, uch, szRet
    Dim x
    Dim nAsc, nAsc2, nAsc3
    If szInput = "" Then
        UTF8_URLEncoding = szInput
        Exit Function
    End If
    For x = 1 To Len(szInput)
        wch = Mid(szInput, x, 1)
        nAsc = AscW(wch)
       
        If nAsc < 0 Then nAsc = nAsc + 65536
       
        If (nAsc And &HFF80) = 0 Then
            szRet = szRet & wch
        Else
            If (nAsc And &HF000) = 0 Then
                uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            Else
                uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
                Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
                Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
    UTF8_URLEncoding = szRet
End Function

但实际出处应该在这里:
http://blog.csdn.net/xiaoyao961/article/details/6764029
因为还带了非常重要的注释,而且人家明明写得很清楚:
“VB源码函数UTF8Encode UTF8编码,原内容中有URLENCODE内容的不作更改”
根据分析源码,作者的意思应该是对中文进行URLencode,对其他字符不处理,譬如"%",空格,“&”这些都是不处理的。
当然,我们还搜索到另外一个函数,出处在这里:
http://blog.csdn.net/bibbykwan/article/details/6041969
源码:

Public Function URLEncode(ByVal strParameter As String) As String

Dim s As String
Dim I As Integer
Dim intValue As Integer

Dim TmpData() As Byte

    s = ""
    TmpData = StrConv(strParameter, vbFromUnicode)
    For I = 0 To UBound(TmpData)
      intValue = TmpData(I)
      If (intValue >= 48 And intValue <= 57) Or _         (intValue >= 65 And intValue <= 90) Or _         (intValue >= 97 And intValue <= 122) Then
        s = s & Chr(intValue)
      ElseIf intValue = 32 Then
        s = s & "+"
      Else
        s = s & "%" & Hex(intValue)
      End If
    Next I
    URLEncode = s

End Function

其实我更喜欢另外一个更加简单的,其实是一样的:

Public Function URLEncode(ByRef Text As String) As String
    Const Hex = "0123456789ABCDEF"
    Dim lngA As Long, lngChar As Long
    URLEncode = Text
    For lngA = LenB(URLEncode) - 1 To 1 Step -2
        lngChar = Asc(MidB$(URLEncode, lngA, 2))
        Select Case lngChar
            Case 48 To 57, 65 To 90, 97 To 122
            Case 32
                MidB$(URLEncode, lngA, 2) = "+"
            Case Else
                URLEncode = LeftB$(URLEncode, lngA - 1) & "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1) & MidB$(URLEncode, lngA + 2)
        End Select
    Next lngA
End Function

分析源码可以得知,该函数仅对空格、"%"这些字符进行处理,如果是中文的话,得不到想要的结果。
好吧,既然如此,只能够自己修改了,把2个不足的地方互相弥补一下,得出以下真实可用的函数:

'UTF-8 URL编码
Public Function UTF8_URLEncoding(szInput)
    Dim uch, szRet
    Dim wch As String
    Dim x
    Dim nAsc, nAsc2, nAsc3
    If szInput = "" Then
        UTF8_URLEncoding = szInput
        Exit Function
    End If
    For x = 1 To Len(szInput)
        wch = Mid(szInput, x, 1)
        nAsc = AscW(wch)
       
        If nAsc < 0 Then nAsc = nAsc + 65536
       
        If (nAsc And &HFF80) = 0 Then
            szRet = szRet & URLEncode(wch)
        Else
            If (nAsc And &HF000) = 0 Then
                uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            Else
                uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
                Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
                Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
    UTF8_URLEncoding = szRet
End Function

Public Function URLEncode(ByRef Text As String) As String
    Const Hex = "0123456789ABCDEF"
    Dim lngA As Long, lngChar As Long
    URLEncode = Text
    For lngA = LenB(URLEncode) - 1 To 1 Step -2
        lngChar = Asc(MidB$(URLEncode, lngA, 2))
        Select Case lngChar
            Case 48 To 57, 65 To 90, 97 To 122
            Case 32
                MidB$(URLEncode, lngA, 2) = "+"
            Case Else
                URLEncode = LeftB$(URLEncode, lngA - 1) & "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1) & MidB$(URLEncode, lngA + 2)
        End Select
    Next lngA
End Function

只要调用UTF8_URLEncoding()这个函数就可以得出真实的结果了,测试如下:
debug.print UTF8_URLEncoding("1+1%&测试")的结果为:
1%2B1%25%26%E6%B5%8B%E8%AF%95

总结:现在的开发总浮于表面,通常网上找到就马上拿来用了,是不是真的可用也没实际测试。特别是这个URLencode,因为一般如果只包含中文,是看不出问题的,只有当含有%和空格这些特殊符号才出问题。
不过现在用VB6的也很少了,如果是VB.net就一个函数搞定。

 

后记,百度知道上面的那个,经测试是GB2312的,可用,也放着留存吧,代码如下:
http://zhidao.baidu.com/link?url=eHXKcsGEuhSMRhearWqQgcyuJEoLNFRuDOU0mog-du6wuy0PZHkzeBcez2lKfeRlamPxVccLRWWFC17STrlRdAoiXSKxW-_6AnwutBe5uL3

'编码函数
Public Function URLEncode(ByRef strURL As String) As String
Dim I As Long
Dim tempStr As String
For I = 1 To Len(strURL)
If Asc(Mid(strURL, I, 1)) < 0 Then
    tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, I, 1)))), 2)
    tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, I, 1)))), Len(CStr(Hex(Asc(Mid(strURL, I, 1))))) - 2) & tempStr
    URLEncode = URLEncode & tempStr
ElseIf (Asc(Mid(strURL, I, 1)) >= 65 And Asc(Mid(strURL, I, 1)) <= 90) Or (Asc(Mid(strURL, I, 1)) >= 97 And Asc(Mid(strURL, I, 1)) <= 122) Then
    URLEncode = URLEncode & Mid(strURL, I, 1)
Else
    URLEncode = URLEncode & "%" & Hex(Asc(Mid(strURL, I, 1)))
End If
Next
End Function
 
'解码函数
Public Function URLDecode(ByRef strURL As String) As String 
Dim I As Long 
 
If InStr(strURL, "%") = 0 Then URLDecode = strURL: Exit Function 
 
For I = 1 To Len(strURL) 
If Mid(strURL, I, 1) = "%" Then 
If Val("&H" & Mid(strURL, I + 1, 2)) > 127 Then 
URLDecode = URLDecode & Chr(Val("&H" & Mid(strURL, I + 1, 2) & Mid(strURL, I + 4, 2))) 
I = I + 5 
Else 
URLDecode = URLDecode & Chr(Val("&H" & Mid(strURL, I + 1, 2))) 
I = I + 2 
End If 
Else 
URLDecode = URLDecode & Mid(strURL, I, 1) 
End If 
Next 
End Function

评论

0条评论

发表评论

电子邮件地址不会被公开。 必填项已用*标注

此站点使用Akismet来减少垃圾评论。了解我们如何处理您的评论数据