【Access自定义函数】URL编码函数--解决中文字符出现乱码的问题

时　间:2021-06-29 11:07:31
作　者:金宇   ID：43  城市：江阴
摘　要:URL编码函数，如果需要给网页传递URL字符，传递的字符中含有中文，那么最终将字符串传递给网页的时候的中文部分会出现乱码，从而影响网页对传递字符串的读取，使得网页无法正常显示，通过在access中对所需传递的字符串进行URL编码后再传递给网页，那么网页就可以正常解析读取所传递的字符串，网页也就可以正常显示。
正　文:

'=====================================
'-函数名称：     UrlEncode
'-功能描述：     将中文字符转换成编码，并解决出现乱码的问题
'-输入参数：     盟威软件
'-返回参数：     返回编码
'-使用示例：     =UrlEncode("盟威软件")   '返回值：%E7%9B%9F%E5%A8%81
'-作      者：     Accessoft-金宇
'=====================================

'URL编码

Public Function UrlEncode(ByRef szString As String) As String
    Dim szChar As String
    Dim szTemp As String
    Dim szCode As String
    Dim szHex As String
    Dim szBin As String
    Dim iCount1 As Integer
    Dim iCount2 As Integer
    Dim iStrLen1 As Integer
    Dim iStrLen2 As Integer
    Dim lResult As Long
    Dim lAscVal As Long
    szString = Trim$(szString)
    iStrLen1 = Len(szString)
    For iCount1 = 1 To iStrLen1
        szChar = Mid$(szString, iCount1, 1)
        lAscVal = AscW(szChar)
        If lAscVal >= &H0 And lAscVal <= &HFF Then
            If (lAscVal >= &H30 And lAscVal <= &H39) Or _
               (lAscVal >= &H41 And lAscVal <= &H5A) Or _
               (lAscVal >= &H61 And lAscVal <= &H7A) Then
                szCode = szCode & szChar
            Else

                szCode = szCode & "%" & Hex(AscW(szChar))
            End If
        Else
            szHex = Hex(AscW(szChar))
            iStrLen2 = Len(szHex)
            For iCount2 = 1 To iStrLen2
                szChar = Mid$(szHex, iCount2, 1)
                Select Case szChar
                Case Is = "0"
                    szBin = szBin & "0000"
                Case Is = "1"
                    szBin = szBin & "0001"
                Case Is = "2"
                    szBin = szBin & "0010"
                Case Is = "3"
                    szBin = szBin & "0011"
                Case Is = "4"
                    szBin = szBin & "0100"
                Case Is = "5"
                    szBin = szBin & "0101"
                Case Is = "6"
                    szBin = szBin & "0110"
                Case Is = "7"
                    szBin = szBin & "0111"
                Case Is = "8"
                    szBin = szBin & "1000"
                Case Is = "9"
                    szBin = szBin & "1001"
                Case Is = "A"
                    szBin = szBin & "1010"
                Case Is = "B"
                    szBin = szBin & "1011"
                Case Is = "C"
                    szBin = szBin & "1100"
                Case Is = "D"
                    szBin = szBin & "1101"
                Case Is = "E"
                    szBin = szBin & "1110"
                Case Is = "F"
                    szBin = szBin & "1111"
                Case Else
                End Select
            Next iCount2
            szTemp = "1110" & Left$(szBin, 4) & "10" & Mid$(szBin, 5, 6) & "10" & Right$(szBin, 6)
            For iCount2 = 1 To 24
                If Mid$(szTemp, iCount2, 1) = "1" Then
                    lResult = lResult + 1 * 2 ^ (24 - iCount2)
                Else: lResult = lResult + 0 * 2 ^ (24 - iCount2)
                End If
            Next iCount2
            szTemp = Hex(lResult)
            szCode = szCode & "%" & Left$(szTemp, 2) & "%" & Mid$(szTemp, 3, 2) & "%" & Right$(szTemp, 2)
        End If
        szBin = vbNullString
        lResult = 0
    Next iCount1
    UrlEncode = szCode
End Function

附   件:

点击下载此示例

演   示: