MyTetra Share
Делитесь знаниями!
Преобразование строки, содержащей кириллицу, в URLEncode
31.12.2017
15:38
Текстовые метки: Encode
Раздел: VBA - Кодировки

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

Пользовательская функция на VBA, которая преобразовывает Unicode (русский текст) в URLencode

Function RussianStringToURLEncode(ByVal txt As String) As String

For i = 1 To Len(txt)

l = Mid(txt, i, 1)

Select Case AscW(l)

Case Is > 256: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)

Case 32: t = "+"

Case Else: t = l

End Select

RussianStringToURLEncode = RussianStringToURLEncode & t

Next

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



Еще один вариант функции:

Function RussianStringToURLEncode(ByVal txt As String) As String

Dim i&, l$, t$

For i = 1 To Len(txt)

l = Mid(txt, i, 1)

Select Case AscW(l)

Case Is >= 256: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)

Case Else: t = "%" & Hex(AscW(l) \ 16) & Hex(AscW(l) Mod 16)

End Select

RussianStringToURLEncode = RussianStringToURLEncode & t

Next

End Function



новая версия

Function RussianStringToURLEncode_New(ByVal txt As String) As String

For i = 1 To Len(txt)

l = Mid(txt, i, 1)

Select Case AscW(l)

Case Is > 4095: t = "%" & Hex(AscW(l) \ 64 \ 64 + 224) & "%" & Hex(AscW(l) \ 64) & "%" & Hex(8 * 16 + AscW(l) Mod 64)

Case Is > 127: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)

Case 32: t = "%20"

Case Else: t = l

End Select

RussianStringToURLEncode_New = RussianStringToURLEncode_New & t

Next

End Function

  • 12891 просмотр
Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования