|
Пользовательская функция на 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
|
