• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 696
  • Last Modified:

How to accept cookies using WinInit

I have a lot of WinInit VB6 examples but I need to use WinInit to walk a Dyvnamic part of a web site. To do so I need to be able to have WinInit accept the request for cookies and return cookie information if needed
0
dnotestine
Asked:
dnotestine
  • 2
  • 2
1 Solution
 
inthedarkCommented:
Are you creating your HTTP GET/PUT commands yourself?  In which case you need to add the cookies to the HTTP commands you send.
0
 
dnotestineAuthor Commented:
This is the code I'm using to send the request. How would I enable cookies? I'm new to WinInit and don't have a clue. Thanks in advance.

Private Sub btSend_Click()

    Dim iRetVal     As Integer
    Dim sBuffer     As String * 1024
    Dim lBufferLen  As Long
    Dim vDllVersion As tWinInetDLLVersion
    Dim sStatus     As String
    Dim sOptionBuffer   As String
    Dim lOptionBufferLen As Long
    Dim SecFlag As Long
    Dim dwSecFlag As Long
    Dim dwPort As Long


    Screen.MousePointer = vbHourglass
    btSend.Enabled = True
    lBufferLen = Len(sBuffer)
   
    If CBool(hInternetSession) Then
   
        SetStatus "InternetQueryOption"
        InternetQueryOption hInternetSession, _
                            INTERNET_OPTION_VERSION, _
                            vDllVersion, _
                            Len(vDllVersion)
        lblMajor = vDllVersion.lMajorVersion
        lblMinor = vDllVersion.lMinorVersion
       
        '---   Connect
       
        SetStatus "InternetConnect"
       
        '- If secure is needed
        If checkSecure.Value = 1 Then
       
            Debug.Print "Establishing secure connection" & " "
            dwPort = INTERNET_DEFAULT_HTTPS_PORT
            Debug.Print "Setting security flags" & " "
            SecFlag = INTERNET_FLAG_SECURE Or _
                      INTERNET_FLAG_IGNORE_CERT_CN_INVALID Or _
                      INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
        ' Not secure
        Else
       
            dwPort = INTERNET_DEFAULT_HTTP_PORT
            SecFlag = 0
           
        End If
        hInternetConnect = InternetConnect(hInternetSession, CheckUrl, dwPort, _
                                txtUsername.Text, txtPassword.Text, INTERNET_SERVICE_HTTP, 0, 0)
        'hInternetConnect = InternetConnect(hInternetSession, CheckUrl, dwPort, _
                                vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
       
        '---   Open the Request if the Connect was Successful
       
        If hInternetConnect > 0 Then
           
            SetStatus "HttpOpenRequest"
           
            If optGet.Value = True Then
                sOptionBuffer = vbNullString
                lOptionBufferLen = 0
                hHttpOpenRequest = HttpOpenRequest(hInternetConnect, _
                                                   "GET", _
                                                   GetUrlObject, _
                                                   "HTTP/1.0", _
                                                   vbNullString, _
                                                   0, _
                                                   INTERNET_FLAG_RELOAD Or INTERNET_FLAG_KEEP_CONNECTION Or SecFlag, _
                                                   0)
            Else
                sOptionBuffer = "MOVENEXT=MoveNext?CONTRACT=-1&ZIP=94025?STATE=CA"
                lOptionBufferLen = Len(sOptionBuffer)
                hHttpOpenRequest = HttpOpenRequest(hInternetConnect, _
                                                   "POST", _
                                                   GetUrlObject, _
                                                   "HTTP/1.0", _
                                                   vbNullString, _
                                                   0, _
                                                   INTERNET_FLAG_RELOAD Or SecFlag, _
                                                   0)
            End If
           
            '---   If the Open Request was Successful
           
            If CBool(hHttpOpenRequest) Then
           
                SetStatus "HttpSendRequest"
                Debug.Print sOptionBuffer
               
                '---   Headers
               
                Dim sHeader As String
               
                'sHeader = "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd." & vbCrLf
                'iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, _
                                                sHeader, _
                                                Len(sHeader), _
                                                HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
                'Debug.Print iRetVal & " " & Len(sHeader)
               
                sHeader = "Accept-Language: en" & vbCrLf
                iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, _
                                                sHeader, _
                                                Len(sHeader), _
                                                HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
                Debug.Print iRetVal & " " & Len(sHeader)
                           
                sHeader = "Connection: Keep-Alive" & vbCrLf
                iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, _
                                                sHeader, Len(sHeader), _
                                                HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
                Debug.Print iRetVal & " " & Len(sHeader);
     
                sHeader = "Content-Type: text/html" & vbCrLf
                'The follwing line was at the end of the above line ????? It was remarked out
                ' "Accept = image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd." & vbCrLf
                'iRetVal = HttpAddRequestHeaders(hHttpOpenRequest, _
                                                sHeader, _
                                                Len(sHeader), _
                                                HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
                'Debug.Print iRetVal & " " & Len(sHeader)
               
                '---   Timeouts
               
                Dim dwTimeOut As Long
                dwTimeOut = 420000 ' time out is set to 7 minutes
               
                iRetVal = InternetSetOption(hHttpOpenRequest, _
                                            INTERNET_OPTION_CONNECT_TIMEOUT, _
                                            dwTimeOut, _
                                            4)
                Debug.Print iRetVal & " " & Err.LastDllError & " " & "INTERNET_OPTION_CONNECT_TIMEOUT"
               
                iRetVal = InternetSetOption(hHttpOpenRequest, _
                                            INTERNET_OPTION_RECEIVE_TIMEOUT, _
                                            dwTimeOut, _
                                            4)
                Debug.Print iRetVal & " " & "INTERNET_OPTION_RECEIVE_TIMEOUT"
               
                iRetVal = InternetSetOption(hHttpOpenRequest, _
                                            INTERNET_OPTION_SEND_TIMEOUT, _
                                            dwTimeOut, _
                                            4)
                Debug.Print iRetVal & " " & "INTERNET_OPTION_SEND_TIMEOUT"
               
