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
'//中文转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

发表评论

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

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