SetRequestHeader




Sub LoginAndGetDailySummary()
    KullaniciAdi = "user"
    KullaniciSifre = "Password"
    arrcookie = ConnecttoURL("https://login.targetsite.com", KullaniciAdi, KullaniciSifre)
    If Trim(arrcookie(0)) = "" Then
        MsgBox "Not connected"
        Exit Sub
    End If
    Set GunlukPrgxml = GetGunlukPrg("https://app.targetsite.com/prg_daily_summary_xml.asp?", _
                "https://app.targetsite.com/", arrcookie)
    
    
    Set objXMLDoc = CreateObject("Microsoft.XMLDOM")
    objXMLDoc.async = False
    Ek = "<?xml version=""1.0"" encoding=""ISO-8859-9""?>"
    
    objXMLDoc.loadXML Ek & GunlukPrgxml.XML
    MsgBox objXMLDoc.XML
End Sub
Function ConnecttoURL(URL, KullaniciAdi, KullaniciSifre)
    urlx = URL & "?userid=" & KullaniciAdi & "&password=" & KullaniciSifre

    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "POST", urlx, False
    XMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    XMLHTTP.setRequestHeader "Referer", "http://targetsite.com/"
    XMLHTTP.setRequestHeader "ACCEPT-LANGUAGE", "tr"
    XMLHTTP.setRequestHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*"
    XMLHTTP.send postvars
    While XMLHTTP.readyState <> 4
      XMLHTTP.waitForResponse 1000
    Wend
    strHeaders = XMLHTTP.getAllResponseHeaders()
    sReturn = XMLHTTP.responseText
    Set XMLHTTP = Nothing
    nlenHead = Len(strHeaders)
    iStart = 1
    '********************************
    'get cookie information from returned headers (strHeaders)
    '********************************
    j = 0
    ReDim arrcookie(0)
    Do While iStart < nlenHead
      nFoundAt = InStr(iStart, strHeaders, "Set-Cookie:")
      If nFoundAt = 0 Then
        Exit Do
      End If
      ReDim Preserve arrcookie(j)
      nEndOfcookie = InStr(nFoundAt, strHeaders, ";")
      If (nEndOfcookie > 0) Then
      ' get only the cookie data;
        arrcookie(j) = Mid(strHeaders, nFoundAt + 12, nEndOfcookie - nFoundAt - 12)
      End If
      iStart = nEndOfcookie + 1
      j = j + 1
    Loop
    '********************************
    'end get cookie information from returned headers (strHeaders)
    '********************************
    FOSNConnect = arrcookie
End Function
Function GetGunlukPrg(sTargetDataPage, sRef, CookieArray)
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "GET", sTargetDataPage, False
    'we need to setrequestheaders twice due to KB article Q234486.
    XMLHTTP.setRequestHeader "cookie", "x=y"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    XMLHTTP.setRequestHeader "Referer", sRef
    XMLHTTP.setRequestHeader "accept-language", "tr"
    XMLHTTP.setRequestHeader "content-type", "text/html"
    XMLHTTP.setRequestHeader "content-length", ""
    XMLHTTP.setRequestHeader "accept-encoding", "gzip, deflate"
    XMLHTTP.setRequestHeader "accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*"
    For j = 0 To UBound(CookieArray)
      'set the outgoing request header with the cookies received above
      XMLHTTP.setRequestHeader "cookie", CookieArray(j)
    Next
    XMLHTTP.send ""
    While XMLHTTP.readyState <> 4
      XMLHTTP.waitForResponse 1000
    Wend
    
    Set GetGunlukPrg = XMLHTTP.responseXML
    Set XMLHTTP = Nothing
    '********************************
    'end get target data information from target page
    '********************************
End Function