Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Кодирование URL
 
#1
29.01.2015 16:05:24
Задача закодировать URL в валидный URI формат.
т.е. к примеру у нас есть ссылка типа http://www.site.com/привет.jpg закодировать надо как http://www.site.com/[ТУТ КОДИРОВАНЫЙ ТЕКСТ].jpg
Есть код который кодирует URL:

Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
     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
 
 
 
#2
29.01.2015 16:57:45
http://excelvba.ru/code/URLencode
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
29.01.2015 18:43:34
:)
правда есть один минус. например символ "№" почему то преобразовывает неправильно.
Вот как преобразовывает Файерфокс: %E2%84%96
А вот как функция: %144%96

соответственно ссылка по факту становится нерабочей. Что посоветуете там поправить? Для удобства добавлю код сюда
Код
?
1
2
3
4
5
6
7
8
9
10
11
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
 
 
 
#4
29.01.2015 19:08:51
Примерно так должна функция выглядеть:

Код
?
1
2
3
4
5
6
7
8
9
10
11
12
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  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#5
29.01.2015 23:13:02
благодарю величайше!
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...