vb URL编码 unicode中文互转, gb2312中文互转, utf8中文互转

'//vb将unicode转成汉字，如：\u8033\u9EA6，转后为：耳麦
Public Function urlUnicodeDecode(strCode As String) As String
    
    Dim Char As String, arr
 
    strCode = Replace(strCode, "U", "u")
    arr = Split(strCode, "\u")
    For i = 0 To UBound(arr)
        If Len(arr(i)) > 0 Then
            If Len(arr(i)) = 4 Then '//长度是4刚好是一个字
                Char = Char & ChrW("&H" & Mid(CStr(arr(i)), 1, 4))
            ElseIf Len(arr(i)) > 4 Then '//长度>4说明有其它字符
                Char = Char & ChrW("&H" & Mid(CStr(arr(i)), 1, 4)) & Mid(CStr(arr(i)), 5)
            End If
        End If
    Next
    unicodeDecode = Char
    
End Function

'//将中文转为unicode编码，如：耳麦，转后为：\u8033\u9EA6
Function urlUnicodeEncode(strCode As String) As String
    
    Dim a() As String
    Dim str As String
    Dim i As Integer
    StrTemp = strCode
    
    For i = 0 To Len(strCode) - 1
    On Error Resume Next
        str = Mid(strCode, i + 1, 1)
        If isChinese(str) = True Then '//是中文
            unicodeEncode = unicodeEncode & "\u" & String(4 - Len(Hex(AscW(str))), "0") & Hex(AscW(str))
        Else '//不是中文
            unicodeEncode = unicodeEncode & str
        End If
        
    Next

End Function

'//是否为中文
Private Function isChinese(Text As String) As Boolean

    Dim l As Long
    Dim i As Long
    l = Len(Text)
    isChinese = False
    
    For i = 1 To l
        If Asc(Mid(Text, i, 1)) < 0 Or Asc(Mid(Text, i, 1)) < 0 Then
        isChinese = True
        Exit Function
        End If
    Next

End Function

'发送的内容转为utf8
Public Function UTF8EncodeURI(szInput)
    
    Dim wch, uch, szRet
    Dim X
    Dim nAsc, nAsc2, nAsc3
    If szInput = "" Then
        UTF8EncodeURI = 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
    
End Function

'//中文转gbk 如："http://被" 转后："http://%B1%BB"

Function urlGbkEncode(nstr As String) As String
    Dim I As Integer, nmid As String, nAsc As Integer, nhex As String
    For I = 1 To Len(nstr)
        nmid = Mid(nstr, I, 1)
        nAsc = Asc(nmid)
        If nAsc < 0 Then
            nhex = Right("000" & Hex(nAsc), 4)
            URLEncodeGbk = URLEncodeGbk & "%" & Left(nhex, 2) & "%" & Right(nhex, 2)
        ElseIf nmid = " " Then
            URLEncodeGbk = URLEncodeGbk & "+"
        ElseIf (nAsc >= 48 And nAsc <= 57) Or (nAsc >= 65 And nAsc <= 90) Or (nAsc >= 97 And nAsc <= 122) Then
            URLEncodeGbk = URLEncodeGbk & nmid
        Else
            URLEncodeGbk = URLEncodeGbk & "%" & Right("0" & Hex(nAsc), 2)
        End If
    Next I
End Function

'//gbk转中文 如："http://%B1%BB" 转后："http://被"

Public Function urlGbkDecode(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