При загрузке главной страницы браузер выполняет много запросов (в том числе и запросы, инициированные скриптами)
В ответ на разные запросы, сервером могут возвращаться разные куки (которые заменяют или дополняют предыдущие)
Смотрите, по каким запросам появляются эти куки, и выполняйте макросом аналогичные запросы:
Причем, это еще не всё
Некоторые куки ставятся в момент редиректов.
Сайт перенаправляет вас 2-3 раза, а ваш код считает заголовки ответа сервера только из последнего из 2-3 перенаправлений (и вы можете потерять кукисы, которые сайт выдавал в первых редиректах)
Чтобы это учесть, надо заметно усложнять функцию загрузки страницы:
| Код |
|---|
' ...
' отключаем авторедирект, чтобы получать cookies при каждом редиректе
wHTTP.Option(WinHttpRequestOption_EnableRedirects) = False
' ...
wHTTP.Send
' считываем и запоминаем куки
ResponseHeaders$ = DecodeUTF8(wHTTP.GetAllResponseHeaders)
SaveCookiesFromResponseHeaders ResponseHeaders$
' если есть заголовок Location - выполняем редирект
URL$ = GetRedirectLocation(ResponseHeaders$, wHTTP.Option(WinHttpRequestOption_URL))
While IsURL(URL$) ' ЦИКЛ ДЛЯ РЕДИРЕКТОВ
RedirectsCount& = RedirectsCount& + 1
If RedirectsCount& > 5 Then
AddBalloon "Зацикливание редиректа на " & CreateHTMLlink(URL$) & "<br />Загрузка страницы прервана.", bt_Warning
GoTo StopRedirects
End If
If (PrevRedirectURL$ = URL$) And (RedirectsCount& > 1) Then
' надо очистить заголовки запроса, т.к. там старые Host и Referer
Set wHTTP = New WinHttpRequest
RequestHeadersStore.RemoveAll
AddStandartHeadersIntoStore URL$
AddRequestHeadersFromStore
If Not WP Is Nothing Then WP.Proxy.Apply
End If
wHTTP.Open "GET", URL$, True
AddRequestHeadersFromStore
PrevRedirectURL$ = URL$
PreviousCookies$ = GetCookiesFromStore
If Not CookiesStore Is Nothing Then wHTTP.SetRequestHeader "Cookie", GetCookiesFromStore
wHTTP.Send
URL$ = ""
If wHTTP.WaitForResponse(Timeout&) Then
' MsgBox .GetAllResponseHeaders, vbCritical
ResponseHeaders$ = "": ResponseHeaders$ = wHTTP.GetAllResponseHeaders
SaveCookiesFromResponseHeaders ResponseHeaders$
URL$ = GetRedirectLocation(ResponseHeaders$, wHTTP.Option(WinHttpRequestOption_URL))
End If
Wend
' ...
|
Есть другой вариант — открыть страницу в браузере IE, и потом считать все Cookies из IE
Причем тут 2 варианта считывания — из документа IE (много, но не все, путем обращения к IE.document.Cookie), и напрямую из текстовых файлов Cookies (там точно всё считается)
И с этими кукисами потом выполнять запрос средствами WinHttp
Пример кода для считывания куки из системных файлов:
| Код |
|---|
Function GetIECookiesFromFiles(ByVal domain$, Optional Apply As Boolean) As String
On Error Resume Next
Dim sCookiesPath$, oCookies As Object, oFSO As Object, oFolder As Object, oFile
Dim sContent As String, a() As String, i As Long, aItems, aCookies()
' read IE cookie files
sCookiesPath = CreateObject("shell.application").Namespace("shell:Cookies").self.Path
Set oCookies = CreateObject("Scripting.Dictionary")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sCookiesPath)
For Each oFile In oFolder.Files
If LCase(oFSO.GetExtensionName(oFile.Name)) = "txt" Then
With oFile.OpenAsTextStream(1, 0) ' read-only, ascii
sContent = .ReadAll
.Close
End With
sContent = Replace(sContent, vbCr, "")
' split cookies within file
a = Split(sContent, vbLf & "*" & vbLf)
For i = 0 To UBound(a) - 1
If InStr(1, a(i), domain$, vbTextCompare) > 0 Then oCookies.Add oCookies.Count, a(i)
Next
End If
Next
' parse data, repack to 2d array
aItems = oCookies.Items()
If UBound(aItems) = -1 Then Exit Function
' If CookiesStore Is Nothing Then Set CookiesStore = New Dictionary ' глобальный словарь с cookies
ReDim aCookies(1 To UBound(aItems) + 1, 1 To 6)
Dim param_name$, param_value$, NewCookiesList$
For i = 1 To UBound(aItems) + 1
a = Split(aItems(i - 1), vbLf)
param_name$ = "": param_value$ = ""
param_name$ = a(0)
param_value$ = a(1)
If Len(param_name$) Then
NewCookiesList$ = NewCookiesList$ & IIf(NewCookiesList$ = "", "", vbLf) & param_name$
GetIECookiesFromFiles = GetIECookiesFromFiles & IIf(GetIECookiesFromFiles = "", "", "; ") & param_name$ & "=" & param_value$
CookiesStore.Item(param_name$) = param_value$
End If
Next
If (Len(NewCookiesList$) > 0) Then
Debug.Print "Добавлено cookies из файлов IE: " & 1 + Len(NewCookiesList$) - Len(Replace(NewCookiesList$, vbLf, ""))
End If
End Function
Sub test_IECookies()
' сначала надо открыть сайт https://www.planetaexcel.ru/ в браузере IE
' и только потом запускать этот макрос
res = GetIECookiesFromFiles("planetaexcel.ru")
Debug.Print res
' пример результата:
' Добавлено cookies из файлов IE: 6
' PHPSESSID=ZxFVnPmSxkYRIWHYk45QG1wpw67HjW4S; ct_sfw_pass_key=d923fe31370fb636c3ae0bbe78f888370; BX_USER_ID=dc035afce16c0c73611c8af1423dd; _ga=GA1.2.660066615.1645556965; _gid=GA1.2.1591444045.1644333965; _gat=1
End Sub
|
