Кодирование URL

Пользователь

Сообщений: 39 Регистрация: 19.10.2014

29.01.2015 16:05:24

Задача закодировать URL в валидный URI формат.
т.е. к примеру у нас есть ссылка типа http://www.site.com/привет.jpg закодировать надо как http://www.site.com/[ТУТ КОДИРОВАНЫЙ ТЕКСТ].jpg
Есть код который кодирует URL:

Код

     Function URLEncode(ByVal Text As String) As String
      Dim i As Integer
      Dim acode As Integer
      Dim char As String
      URLEncode = Text
      For i = Len(URLEncode) To 1 Step -1
        acode = Asc(Mid$(URLEncode, i, 1))
        Select Case acode
          Case 48 To 57, 65 To 90, 97 To 122
            ' don't touch alphanumeric chars
          Case 32
            ' replace space with "+"
            Mid$(URLEncode, i, 1) = "+"
          Case Else
            ' replace punctuation chars with "%hex"
            URLEncode = Left$(URLEncode, i - 1) & "%" & Hex$(acode) & Mid$(URLEncode, i + 1)
        End Select
      Next
    End Function

Но он кодирует и символы типа "/", ":" и т.д. Мне надо чтобы эти символы он также не трогал, также как не трогает латинские символы. Вообщем также кодировал как тот же файерфокс например когда копируешь ссылку из адресной строки.В коде походу надо совсем чуть чуть что то поменять, но в силу того что в этом совсем не разбираюсь, прошу помощи у вас.

Изменено: myrecs - 29.01.2015 16:18:45

Игорь Пользователь Сообщений: 3697 Регистрация: 23.12.2012	#2 29.01.2015 16:57:45 http://excelvba.ru/code/URLencode Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

myrecs

Пользователь

Сообщений: 39 Регистрация: 19.10.2014

29.01.2015 18:43:34

правда есть один минус. например символ "№" почему то преобразовывает неправильно.
Вот как преобразовывает Файерфокс: %E2%84%96
А вот как функция: %144%96

соответственно ссылка по факту становится нерабочей. Что посоветуете там поправить? Для удобства добавлю код сюда

Код

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

Игорь

Пользователь

Сообщений: 3697 Регистрация: 23.12.2012

29.01.2015 19:08:51

Примерно так должна функция выглядеть:

Код

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

в коде не учитывается, что функция HEX может вернуть значение из одного символа, - в этом случае надо добавлять после %

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

myrecs Пользователь Сообщений: 39 Регистрация: 19.10.2014	#5 29.01.2015 23:13:02 благодарю величайше!

Читают тему