URLEncode函数的疑问

Question

问题：
同样是URLEncode编码,以“中华人民共和国”为例，在网上在线查询出来的编码是：%e4%b8%ad%e5%8d%8e%e4%ba%ba%e6%b0%91%e5%85%b1%e5%92%8c%e5%9b%bd
可是用下面这个函数，出来的是：%D0%AA%CB%F1%B2%CD%FA在网上搜了一下，也试了好多例子，现成的例子中暂时没发现有哪个能出来上面那个结果的。。请问怎么能得出上面那种结果？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

Answer 1

你贴的代码是不能编码汉字的。
你在网上在线查询出来的编码结果，是utf-8编码格式的。不同的编码格式会出现不同的结果。我前段时间正好有这个需要，参考写了个。根据这个，可以选择性地编码某些字符。'------------------------------------------------------------------
'Written for utf8-encoded text
Public Function encode(StringToEncode As String, Optional UsePlusRatherThanHexForSpace As Boolean = False) As String
    Dim TempAns As String
    Dim CurIndex As Integer
    Dim BytesUtf8() As Byte
    
    BytesUtf8() = EncodeToBytes(StringToEncode)
    
    CurIndex = 0
    
    Do Until CurIndex = UBound(BytesUtf8) 'discard last null char
        Select Case BytesUtf8(CurIndex)
            Case 48 To 57, 65 To 90, 97 To 122
                TempAns = TempAns & chr(BytesUtf8(CurIndex))
            Case 32
                If UsePlusRatherThanHexForSpace = True Then
                    TempAns = TempAns & "+"
                Else
                    TempAns = TempAns & "%" & Hex(32)
                End If
            Case &H21, &H23, &H24, &H28, &H29, &H2C, &H3A, &H3F, &H7E 'as !#$(),:?~
                TempAns = TempAns & chr(BytesUtf8(CurIndex))
            Case &H3C, &H3D, &H3E '<=>
                TempAns = TempAns & chr(BytesUtf8(CurIndex))
            Case Else
                TempAns = TempAns & "%" & FormatHex(BytesUtf8(CurIndex))
        End Select
        
        CurIndex = CurIndex + 1
    Loop
    
    Erase BytesUtf8
    
    encode = TempAns
End FunctionPublic Function decode(StringToDecode As String) As String
    Dim CurChr As Integer
    Dim BytesUtf8() As Byte, BytesIndex As Integer
    
    ReDim BytesUtf8(Len(StringToDecode) - 1)
    BytesIndex = 0
    
    CurChr = 1
    
    Do Until CurChr - 1 = Len(StringToDecode)
        Select Case Mid(StringToDecode, CurChr, 1)
            Case "+"
                BytesUtf8(BytesIndex) = Asc(" ")
            Case "%"
                BytesUtf8(BytesIndex) = Val("&h" & _
                Mid(StringToDecode, CurChr + 1, 2))
                CurChr = CurChr + 2
            Case Else
                BytesUtf8(BytesIndex) = Asc(Mid(StringToDecode, CurChr, 1))
        End Select
        
        CurChr = CurChr + 1
        
        BytesIndex = BytesIndex + 1
    Loop
    
    ReDim Preserve BytesUtf8(BytesIndex - 1)
    
    decode = Utf8ToUnicode(BytesUtf8)
End Function
'------------------------------------------------------------------'utf-8转换UNICODE代码
Option ExplicitPrivate Const CP_ACP = 0        ' default to ANSI code pagePrivate Const CP_UTF8 = 65001   ' default to UTF-8 code pagePrivate Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As LongPrivate Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As LongFunction Utf8ToUnicode(ByRef Utf() As Byte) As String
    Dim lRet As Long
    Dim lLength As Long
    Dim lBufferSize As Long
    
    Err.Clear
    On Error Resume Next
    lRet = UBound(Utf)
    If Err.Number = 9 Then
        Err.Clear
        Exit Function
    End If
    On Error GoTo 0
    
    lLength = UBound(Utf) - LBound(Utf) + 1
    If lLength <= 0 Then Exit Function
    lBufferSize = lLength * 2
    Utf8ToUnicode = String$(lBufferSize, chr(0))
    lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
    If lRet <> 0 Then
        Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
    Else
        Utf8ToUnicode = ""
    End If
End FunctionPublic Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
    Dim aRetn() As Byte
    Dim nSize As Long
    
    nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
    ReDim aRetn(0 To nSize - 1) As Byte
    WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
    
    EncodeToBytes = aRetn
End Function