SetRequestHeaderSub 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 |