UrlEncode

[Мамонт]

Вопрос в следующем. Мне надо отправить серверу запрос в котором содержется руский текст. Просто текст отправить то нельзя, нашёл функцию UrlEncode, но она работает неправельно. Я перехватил запросы браузера и допустим он кодирует букву "ы" как %D1%8B а все примеры на VB кодируют ту же букву как %FB
и отправляя такой запрос меня сервер несовсем понимает. Вернее отображает руский текст неправельно.

[Хакер]

Важно спросить: где ты её нашёл?

[Мамонт]

Нашёл её тут на форуме! Потом перекопал исходников 10! Все они примерно одинаковые и кодируют также неправельно как нужно!

[Хакер]

Не там искал.
Искать надо в библиотеке wininet.dll.

InternetCanonicalizeUrl

[Мамонт]

немогу разобраться

у меня только пробелы кодирует.

[Хакер]

Это значит, что ты используешь флаг ICU_ENCODE_SPACES_ONLY. Не используй его.

[Мамонт]

Я использую ICU_ENCODE_PERCENT и всёравно некодирует, а только пробелы

[Мамонт]

Код: Выделить всё

Private Declare Sub InternetCombineUrl Lib "wininet.dll" Alias "InternetCombineUrlA" (ByVal lpszBaseUrl As String, ByVal lpszRelativeUrl As String, ByVal lpszBuffer As String, ByRef lpdwBufferLength As Long, ByVal dwFlags As Long)

Private Const ICU_BROWSER_MODE = &H2000000
Private Const ICU_DECODE = &H10000000
Private Const ICU_ENCODE_PERCENT = &H1000
Private Const ICU_ENCODE_SPACES_ONLY = &H4000000
Private Const ICU_ESCAPE = &H80000000
Private Const ICU_NO_ENCODE = &H20000000
Private Const ICU_NO_META = &H8000000
Private Const ICU_USERNAME = &H40000000

Private Sub Form_Load()
Dim strBuffer As String
strBuffer = String(255, 0)
InternetCombineUrl "http://www.ya.ru", "ыы", strBuffer, 255, ICU_ENCODE_PERCENT
strBuffer = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)
Debug.Print strBuffer
End Sub

вот собственно...и не работает!!!!(

[Мамонт]

Решение проблемы:

Код: Выделить всё

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Function GetEncodedUTF8String( _
      ByVal Text As String _
   ) As String
   
   Dim Index1 As Long
   Dim Index2 As Long
   Dim Result As String
   Dim Chars() As Byte
   Dim Char As String
   Dim Byte1 As Byte
   Dim Byte2 As Byte
   Dim UTF16 As Long

   For Index1 = 1 To Len(Text)
      CopyMemory Byte1, ByVal StrPtr(Text) + ((Index1 - 1) * 2), 1
      CopyMemory Byte2, ByVal StrPtr(Text) + ((Index1 - 1) * 2) + 1, 1
      UTF16 = Byte2
      UTF16 = UTF16 * 256 + Byte1
      Chars = GetUTF8FromUTF16(UTF16)
      For Index2 = LBound(Chars) To UBound(Chars)
         Char = Chr(Chars(Index2))
         If Char Like "[0-9A-Za-z]" Then
            Result = Result & Char
         Else
            Result = Result & "%" & Hex(Asc(Char))
         End If
      Next
   Next
   
   GetEncodedUTF8String = Result
   
End Function

Public Function GetUTF8FromUTF16( _
      ByVal UTF16 As Long _
   ) As Byte()

   Dim Result() As Byte
   
   If UTF16 < &H80 Then
      ReDim Result(0 To 0)
      Result(0) = UTF16
   ElseIf UTF16 < &H800 Then
      ReDim Result(0 To 1)
      Result(1) = &H80 + (UTF16 And &H3F)
      UTF16 = UTF16 \ &H40
      Result(0) = &HC0 + (UTF16 And &H1F)
   Else
      ReDim Result(0 To 2)
      Result(2) = &H80 + (UTF16 And &H3F)
      UTF16 = UTF16 \ &H40
      Result(1) = &H80 + (UTF16 And &H3F)
      UTF16 = UTF16 \ &H40
      Result(0) = &HE0 + (UTF16 And &HF)
   End If
   GetUTF8FromUTF16 = Result
   
End Function