VB6 VBA Access真正可用并且完美支持中英文的 URLEncode 与 URLDecode 函数源码

VB6 Excel VBA Access VBA环境下：真正可用并且完美支持中英文的 URLEncode 与 URLDecode 2个函数源码

函数用途：向网页Get 或 Post提交数据时，经常要对文本Url编码 Url解码

网上很多 Url编码解码函数都是有问题的。这两天要处理一个URL解码 代码。找了很多代码,并修改测试，测试后这2个函数是成功的。

一个是解密函数 URLDecode，一个是加密函数 URLEncode

Function URLDecode(strIn) 'Tmtony亲测成功的 这个是成功的 支持中文 尝试多种不同的字符是正确的
    URLDecode = ""
    Dim sl: sl = 1
    Dim tl: tl = 1
    Dim key: key = "%"
    Dim kl: kl = Len(key)
    sl = InStr(sl, strIn, key, 1)
    Do While sl > 0
        If (tl = 1 And sl <> 1) Or tl < sl Then
            URLDecode = URLDecode & Mid(strIn, tl, sl - tl)
        End If
        Dim hh, hi, hl
        Dim a
        Select Case UCase(Mid(strIn, sl + kl, 1))
        Case "U": 'Unicode URLEncode
            a = Mid(strIn, sl + kl + 1, 4)
            URLDecode = URLDecode & ChrW("&H" & a)
            sl = sl + 6
        Case "E": 'UTF-8 URLEncode
            hh = Mid(strIn, sl + kl, 2)
            a = Int("&H" & hh) 'ascii码
            If Abs(a) < 128 Then
                sl = sl + 3
                URLDecode = URLDecode & Chr(a)
            Else
                hi = Mid(strIn, sl + 3 + kl, 2)
                hl = Mid(strIn, sl + 6 + kl, 2)
                a = ("&H" & hh And &HF) * 2 ^ 12 Or ("&H" & hi And &H3F) * 2 ^ 6 Or ("&H" & hl And &H3F)
                If a < 0 Then a = a + 65536
                URLDecode = URLDecode & ChrW(a)
                sl = sl + 9
            End If
        Case Else: 'Asc URLEncode
            hh = Mid(strIn, sl + kl, 2) '高位
            a = Int("&H" & hh) 'ascii码
            If Abs(a) < 128 Then
                sl = sl + 3
            Else
                hi = Mid(strIn, sl + 3 + kl, 2) '低位
                a = Int("&H" & hh & hi) '非ascii码
                sl = sl + 6
            End If
            URLDecode = URLDecode & Chr(a)
        End Select
        tl = sl
        sl = InStr(sl, strIn, key, 1)
    Loop
    URLDecode = URLDecode & Mid(strIn, tl) 'TmTony 测试过带符号 带全角 带中文 带数字 带小写字母 结果是对的
End Function

编码函数

Public Function UrlEncode(ByRef szString As String) As String '由我们Office交流网论坛版主roadbeg提供
    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) Or lAscVal = 61 Or lAscVal = 38 Or lAscVal = 95 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