Преобразование строки, содержащей кириллицу, в URLEncode

Функция на VBA, которая преобразовывает Unicode (русский текст) в URLencode (Percent Encoding)

Public Function URL_Encode(ByRef txt As String) As String
    Dim buffer As String, i As Long, c As Long, n As Long
    buffer = String$(Len(txt) * 12, "%")
 
    For i = 1 To Len(txt)
        c = AscW(Mid$(txt, i, 1)) And 65535
 
        Select Case c
            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95  ' Unescaped 0-9A-Za-z-._ '
                n = n + 1
                Mid$(buffer, n) = ChrW(c)
            Case Is <= 127            ' Escaped UTF-8 1 bytes U+0000 to U+007F '
                n = n + 3
                Mid$(buffer, n - 1) = Right$(Hex$(256 + c), 2)
            Case Is <= 2047           ' Escaped UTF-8 2 bytes U+0080 to U+07FF '
                n = n + 6
                Mid$(buffer, n - 4) = Hex$(192 + (c \ 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
            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 - 10) = Hex$(240 + (c \ 262144))
                Mid$(buffer, n - 7) = Hex$(128 + ((c \ 4096) Mod 64))
                Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
            Case Else                 ' Escaped UTF-8 3 bytes U+0800 to U+FFFF '
                n = n + 9
                Mid$(buffer, n - 7) = Hex$(224 + (c \ 4096))
                Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
        End Select
    Next
    URL_Encode = Left$(buffer, n)
End Function

См. также функцию обратного преобразования — URLdecode:

Function URLDecode(ByVal strIn)
    ' взято здесь: zhaojunpeng.com/posts/2016/10/28/excel-urldecode
    ' в редакции EducatedFool
    On Error Resume Next
    Dim sl&, tl&, key$, kl&
    sl = 1:    tl = 1: key = "%": 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$, 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?
                    a = (Int("&H" & hh) - 194) * 64 + Int("&H" & hi)
                    sl = sl + 6
                End If
                URLDecode = URLDecode & ChrW(a)
        End Select
        tl = sl
        sl = InStr(sl, strIn, key, 1)
    Loop
    URLDecode = URLDecode & Mid(strIn, tl)
End Function

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Благодарность автору!! не передать сколько времени сэкономлено

Спасибо! Функция сэкономила мне день работы. Для тех, кто не понимает, как это использовать - погуглите "Как использовать функцию VBA в exel". Я сам в Visual Basic не сильно соображаю, но десять минут поиска в сети и все моим ссылки для Google Ads переделаны.

А как URLdecode воспользоваться, запихнуть функцию в стандартный модуль а потом строку передать или как то по другому, можно пример если не затруднит?

С п а с и б о!

Андрей, сделать что?
в какой кодировке у вас текстовая строка изначально? и в какую надо перевести? и зачем вообще это делаете?

Как сделать то же самое, но не для Unicode, а Windows-1251 ?

Спасибо, ребят, что вы существуете! Пошел писать функцию для rskript, за основу возьму ваш труд. =)

два пробела меняются на последовательность %20%20. Какую строку преобразуете и что получается?

Круто! Но есть маленький недочет, если в ссылке стоит 2 пробела подряд, они заменяются на 1 знак %20 и ссылка перестает работать, т.к. правильный вариант, когда 2 пробела заменяются на 2 знака %20%20. Как можно это исправить?

А как в exele это заюзать?

АААААА
СПАСИБО!!!!!!!!!!!!!11
Уже мозг начинал взрываться от поиска именно этого преобразования
Сейчас сижу и улыбаюсь монитору.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
                         ___     __    __        __      
__ __ __ __ / _ \ / /_ \ \ / / ___
\ \ /\ / / \ \ /\ / / | (_) | | '_ \ \ \ /\ / / / __|
\ V V / \ V V / \__, | | (_) | \ V V / \__ \
\_/\_/ \_/\_/ /_/ \___/ \_/\_/ |___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.