Ребят, помогите к картинке прикрутить еще и текстовое описание.
У метода sendPhoto помимо указания чат-ID и photo есть еще опциональная возможность указывать caption (текст, который будет прикреплен к картинке).
Вроде все правильно делаю, но не хотят сообщения на русском прикрепляться, хотя и энкодирую их в UTF-8.
Если прикреплять сообщение английскими буквами, то все ок отрабатывает, с кириллицей же никак не хочет.
В итоге в виде response приходит ошибка, что текст д.б. декодирован в UTF8. Но он ведь и декодирован.
[img]C:\Тест%20бота%20Телеграмм\Безымянный.jpg[/img]
У метода sendPhoto помимо указания чат-ID и photo есть еще опциональная возможность указывать caption (текст, который будет прикреплен к картинке).
Вроде все правильно делаю, но не хотят сообщения на русском прикрепляться, хотя и энкодирую их в UTF-8.
Если прикреплять сообщение английскими буквами, то все ок отрабатывает, с кириллицей же никак не хочет.
Код |
---|
Public Sub telegram_send_picture() Const URL = "https://api.telegram.org/bot" Const TOKEN = "bla-bla-bla:some_TOKEN" ' тут токен бота Const METHOD_NAME = "/sendPhoto?" Const CHAT_ID = "-1234567890" ' тут ID чата, куда послать картинку Const FOLDER = "C:\Тест бота Телеграмм\" ' папка, в которой лежит картинка Const JPG_FILE = "Picture1.jpg" ' имя картинки с расширением Dim msg$: msg = "Какой-то русский текст" ' сообщение (описание), которое надо прикрепить к картинке. ' Если сюда указать английский текст, то все отлично работает. С русскими буквами не хочет msg = EncodeUTF8noBOM(msg) ' переводим русский текст в UTF-8 (функция описана ниже) Dim data As Object, key Set data = CreateObject("Scripting.Dictionary") data.Add "chat_id", CHAT_ID ' добавляем в словарь чат-ID data.Add "caption", msg ' добавляем в словарь текст, который надо прикрепить к картинке, переведенный в UTF-8 BOUNDARY = "--OYWFRYGNCYQAOCCT44655,4239930556" ' разделитель для form-data 'заполняем словарь форм датами чат-ID и сообщения Dim part As String, ado As Object For Each key In data.keys part = part & "--" & BOUNDARY & vbCrLf part = part & "Content-Disposition: form-data; name=""" & key & """" & vbCrLf & vbCrLf part = part & data(key) & vbCrLf Next ' filename part = part & "--" & BOUNDARY & vbCrLf part = part & "Content-Disposition: form-data; name=""photo""; filename=""" & JPG_FILE & """" & vbCrLf & vbCrLf ' read jpg file as binary Dim jpg Set ado = CreateObject("ADODB.Stream") ado.Type = 1 'binary ado.Open ado.LoadFromFile FOLDER & JPG_FILE ado.Position = 0 jpg = ado.read ado.Close ' combine part, jpg , end ado.Open ado.Position = 0 ado.Type = 1 ' binary ado.Write ToBytes(part) ado.Write jpg ado.Write ToBytes(vbCrLf & "--" & BOUNDARY & "---") ado.Position = 0 Dim req As Object, reqURL As String Set req = CreateObject("MSXML2.XMLHTTP") reqURL = URL & TOKEN & METHOD_NAME With req .Open "POST", reqURL, False .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY .send ado.read MsgBox .responseText End With End Sub Function ToBytes(str As String) As Variant Dim ado As Object Set ado = CreateObject("ADODB.Stream") ado.Open ado.Type = 2 ' text ado.Charset = "_autodetect" ado.WriteText str ado.Position = 0 ado.Type = 1 ToBytes = ado.read ado.Close End Function ' перевод в UTF8 Function EncodeUTF8noBOM(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 = Chr(AscW(l) \ 64 \ 64 + 224) & Chr(AscW(l) \ 64) & Chr(8 * 16 + AscW(l) Mod 64) Case Is > 127: t = Chr(AscW(l) \ 64 + 192) & Chr(8 * 16 + AscW(l) Mod 64) Case Else: t = l End Select EncodeUTF8noBOM = EncodeUTF8noBOM & t Next End Function |
В итоге в виде response приходит ошибка, что текст д.б. декодирован в UTF8. Но он ведь и декодирован.
[img]C:\Тест%20бота%20Телеграмм\Безымянный.jpg[/img]