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

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

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

網(wǎng)上很多 Url編碼解碼函數(shù)都是有問(wèn)題的。這兩天要處理一個(gè)URL解碼 代碼。找了很多代碼,并修改測(cè)試，測(cè)試后這2個(gè)函數(shù)是成功的。

一個(gè)是解密函數(shù) URLDecode，一個(gè)是加密函數(shù) URLEncode

Function URLDecode(strIn) 'Tmtony親測(cè)成功的 這個(gè)是成功的 支持中文 嘗試多種不同的字符是正確的
    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 測(cè)試過(guò)帶符號(hào) 帶全角 帶中文 帶數(shù)字 帶小寫字母 結(jié)果是對(duì)的
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