Функция на 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
Уже мозг начинал взрываться от поиска именно этого преобразования
Сейчас сижу и улыбаюсь монитору.
Отправить комментарий