Доброго дня, обращаюсь за советом или подсказкой, в решении вопроса авторизации на сайте путём POST -запроса сайт интернет магазин citilink.ru, путём "курения" интернета соорудил вот такое
Код
Sub AUTH()
Dim xmlWeb As New WinHttpRequest
Dim POST() As Byte, DataPost$
'On Error Resume Next
login$ = "https://login.citilink.ru/auth/login/?from=&back=citilink.ru"
DataPost = "email=lexey_fan%list.ru&pass=123456789&passOk=false" 'для авторизации (тестовый логин /пароль)
POST = StrConv(DataPost, vbFromUnicode)
With xmlWeb
.Open "POST", login$, False
'заголовки запроса
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
.setRequestHeader "Connection", "keep-alive"
' .setRequestHeader "Content-Type", "text/html" ' при этом заголовке выдаёт что фал существует
.setRequestHeader "Keep-Alive", "timeout=15"
.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
.setRequestHeader "Accept-Encoding", "gzip, deflate"
.setRequestHeader "Host", "login.citilink.ru"
.setRequestHeader "Origin", "http://www.citilink.ru"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.90 Safari/537.36"
.setRequestHeader "Referer", login$
.Send (POST): DoEvents ' отправка запроса авторизации
If .Status = 301 Then msgbox "OK"
end with
End sub
Если переменная login вида https.... то выдаёт ошибку операция отменена, если http то статус получает равны 200, при этом авторизация не проходит! заранее спасибо за внимание к вопросу!
Вроде неплохо написано. Много лишнего, это да. В коде коробит вездесущее XMLWeb - неужели нельзя было все сохранить под блоком With - End with? Если не ошибаюсь, достаточно было из RequestHeader оставить пункты User-agent и Content-Type. Ждем пользователя Doober - он горазд на качественные ответы по запросам в VBA.
Пытался авторизоваться на одном сайте (только с помощью Python) - похожие проблемы возникали. Так что подписываюсь на тему.
Sub AUTH()
Dim xmlWeb
Set xmlWeb = CreateObject("Msxml2.ServerXMLHTTP")
'On Error Resume Next
login$ = "https://login.citilink.ru/auth/login/?from=&back=citilink.ru&email=lexey_fan%40list.ru&pass=123456789&passOk=false"
'для авторизации (тестовый логин /пароль)
With xmlWeb
.Open "GET", login$, False
'заголовки запроса
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
.setRequestHeader "Accept-Encoding", "gzip, deflate"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.90 Safari/537.36"
.Send: DoEvents '
If .Status = 200 Then
If InStr(1, .responseText, "/logout/", vbTextCompare) > 0 Then
MsgBox "OK"
End If
End If
End With
End Sub
потому что, если сервер послушается, и отправит ответ в сжатом виде (gzip), — а такое бывает, в зависимости от настроек сайта, — то эта строка уже не сработает:
Код
If InStr(1, .responseText, "/logout/", vbTextCompare) > 0 Then
Доброго дня, С Вашего позволения подниму тему повторно, не удается что-то разобраться почему не авторизовывается, можете подсказать как поправить
Код
Sub AUTH()
Dim xmlWeb
Set xmlWeb = CreateObject("Msxml2.ServerXMLHTTP")
'On Error Resume Next
сlogin = "lexey_fan%40list.ru"
cPass = "123456789"
login$ = "https://login.citilink.ru/auth/login/?from=https%3A%2F%2Fwww.citilink.ru%2F&login=" & clogin & "&pass=" & cPass
'для авторизации (тестовый логин /пароль)
With xmlWeb
.Open "GET", login$, False
'заголовки запроса
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.90 Safari/537.36"
.Send: DoEvents
.Debug.print .responseText
If .Status = 200 Then
If InStr(1, .responseText, "/logout/", vbTextCompare) > 0 Then
MsgBox "OK"
End If
End If
End With
End Sub
Код не запускал, но проверил: 1. У Вас в первом случае сLogin начинается с русской буквы "c", а затем - с английской "c". Советую объявлять все переменные, а в начале модуля использовать Option Explicit, тогда такие опечатки легко будет найти. 2. Текстовое содержание cLogin отличается от того, что было в коде Сергея (Doober).
ZVI, да заметил что ошибся с переменой (копировал через телефон, что то подправлял, видимо просто ошибся), спасибо, а по поводу отличия формирования строки login от того что делал Сергей, сам сайт citilink изменил строку авторизации поэтому вносил правки, какое то время работало
там не функция их генерирует перед авторизацией, надо прогрузить любую страницу сайта (например, главную), — в её исходном коде найдете token и csfr (иногда они через cookie передаются, но обычно в HTML коде присутствуют)
а с капчей, - сложнее. надо показывать пользователю капчу, чтобы он вводил её вручную с картинки в поле формы проверить не на чем (нет логина-пароля для проверки), а без них капча не видна
Пробовал брать token и csfr с сайта, но при этом, если отправляю post запрос выкидывает на 404, если Get то просто не авторизовывает! Если вручную авторизовываться то капчу не показывает