VB6 VBA Access真正可用併且完美支持中英文的 URLEncode 與 URLDecode 函數(shù)源碼

VB6 Excel VBA Access VBA環(huán)境下：真正可用併且完美支持中英文的 URLEncode 與 URLDecode 2箇函數(shù)源碼

函數(shù)用途：曏網(wǎng)頁Get 或 Post提交數(shù)據(jù)時，經(jīng)常要對文本Url編碼 Url解碼

網(wǎng)上很多 Url編碼解碼函數(shù)都是有問題的。這兩天要處理一箇URL解碼 代碼。找瞭很多代碼,併修改測試，測試後這2箇函數(shù)是成功的。

一箇是解密函數(shù) URLDecode，一箇是加密函數(shù) 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 測試過帶符號 帶全角 帶中文 帶數(shù)字 帶小寫字母 結(jié)果是對的
End Function

編碼函數(shù)

Public Function UrlEncode(ByRef szString As String) As String '由我們Office交流網(wǎng)論罎版主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