| Option Explicit | |
| '------------------------------------------------------------------------------ | |
| ' Module: URL Encode and Decode Functions | |
| ' Author: Jeremy Varnham | |
| ' Version: 1.1.0 | |
| ' Date: 22 August 2024 | |
| ' Description: This module provides two functions: URLEncode and URLDecode. | |
| ' These functions allow you to encode and decode URL strings, | |
| ' supporting ASCII, Unicode, and UTF-8 encoding. | |
| ' Usage: | |
| ' 1. Open your CSV file in Excel and save it as a Macro-Enabled Workbook. | |
| ' 2. Open Visual Basic Editor. | |
| ' 3. Insert a new Module. | |
| ' 4. Copy and paste this code into the code editor window. | |
| ' 5. Close Visual Basic Editor. In your worksheet, you will now have two | |
| ' new formulas available: URLEncode and URLDecode. | |
| '------------------------------------------------------------------------------ | |
| '------------------------------------------------------------------------------ | |
| ' Function: URLDecode | |
| ' Description: Decodes a URL-encoded string, supporting ASCII, Unicode, and UTF-8 encoding. | |
| ' Parameters: | |
| ' - strIn: The URL-encoded string to decode. | |
| ' Returns: | |
| ' - The decoded string. | |
| '------------------------------------------------------------------------------ | |
| Function URLDecode(ByVal strIn As String) As String | |
| On Error GoTo ErrorHandler | |
| ' Declare and initialize variables | |
| Dim sl As Long, tl As Long | |
| Dim key As String, kl As Long | |
| Dim hh As String, hi As String, hl As String | |
| Dim a As Long | |
| ' Set the key to look for the percent symbol used in URL encoding | |
| key = "%" | |
| kl = Len(key) | |
| sl = 1: tl = 1 | |
| ' Find the first occurrence of the key (percent symbol) in the input string | |
| sl = InStr(sl, strIn, key, vbTextCompare) | |
| ' Loop through the input string until no more percent symbols are found | |
| Do While sl > 0 | |
| ' Add unprocessed characters to the result | |
| If (tl = 1 And sl <> 1) Or tl < sl Then | |
| URLDecode = URLDecode & Mid(strIn, tl, sl - tl) | |
| End If | |
| ' Determine the type of encoding (Unicode, UTF-8, or ASCII) and decode accordingly | |
| Select Case UCase(Mid(strIn, sl + kl, 1)) | |
| Case "U" ' Unicode URL encoding (e.g., %uXXXX) | |
| a = Val("&H" & Mid(strIn, sl + kl + 1, 4)) ' Convert hex to decimal | |
| URLDecode = URLDecode & ChrW(a) ' Convert decimal to character | |
| sl = sl + 6 ' Move to the next character after the encoded sequence | |
| Case "E" ' UTF-8 URL encoding (e.g., %EXXX) | |
| hh = Mid(strIn, sl + kl, 2) ' Get the first two hex digits | |
| a = Val("&H" & hh) ' Convert hex to decimal | |
| If a < 128 Then | |
| sl = sl + 3 ' Move to the next character | |
| URLDecode = URLDecode & Chr(a) ' Convert to ASCII character | |
| Else | |
| ' For multibyte UTF-8 characters | |
| hi = Mid(strIn, sl + 3 + kl, 2) ' Get the next two hex digits | |
| hl = Mid(strIn, sl + 6 + kl, 2) ' Get the final two hex digits | |
| a = ((Val("&H" & hh) And &HF) * 2 ^ 12) Or ((Val("&H" & hi) And &H3F) * 2 ^ 6) Or (Val("&H" & hl) And &H3F) | |
| URLDecode = URLDecode & ChrW(a) ' Convert to a wide character | |
| sl = sl + 9 ' Move to the next character after the encoded sequence | |
| End If | |
| Case Else ' Standard ASCII URL encoding (e.g., %XX) | |
| hh = Mid(strIn, sl + kl, 2) ' Get the two hex digits | |
| a = Val("&H" & hh) ' Convert hex to decimal | |
| If a < 128 Then | |
| sl = sl + 3 ' Move to the next character | |
| Else | |
| hi = Mid(strIn, sl + 3 + kl, 2) ' Get the next two hex digits | |
| a = ((Val("&H" & hh) - 194) * 64) + Val("&H" & hi) ' Convert to a character code | |
| sl = sl + 6 ' Move to the next character after the encoded sequence | |
| End If | |
| URLDecode = URLDecode & ChrW(a) ' Convert to a wide character | |
| End Select | |
| ' Update the position of the last processed character | |
| tl = sl | |
| ' Find the next occurrence of the percent symbol | |
| sl = InStr(sl, strIn, key, vbTextCompare) | |
| Loop | |
| ' Append any remaining characters after the last percent symbol | |
| URLDecode = URLDecode & Mid(strIn, tl) | |
| Exit Function | |
| ErrorHandler: | |
| ' Display an error message if an error occurs | |
| MsgBox "An error occurred in URLDecode function: " & Err.Description, vbExclamation, "URLDecode Error" | |
| End Function | |
| '------------------------------------------------------------------------------ | |
| ' Function: URLEncode | |
| ' Description: Encodes a string into a URL-encoded format, supporting ASCII, Unicode, and UTF-8 encoding. | |
| ' Parameters: | |
| ' - txt: The string to encode. | |
| ' Returns: | |
| ' - The URL-encoded string. | |
| '------------------------------------------------------------------------------ | |
| Public Function URLEncode(ByRef txt As String) As String | |
| On Error GoTo ErrorHandler | |
| ' Declare and initialize variables | |
| Dim buffer As String | |
| Dim i As Long, c As Long, n As Long | |
| ' Initialize the buffer with enough space for the encoded string | |
| buffer = String$(Len(txt) * 12, "%") | |
| ' Loop through each character in the input string | |
| For i = 1 To Len(txt) | |
| ' Get the character code for the current character | |
| c = AscW(Mid$(txt, i, 1)) And 65535 | |
| ' Determine if the character needs to be encoded or can be left as is | |
| Select Case c | |
| Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95 ' Unescaped characters: 0-9, A-Z, a-z, - . _ ' | |
| n = n + 1 | |
| Mid$(buffer, n) = ChrW(c) ' Add the character to the buffer | |
| Case Is <= 127 ' Escaped UTF-8 1 byte (U+0000 to U+007F) ' | |
| n = n + 3 | |
| Mid$(buffer, n - 2) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 1) = Right$("0" & Hex$(c), 2) ' Add the hex representation | |
| Case Is <= 2047 ' Escaped UTF-8 2 bytes (U+0080 to U+07FF) ' | |
| n = n + 6 | |
| Mid$(buffer, n - 5) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 4) = Right$("0" & Hex$(192 + (c \ 64)), 2) ' Add the first byte of the encoded character | |
| Mid$(buffer, n - 2) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 1) = Right$("0" & Hex$(128 + (c Mod 64)), 2) ' Add the second byte of the encoded character | |
| Case 55296 To 57343 ' Escaped UTF-8 4 bytes (U+010000 to U+10FFFF) ' | |
| i = i + 1 | |
| c = 65536 + (c Mod 1024) * 1024 + (AscW(Mid$(txt, i, 1)) And 1023) | |
| n = n + 12 | |
| Mid$(buffer, n - 11) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 10) = Right$("0" & Hex$(240 + (c \ 262144)), 2) ' Add the first byte | |
| Mid$(buffer, n - 8) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 7) = Right$("0" & Hex$(128 + ((c \ 4096) Mod 64)), 2) ' Add the second byte | |
| Mid$(buffer, n - 5) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 4) = Right$("0" & Hex$(128 + ((c \ 64) Mod 64)), 2) ' Add the third byte | |
| Mid$(buffer, n - 2) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 1) = Right$("0" & Hex$(128 + (c Mod 64)), 2) ' Add the fourth byte | |
| Case Else ' Escaped UTF-8 3 bytes (U+0800 to U+FFFF) ' | |
| n = n + 9 | |
| Mid$(buffer, n - 8) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 7) = Right$("0" & Hex$(224 + (c \ 4096)), 2) ' Add the first byte | |
| Mid$(buffer, n - 5) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 4) = Right$("0" & Hex$(128 + ((c \ 64) Mod 64)), 2) ' Add the second byte | |
| Mid$(buffer, n - 2) = "%" ' Add the percent symbol | |
| Mid$(buffer, n - 1) = Right$("0" & Hex$(128 + (c Mod 64)), 2) ' Add the third byte | |
| End Select | |
| Next | |
| ' Trim the buffer to the actual length of the encoded string | |
| URLEncode = Left$(buffer, n) | |
| Exit Function | |
| ErrorHandler: | |
| ' Display an error message if an error occurs | |
| MsgBox "An error occurred in URLEncode function: " & Err.Description, vbExclamation, "URLEncode Error" | |
| End Function |
Source: ExcelVBA.ru Original Source: zhaojunpeng.com (defunct)