Resend:
                '---   Send the Request
               
                iRetVal = HttpSendRequest(hHttpOpenRequest, _
                                          vbNullString, _
                                          0, _
                                          sOptionBuffer, _
                                          lOptionBufferLen)
                'Certificate Authority is invalid.
                If (iRetVal <> 1) And (Err.LastDllError = 12045) Then
                    'MsgBox "Invalid CA"
                    Debug.Print "Invalid Cert Auth, resending" & " "
                    dwSecFlag = SECURITY_FLAG_IGNORE_UNKNOWN_CA
                    iRetVal = InternetSetOption(hHttpOpenRequest, _
                                                INTERNET_OPTION_SECURITY_FLAGS, _
                                                dwSecFlag, _
                                                4)
                    Debug.Print iRetVal & " " & Err.LastDllError & " " & "INTERNET_OPTION_SECURITY_FLAGS"
                    GoTo Resend
                End If
               
                If iRetVal Then
               
                    Dim dwStatus As Long, dwStatusSize As Long
                   
                    dwStatusSize = Len(dwStatus)
                   
                    HttpQueryInfo hHttpOpenRequest, _
                                  HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, _
                                  dwStatus, _
                                  dwStatusSize, _
                                  0
                                 
                    Select Case dwStatus
                   
                        Case HTTP_STATUS_PROXY_AUTH_REQ
                       
                            iRetVal = InternetSetOptionStr(hHttpOpenRequest, _
                                                           INTERNET_OPTION_PROXY_USERNAME, _
                                                           "IUSR_WEIHUA1", _
                                                           Len("IUSR_WEIHUA1") + 1)
                            iRetVal = InternetSetOptionStr(hHttpOpenRequest, _
                                                           INTERNET_OPTION_PROXY_PASSWORD, _
                                                           "IUSR_WEIHUA1", _
                                                           Len("IUSR_WEIHUA1") + 1)
                            GoTo Resend
                           
                        Case HTTP_STATUS_DENIED
                       
                            iRetVal = InternetSetOptionStr(hHttpOpenRequest, _
                                                           INTERNET_OPTION_USERNAME, _
                                                           "IUSR_WEIHUA1", _
                                                           Len("IUSR_WEIHUA1") + 1)
                            iRetVal = InternetSetOptionStr(hHttpOpenRequest, _
                                                           INTERNET_OPTION_PASSWORD, _
                                                           "IUSR_WEIHUA1", _
                                                           Len("IUSR_WEIHUA1") + 1)
                            GoTo Resend
                           
                    End Select
               
                    '---   Get Query Info and put in Textboxes
                   
                    SetStatus "HttpQueryInfo"
                   
                    'response headers
                    GetQueryInfo hHttpOpenRequest, lblContentType, HTTP_QUERY_CONTENT_TYPE
                    GetQueryInfo hHttpOpenRequest, lblContentLength, HTTP_QUERY_CONTENT_LENGTH
                    GetQueryInfo hHttpOpenRequest, lblLastModified, HTTP_QUERY_LAST_MODIFIED
                    GetQueryInfo hHttpOpenRequest, lblVersion, HTTP_QUERY_VERSION
                    GetQueryInfo hHttpOpenRequest, lblStatusCode, HTTP_QUERY_STATUS_CODE
                    GetQueryInfo hHttpOpenRequest, lblStatusText, HTTP_QUERY_STATUS_TEXT
                    GetQueryInfo hHttpOpenRequest, lblRawHeaders, HTTP_QUERY_RAW_HEADERS
                    GetQueryInfo hHttpOpenRequest, txtResponseHeaders, HTTP_QUERY_RAW_HEADERS_CRLF
                    GetQueryInfo hHttpOpenRequest, lblForwarded, HTTP_QUERY_FORWARDED
                    GetQueryInfo hHttpOpenRequest, lblServer, HTTP_QUERY_SERVER
                    GetQueryInfo hHttpOpenRequest, lblRequestMethod, HTTP_QUERY_REQUEST_METHOD
                    GetQueryInfo hHttpOpenRequest, lblPragma, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_PRAGMA
                    GetQueryInfo hHttpOpenRequest, txtRequestHeaders, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_RAW_HEADERS_CRLF
                    GetQueryInfo hHttpOpenRequest, lblUserAgent, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_USER_AGENT
                    GetQueryInfo hHttpOpenRequest, lblRequestMethod2, HTTP_QUERY_FLAG_REQUEST_HEADERS + HTTP_QUERY_REQUEST_METHOD
                   
                    sStatus = "Ready"
                    btSend.Enabled = False
                    btGet.Enabled = True
                   
                Else
                    ' HttpSendRequest failed
                    sStatus = "HttpSendRequest call failed; Error code: " & Err.LastDllError & "."
                End If
               
            Else
                ' HttpOpenRequest failed
                sStatus = "HttpOpenRequest call failed; Error code: " & Err.LastDllError & "."
            End If
           
        Else
            ' InternetConnect failed
            sStatus = "InternetConnect call failed; Error code: " & Err.LastDllError & "."
        End If
    Else
        ' hInternetSession handle not allocated
        sStatus = "InternetOpen call failed: Error code: " & Err.LastDllError & "."
    End If
   
    SetStatus sStatus
    Screen.MousePointer = vbDefault
