Перекодировать урлы из юникода в текст

[_MBK_]

VBA - это макрос и есть. По этой ссылке только куски кода, который перекодирует. Изруквруки предлагает на весь текст его натравить? Нуну

 

[_MBK_]

А впрочем, попробуй. Максимальная пакость, которую этот макрос может сделать при тотальном перекодировании - погрохает случайно неотбитые проценты вместе с прилегающими символами. У меня всеж более интеллектуальный фильтр, но его еще реализовывать надо, проще потом внимательно все вычитать.

 

[dastin]

потыкался малость .. но уперся рогом
имеем вордовский документ с приведенными фрагментами

п/д: ugpark.suvarholding.ru/upload/ugpark/3_och/%D0%9F%D1%80%D0%BE%D0%B5%D0%BA%D1%82%D0%BD%D0%B0%D1%8F%20%D0%B4%D0%B5%D0%BA%D0,

создаем макрос в ворде ... а он у меня 2003 ... такого типа

Option Explicit
Sub Decode()
Dim oDoc As Word.Document
Dim st As String
st = Selection.text
URLdecode st
Selection.text = st
End Sub

Public Function URLdecode(st As String) As String

Dim TempAns As String
Dim CurChr As Integer

CurChr = 1

Do Until CurChr - 1 = Len(st)
  Select Case Mid(st, CurChr, 1)
    Case "+"
      TempAns = TempAns & " "
    Case "%"
      TempAns = TempAns & Chr(Val("&h" & _
         Mid(st, CurChr + 1, 2)))
       CurChr = CurChr + 2
    Case Else
      TempAns = TempAns & Mid(st, CurChr, 1)
  End Select

CurChr = CurChr + 1
Loop
st = TempAns
End Function

выделяем строку (тут может быть результат какого-то поиска вместо выделения) - вызываем макрос
получаем следующее

п/д: ugpark.suvarholding.ru/upload/ugpark/3_och/Проектная декР

т.е. раскодирование происходит, но кодировка строки становится смешанной UTF-8 + СР-1251

 

[_MBK_]

Откуда ты это взял? Там же есть вполне работоспособный URLdecode

 

[dastin]

Откуда ты это взял? Там же есть вполне работоспособный URLdecode

из гугла вестимо ... взял первого попавшегося за ногу ... там же есть? ... гдеэтогдеэтогдеэто?

 

[_MBK_]

По твоей же ссылке

 

[dastin]

ага ... вот так всё работает

Спойлер: макрос для ворда Decode

Option Explicit
Sub Decode()
Dim strin As String
strin = Selection.text
Selection.text = CStr(URLDecode(strin))
End Sub

Function URLDecode(ByVal strin) As String
    ' âçÿòî çäåñü: 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

 

[Oleg Butrin]

â ðåäàêöèè EducatedFool

Забавно!

 

[dastin]

это комментарии побились

 

[dastin]

гхм ... версия вторая, регэкспная ( в первый раз - чеслово), по всему документу, с докладом.

Спойлер: DecodeURL macros for Word

Option Explicit
Sub Decode()

Dim RE As New RegExp, aMatch As Match, colMatches As MatchCollection
Dim c As String, u As Integer, ToGraf As Paragraph, trange As Range, tekst As String

RE.Global = False: RE.IgnoreCase = False: RE.Pattern = "/%..\%.*?,"
u = 0
For Each ToGraf In ActiveDocument.Paragraphs
Set trange = ToGraf.Range
trange.MoveEnd unit:=wdCharacter, Count:=-1
Set colMatches = RE.Execute(trange)
For Each aMatch In colMatches
' a = aMatch.FirstIndex
' b = aMatch.Length
c = aMatch.Value
u = u + 1
Next aMatch
trange = URLDecode(trange)
tekst = ""
trange.Text = RE.Replace(trange.Text, tekst)
Next ToGraf
MsgBox "Sir, obyskali vsyo, ras4lenili " & u & " URL"
End Sub

Function URLDecode(ByVal strTest) As String
' source: zhaojunpeng.com/posts/2016/10/28/excel-urldecode
' editor EducatedFool
On Error Resume Next
Dim sl&, tl&, key$, kl&
sl = 1: tl = 1: key = "%": kl = Len(key)
sl = InStr(sl, strTest, key, 1)
Do While sl > 0
If (tl = 1 And sl <> 1) Or tl < sl Then
URLDecode = URLDecode & Mid(strTest, tl, sl - tl)
End If
Dim hh$, hi$, hl$, a$
Select Case UCase(Mid(strTest, sl + kl, 1))
Case "U" 'Unicode URLEncode
a = Mid(strTest, sl + kl + 1, 4)
URLDecode = URLDecode & ChrW("&H" & a)
sl = sl + 6
Case "E" 'UTF-8 URLEncode
hh = Mid(strTest, sl + kl, 2)
a = Int("&H" & hh) 'ascii?
If Abs(a) < 128 Then
sl = sl + 3
URLDecode = URLDecode & Chr(a)
Else
hi = Mid(strTest, sl + 3 + kl, 2)
hl = Mid(strTest, 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(strTest, sl + kl, 2) '??
a = Int("&H" & hh) 'ascii?

If Abs(a) < 128 Then
sl = sl + 3
Else
hi = Mid(strTest, 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, strTest, key, 1)
Loop
URLDecode = URLDecode & Mid(strTest, tl)
End Function

 

[Йожег]

Будем пробовать.

Не по теме:
печаль что в текст они уже вставляются обрезанными (проектная дек) уж не знаю кто косячит автор объявы или при выгрузке их плющит.

 

[dastin]

Будем пробовать

да уж не без этого может и поправить чего надо ...
а то, вот эта бельгийская буковка на конце мне не внушает
регэксп ищет /%+2символа+% и до запятой ... а на выходе запятой нет как нет