VB 网址链接中的编码函数 GBK及UTF-8 编码解码

sword803

VB 网址链接中的编码函数      编码解码GBK及UTF-8

'UTF-8 URL编码
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


'UTF-8 URL解码
Public Function UTF8_UrlDecode(ByVal URL As String)
    Dim B, ub   ''中文字的Unicode码(2字节)
    Dim UtfB    ''Utf-8单个字节
    Dim UtfB1, UtfB2, UtfB3 ''Utf-8码的三个字节
    Dim i, n, s
    n = 0
    ub = 0
    For i = 1 To Len(URL)
        B = Mid(URL, i, 1)
        Select Case B
            Case "+"
                s = s & " "
            Case "%"
                ub = Mid(URL, i + 1, 2)
                UtfB = CInt("&H" & ub)
                If UtfB < 128 Then
                    i = i + 2
                    s = s & ChrW(UtfB)
                Else
                    UtfB1 = (UtfB And &HF) * &H1000   ''取第1个Utf-8字节的二进制后4位
                    UtfB2 = (CInt("&H" & Mid(URL, i + 4, 2)) And &H3F) * &H40      ''取第2个Utf-8字节的二进制后6位
                    UtfB3 = CInt("&H" & Mid(URL, i + 7, 2)) And &H3F      ''取第3个Utf-8字节的二进制后6位
                    s = s & ChrW(UtfB1 Or UtfB2 Or UtfB3)
                    i = i + 8
                End If
            Case Else    ''Ascii码
                s = s & B
        End Select
    Next
    UTF8_UrlDecode = s
End Function


'GBK URL编码
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


'GBK URL解码
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

nb99

学习一下