End Sub
0
 
inthedarkCommented:
I thought that WinInet handled cookies automatically for you.......just make sure you don't use the INTERNET_FLAG_NO_COOKIES option.

Here is how you do it if you are using Sockets API calls or  Winsock control.

Part 1 how to build the cookie string
part 2 how to format the request

But in your case using WinInet, you just need to know how to add a header to the request

AddHeader "Cookie:  " + msCookies

====================Part 1
First how to build the cookie string, you may also need code for the FormURLEncode. I will cover that later.


Dim msCookies As String
Sub MySub()

AddCookie "Name","John Smith"
AddCookie "Title","Mr"

End Sub

Public Sub AddCookie(Cookie As String, Value As String)

If Len(msCookies) > 0 Then
    msCookies = msCookies + "&"
End If
msCookies = msCookies + FormURLEncode(Cookie) + "=" + FormURLEncode(Value)
End Sub

======================part 2
Here is an extract from a class I creaded to be usded with either sockets or winsock control

Public Property Get HTTP_Get() As String
Dim sHTML As String


'GET /epaget.asp?ver=vipasp141.Pager&page=flights&ev=MON04 HTTP/1.1
'Accept: */*
'Accept -Language: en -gb
'Accept -Encoding: gzip , deflate
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322)
'Host: localhost
'Connection: Keep-Alive
'Cookie: ASPSESSIONIDQQQBQQBD=FAEHBFHBCGLGPGPCGMBCPNAB

Dim sCLen As String
If Len(msContent) > 0 Then
    sCLen = "Content-Length: " + CStr(Len(msContent)) + vbCrLf _
    + "Content-Type: application/x-www-form-urlencoded" + vbCrLf
Else
    sCLen = ""
End If


sHTML = "GET " + msDocument + msQuery + " HTTP/1.1" + vbCrLf
sHTML = sHTML + "Accept: */*" + vbCrLf '+application/octet-stream" + vbCrLf
sHTML = sHTML + "Accept-Encoding: identity" + vbCrLf
sHTML = sHTML + "Host: " + msHost + vbCrLf
sHTML = sHTML + "Connection: Close" + vbCrLf
sHTML = sHTML + "If-Modified-Since: Sat, 29 Oct 1901 19:43:31 GMT" + vbCrLf

'    + "Accept-Language: en-gb" + vbCrLf _
'    + "Accept-Encoding: gzip , deflate" + vbCrLf _
'    + "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322)" + vbCrLf _
'    + "Host: " + msHost + vbCrLf _
'    + "Connection: Close" + vbCrLf
'
'    If-Modified-Since: Sat, 29 Oct 1994 19:43:31 GMT

   
If Len(msCookies) > 0 Then
    sHTML = sHTML + "Cookie: " + msCookies + vbCrLf
End If

HTTP_Get = sHTML + vbCrLf ' needs 1 blank line at end


End Property




0
 
dnotestineAuthor Commented:
Ahhh... that would be nice if WinInit did all the cookie stuff for you :-) If I have a web crawler, traversing unknown dynamic pages, the dynamic script may be tracking the crawler using cookies. The dynamic script would be planting cookies and requesting cookies to keep track of the session.

Are you saying that this is automatic if using WinInit? It would be hard to know what cookies to send, etc. that the dynamic script is planting and requesting.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now