Установить аутентификацию XMLHTTP экспорта HTML

Question

Я пытаюсь использовать следующий код, чтобы можно было экспортировать указанную c HTML страницу, но веб-сайту требуются учетные данные. Вот моя попытка

Sub NewTest()
Const sURL As String = "https://courses.myexcelonline.com/courses/take/microsoft-teams/lessons/11482643-microsoft-teams-course-overview"
Dim http As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument

Set http = New MSXML2.XMLHTTP60
Set html = New MSHTML.HTMLDocument

Dim sUser As String, sPass As String
sUser = Application.WorksheetFunction.EncodeURL("myemail")
sPass = Application.WorksheetFunction.EncodeURL("mypass")

Dim postData As String
postData = "user%5Bemail%5D=" & sUser & "&user%5Bpassword%5D=" & sPass

With http
    .Open "POST", sURL, False
    .setRequestHeader "User-Agent", "Mozilla/5.0"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send postData
    html.body.innerHTML = .responseText
    ExportHTML .responseText
End With

Stop
End Sub

Sub ExportHTML(sInput As String)
With CreateObject("ADODB.Stream")
    .Charset = "UTF-8"
    .Open
    .WriteText sInput
    .SaveToFile Environ("USERPROFILE") & "\Desktop\OutputHTML.html", 2
    .Close
End With
End Sub

Я не знаю, что не так с моим кодом .. Я ожидаю, что на моем рабочем столе будет храниться указанная страница c HTML, но когда я открою страницу HTML, я не нашел страницу, но нашел запрос учетных данных для электронной почты и пароля.

Я изменил URL, и это решило проблему, я думаю Const sURL As String = "https://courses.myexcelonline.com/users/sign_in". Но мне нужно знать, как получить указанную c HTML страницу с сайта?

Answer 1

Похоже, что вы отправляете «GET» вместо «POST».

Поскольку вы отправляете данные POST с вашим запросом, вам нужно изменить «GET» на «POST»

.Open "Get", sURL, False

Кому

.Open "POST", sURL, False

РЕДАКТИРОВАТЬ: URL-адрес, который вы предоставили, не соответствует POST, а скорее GET.

Вам необходимо отправить запрос GET на сначала страница входа, затем POST на той же URL-странице входа, что и - https://courses.myexcelonline.com/users/sign_in, затем GET на исходный URL-адрес, предоставленный, поскольку к тому моменту вы уже вошли в систему и можете перейти к Ваш URL правильно.

Вот пример данных POST - маркер подлинности можно найти, когда вы отправляете отправку первого GET на страницу входа в HTML. Для этого получите .responseText после запрос GET. Затем вы можете использовать функцию Split для получения токена аутентификации следующим образом.

<meta name="csrf-param" content="authenticity_token" />
<meta name="csrf-token" content="ReGa49vTQ0KqSZtje3VerA8q3O9J1RLO7lEU/+q1hccys6S1uXn6UigKiKTjDp2yEFQRpYpziRQLnXifJLxb+Q==" />

Dim authToken As String
authToken = Application.WorksheetFunction.EncodeURL(Split(Split(http.responseText, "csrf-token"" content=""")(1), """")(0))

Dim postData As String
postdata = "utf8=%E2%9C%93&authenticity_token=" & authToken & "&user%5Bemail%5D=" & sUser & "&user%5Bpassword%5D=" & sPass & "&user%5Bremember_me%5D=0"

Вот окончательный код

Sub NewTest()
Const sURL As String = "https://courses.myexcelonline.com/courses/take/microsoft-teams/lessons/11482643-microsoft-teams-course-overview"
Const sLoginURL As String = "https://courses.myexcelonline.com/users/sign_in"
Dim http As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument

Set http = New MSXML2.XMLHTTP60
Set html = New MSHTML.HTMLDocument

Dim sUser As String, sPass As String, sAuthToken As String, postData As String
sUser = Application.WorksheetFunction.EncodeURL("myemail")
sPass = Application.WorksheetFunction.EncodeURL("mypass")

'Load Login Page
With http
    .Open "GET", sLoginURL, False
    .setRequestHeader "User-Agent", "Mozilla/5.0"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send
    .WaitForResponse
    html.body.innerHTML = .responseText
End With

'Get Auth Token from HTML
sAuthToken = Application.WorksheetFunction.EncodeURL((Split( (Split(http.body.innerHTML, "csrf-token"" content=""")(1)), """")(0)))

'Construct the POST data that will be sent
postData = "utf8=%E2%9C%93&authenticity_token=" & sAuthToken & "&user%5Bemail%5D=" & sUser & "&user%5Bpassword%5D=" & sPass & "&user%5Bremember_me%5D=0"

'Attempt to login 
With http
    .Open "POST", sLoginURL, False
    .setRequestHeader "User-Agent", "Mozilla/5.0"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send (postData)
    .WaitForResponse
End With

'Add code here to verify if login was successful...

'If successful... navigate to sURL 
With http
    .Open "GET", sURL, False
    .setRequestHeader "User-Agent", "Mozilla/5.0"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send 
    .WaitForResponse
    html.body.innerHTML = .responseText
    ExportHTML .responseText
End With

Stop
End Sub

Sub ExportHTML(sInput As String)
With CreateObject("ADODB.Stream")
    .Charset = "UTF-8"
    .Open
    .WriteText sInput
    .SaveToFile Environ("USERPROFILE") & "\Desktop\OutputHTML.html", 2
    .Close
End With
End Sub
enter code here