零售创新,创新那些事

Excel VBA 字符串继续url解码

Excel VBA 字符串继续url解码  

Excel VBA 字符串继续url解码 - 和平 - 零售创新,创新那些事儿,SPSS,VBA

 

Function URLDecode(ByVal strIn)

    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)

End Function

评论