<strong id="nr4sf"></strong>

<button id="nr4sf"><object id="nr4sf"></object></button>

    <rp id="nr4sf"></rp>
    <th id="nr4sf"><track id="nr4sf"></track></th>
      <s id="nr4sf"></s>
    1. <em id="nr4sf"></em>
    2. <li id="nr4sf"><acronym id="nr4sf"></acronym></li>
    3. <button id="nr4sf"></button>

      office交流網--QQ交流群號

      Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

      Word交流群:218156588             PPT交流群:324131555

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

      2021-11-04 11:06:00
      tmtony
      原創
      14776

      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
      

      分享
      一级日本牲交大片束缚_玖玖资源站亚洲最大的网站_56PAO国产成视频永久_97人人操人人摸
      <strong id="nr4sf"></strong>

      <button id="nr4sf"><object id="nr4sf"></object></button>

      <rp id="nr4sf"></rp>
      <th id="nr4sf"><track id="nr4sf"></track></th>
        <s id="nr4sf"></s>
      1. <em id="nr4sf"></em>
      2. <li id="nr4sf"><acronym id="nr4sf"></acronym></li>
      3. <button id="nr4sf"></button>