Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Авторизация на сайте с помощью WinHttpRequest, Как склеить несколько заголовков Cookie
 
#1
05.10.2014 11:47:21
Вот ответ сайта:
Цитата
HTTP/1.1 302 Found Server: nginx
Date: Sun, 05 Oct 2014 05:42:30 GMT
Content-Type: text/html; charset=utf-8
Content-Length: 131
Connection: keep-alive
Keep-Alive: timeout=20
Cache-Control: private
Location: http://24au.ru
X-AspNetMvc-Version: 3.0
X-AspNet-Version: 4.0.30319
Set-Cookie: Hy701jhkafgPOOYWoehf=346361558F578934C6DDB9182D28E6329737246­33EAE037CB16B1859BE0D43905DB01491DF3938D106A6CBD7C967926807F­F9B5B2B1C6F0B77D269E6B665AB40; domain=.24au.ru; path=/; HttpOnly
Set-Cookie: m_auth=0E4E522DDF280B295655C6A195928745; domain=.24au.ru; path=/; HttpOnly
Set-Cookie: e8839924dda2757bd102e60b15c66777=A7D6D04C-A07E-48D6-9EE7-42F8B0B14D2B; domain=24au.ru; expires=Sat, 05-Oct-2024 05:42:32 GMT; path=/ Set-Cookie: is_adult=0; domain=24au.ru; expires=Sun, 05-Oct-2014 17:42:32 GMT; path=/
Не могу склеить несколько заголовков кукисов (((
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Function auth() As String
    ' возвращает идентификатор сессии в случае удачной авторизации,  или пустую строку при ошибке
   On Error Resume Next
    Dim oXMLHTTP As New WinHttpRequest
    With oXMLHTTP
        ' первый запрос - для получения идентификатора сессии
       .Open "GET", "http://krsk.24au.ru/", False
       .setRequestHeader "Host", "krsk.24au.ru"
       .setRequestHeader "Connection", "keep-alive"
       .setRequestHeader "Cache-Control", "max-age=0"
       .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.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.124 Safari/537.36"
       .setRequestHeader "Referer", "http://krsk.24au.ru/"
       .setRequestHeader "Accept-Encoding", "gzip , deflate, sdch"
       .setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
       .send
        
        For Each .getResponseHeader("Set-Cookie") In .getAllResponseHeaders()
        cookie$ = cookie$ + .getResponseHeader("Set-Cookie")
        Next
         
       If Not cookie$ Like "*SessionId=*" Then
            MsgBox "Ошибка получения идентификатора сессии", vbCritical, "Обратитесь к разработчику программы"
            Exit Function
        End If
 
        ' отключаем редирект
       .Option(WinHttpRequestOption_EnableRedirects) = False
        ' второй запрос - для авторизации
       .Open "POST", "http://common.24au.ru/login/", False
        PostData = "ReturnUrl=http://krsk.24au.ru/&UserName=" & Пользователь & "&Password=" & Пароль & "&RememberMe=false"
         
        .setRequestHeader "Host", "common.24au.ru"
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Content-Length", "88"
        .setRequestHeader "Cache-Control", "max-age=0"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
        .setRequestHeader "Origin", "http://krsk.24au.ru"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.124 Safari/537.36"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "Referer", "http://krsk.24au.ru/"
        .setRequestHeader "Accept-Encoding", "gzip , deflate"
        .setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
        .setRequestHeader "Cookie", cookie$
        .send PostData
         
        For Each .getResponseHeader("Set-Cookie") In .getAllResponseHeaders()
        cookie$ = cookie$ + .getResponseHeader("Set-Cookie")
        Next
         
        Location$ = .getResponseHeader("Location") ' при удачной авторизации сайт перенаправляет на указанную страницу
        MsgBox "Location " & Location
       If Not Location$ Like "*http://krsk.24au.ru/*" Then
            MsgBox "Ошибка авторизации на сайте atsenergo.ru", vbCritical, "Обратитесь к разработчику программы"
            Exit Function
        End If
         
        'Идем на Location
         
        .Open "GET", Location$, False
       .setRequestHeader "Host", "krsk.24au.ru"
       .setRequestHeader "Connection", "keep-alive"
       .setRequestHeader "Cache-Control", "max-age=0"
       .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.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.124 Safari/537.36"
       .setRequestHeader "Referer", "http://common.24au.ru/login/"
       .setRequestHeader "Accept-Encoding", "gzip , deflate, sdch"
       .setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
       .setRequestHeader "Cookie", cookie$
       .send
 
        cookie$ = .getResponseHeader("Set-Cookie")
    auth = cookie$
    htmlau = .responseText
    Open "C:\test.txt" For Output As #1
 
    Print #1, htmlau
 
    Close #1
   End With
End Function
 
 
 
#2
05.10.2014 12:53:15
знакомый код)

вот это смущает: (вряд ли будет работать)
Код
?
1
2
3
For Each .getReponseHeader("Set-Cookie") In .getAllResponseHeaders()   
  cookie$ = cookie$ + .getResponseHeader("Set-Cookie")   
Next

cookie$ - это длинная текстовая строка вида
параметр1=значение1;параметр2=значение2;параметр3=значение3

вот и проверяйте, чтобы объединённая строка была такого вида
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
05.10.2014 13:17:06
здравствуйте Игорь! спасибо что откликнулись )) в том то и проблема что в cookies$ попадает только первый заголовок set-cookies.
и ошибку в коде вы указали правильно, vba ругается имеено в том месте
 
 
 
#4
05.10.2014 13:18:20
Попробуйте + заменить на амперсанд: &
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#5
05.10.2014 14:43:16
уберите в коде строку On Error Resume Next - и увидите свои ошибки
вы перемудрили с конструкцией For Each

вот так будет правильно:
Код
?
1
2
3
4
5
6
7
        Dim header As Variant, cookie$
 
        For Each header In Split(.getAllResponseHeaders(), vbNewLine)
            If header Like "Set-Cookie:*" Then
                cookie$ = cookie$ & "; " & Mid(header, 12)
            End If
        Next
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#6
05.10.2014 16:26:30
Prist спасибо, но ошибку высвечивало на строке:
Код
?
1
For Each .getResponseHeader("Set-Cookie") In .getAllResponseHeaders()
поставил амперсанд, но непонятно что произошло )))
Игорь, допилил немножко код, то cookie$ начиналось с ;
Код
?
1
2
3
4
5
6
7
8
9
10
cookie$ = ""
        For Each header In Split(.getAllResponseHeaders(), vbNewLine)
            If header Like "Set-Cookie:*" Then
                If cookie$ = "" Then
                cookie$ = Mid(header, 12)
                Else
                cookie$ = cookie$ & "; " & Mid(header, 12)
                End If
            End If
        Next
куки передаются вроде правильно теперь, но авторизация все равно не происходит, видимо где то с заголовками косяк у меня, или вообще у них на сайте какая то хитрушка с авторизацией.
За помощь с кукисами огромное спасибо!
 
 
 
#7
05.10.2014 19:21:28
Доковырялся ))))
Ошибка (80070459)
Символ Юникода не имеет сопоставления в конечной многобайтовой кодовой странице
Как ни странно, гугл ответа не дал ((
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
.Open "GET", Location$, False
.setRequestHeader "Host", "krsk.24au.ru"     
.setRequestHeader "Connection", "keep-alive"     
.setRequestHeader "Cache-Control", "max-age=0"   
.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.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.124 Safari/537.36"     
.setRequestHeader "Referer", "http://common.24au.ru/login/"     
.setRequestHeader "Accept-Encoding", "gzip , deflate, sdch"     
.setRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"     
.setRequestHeader "Cookie", cookie$     
.send      
cookie$ = .getResponseHeader("Set-Cookie")
auth = cookie$    
htmlau = .responseText    
Open "C:\test.txt" For Output As #1   
Print #1, htmlau   
Close #1
Ругается на  .responseText  
Помогите у кого была такая проблема, как решали?
 
 
 
#8
05.10.2014 21:53:52
Цитата
Символ Юникода не имеет сопоставления в конечной многобайтовой кодовой странице
при такой ошибке, вместо использования responseText,
надо обрабатывать байтовый массив responseBody

других вариантов нет.

добавьте функцию такую

Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Function GetResponse(ByRef BytesArr, ByVal Encoding$) As String
    On Error Resume Next
    Dim ResponseFilename$
    Set ADODBStream = CreateObject("ADODB.Stream")
    With ADODBStream
        ResponseFilename$ = Environ("tmp") & "\response.txt"
        If Len(Encoding$) Then .Charset = Encoding$
        .Type = 1        ' adTypeBinary:
        .Open: .Write BytesArr
        .SaveToFile ResponseFilename$, 2
        .Type = 2        'adTypeText
        .LoadFromFile ResponseFilename$
        GetResponse = .ReadText
        .Close
        Kill ResponseFilename$
    End With
    Set ADODBStream = Nothing
End Function

и замените строку
Код
?
1
htmlau = .responseText  


на (смотря какой вариант сработает)
Код
?
1
htmlau = GetResponse(.ResponseBody, "")
или на
Код
?
1
htmlau = GetResponse(.ResponseBody, "utf-8")
или на
Код
?
1
htmlau = GetResponse(.ResponseBody, "windows-1251")
Изменено: Игорь - 05.10.2014 22:02:22
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#9
06.10.2014 08:22:36
Низкий поклон, Игорь.
С байтовым массивом никогда бы не допетрил.
Впервые о нем услышал ))))
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...