Msgbox GetData("http://www.yahoo.com/index.html") Function GetData(strUrl) 'As String 'Uses Internet Explorer to return a string containing the 'contents of an http or ftp web page. This returns the worst 'quality of data but is the most likely to be supported 'without installing anything. Dim web 'As InternetExplorer.Application Dim doc 'As InternetExplorer.Document Dim strWebPage 'As String Set web = CreateObject("InternetExplorer.Application") web.Navigate strUrl Do While web.Busy Loop On Error Resume Next Set doc = Nothing Do Until Not doc Is Nothing Set doc = web.Document Loop strWebPage = doc.body.OuterHTML 'This does not return the head or title sections. web.Quit GetData = strWebPage End Function function getURL(aURL, anyPostData, anyUserName, anyPassword) DIM objSrvHTTP,web,method,s on error resume next s="" set objSrvHTTP = Server.CreateObject ("Msxml2.ServerXMLHTTP.3.0") if anyPostData=empty then objSrvHTTP.open "GET",aURL, true, anyUsername, anyPassword else objSrvHTTP.open "POST",aURL, true, anyUsername, anyPassword objSrvHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" end if objSrvHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 5.0)" objSrvHTTP.send anyPostData objSrvHTTP.waitForResponse 5 select case objSrvHTTP.readyState case 0 'object created, but no URL opened debug "getURL("&aURL&", "&anyPostData&", "&anyUserName&", "&anyPassword&"): Object Created, no URL opened" err.raise 1, "Object Created, no URL opened" exit function case 1 'loading: URL opened, but no data sent debug "getURL("&aURL&", "&anyPostData&", "&anyUserName&", "&anyPassword&"):URL opened, no data sent" err.raise 2, "URL opened, no data sent" exit function case 2 'loaded: data sent, status and headers available, no response recieved. debug "getURL("&aURL&", "&anyPostData&", "&anyUserName&", "&anyPassword&"):No response from remote host" err.raise 3, "No response from remote host" exit function case 3 'interactive: some data recieved. responseBody and responseText will return partial results. debug "getURL("&aURL&", "&anyPostData&", "&anyUserName&", "&anyPassword&"):Partial response recieved:" debug server.htmlencode(objSrvHTTP.responseText) s = objSrvHTTP.responseText err.raise 4, "Partial response recieved" case 4 'complete: s = objSrvHTTP.responseText end select getURL = s end function Function GetData(strUrl) 'Uses the Microsoft WinHttp object from: 'http://download.microsoft.com/download/MsHttp50/Install/5.0/NT45XP/EN-US/winhttp50sdk.exe Dim web, strWebPage Const WinHttpRequestOption_UserAgentString = 0 Const WinHttpRequestOption_EscapePercentInURL = 3 Const WinHttpRequestOption_EnableRedirects = 6 Const WinHttpRequestOption_UrlEscapeDisable = 7 Const WinHttpRequestOption_UrlEscapeDisableQuery = 8 Set web = CreateObject("WinHttp.WinHttpRequest.5") web.Option(WinHttpRequestOption_EnableRedirects) = True web.Open "GET", strURL, False web.Send If web.Status = "200" Then strWebPage = web.ResponseText 'Try to follow META redirect pages If InStr(1, strWebPage, "<META HTTP-EQUIV=""REFRESH"" CONTENT=""", vbTextCompare) <> 0 Then strWebPage = Mid(strWebPage, InStr(1, strWebPage, "<META HTTP-EQUIV=""REFRESH"" CONTENT=""", vbTextCompare)) strWebPage = Mid(strWebPage, InStr(1, strWebPage, "URL=", vbTextCompare) + 4) strWebPage = Left(strWebPage, InStr(strWebPage, ">") - 1) Do While InStr(strWebPage, """") <> 0 : strWebPage = Replace(strWebPage, """", "") : Loop strWebPage = Trim(strWebPage) If InStr(strWebPage, " ") <> 0 Then strWebPage = Left(strWebPage, InStr(strWebPage, " ") - 1) strWebPage = MakeAbsolute(strWebPage, strUrl) 'Change the input argument to notify the calling routine strUrl = strWebPage strWebPage = GetData(strWebPage) End If GetData = strWebPage Else GetData = "" End If End Function Function GetData(strUrl) 'As String 'Uses POST.EXE from http://www.ericphelps.com/webget/post.zip 'Downloads an http web page and returns a string containing the contents Dim ts 'As Scripting.TextStream Dim fs 'As Scripting.FileSystemObject Dim web 'As Post.clsPost Dim strWebPage 'As String Dim strWebSite 'As String Dim strResource 'As String If left(strUrl,7) = "http://" Then strWebSite = Mid(strUrl, 8) Else strWebSite = strUrl End If If Instr(strWebSite, "/") = 0 Then strWebSite = strWebSite & "/" strResource = Mid(strWebSite, Instr(strWebSite, "/")) strWebSite = Left(strWebSite, Instr(strWebSite, "/") - 1) Set web = CreateObject("Post.clsPost") web.DataTimeout = 120 web.SocketTimeout = 60 'Get it! (Force string so VBS doesn't try to pass a string-type variant instead) strWebPage = web.GetHeader(Cstr(strWebSite), Cstr(strResource)) 'Check to see if we got content If ((Len(Mid(strWebPage, Instr(strWebPage, vbCrlf & vbCrlf) + 4)) = 0) Or (Left(strWebPage, 11) = "HTTP/1.1 30")) Then If InStr(strWebPage, "Location:") <> 0 Then 'Recursive follow of http redirect. Trim the new location out of the response strWebPage = Mid(strWebPage, InStr(strWebPage, "Location:") + 9) strWebPage = Trim(strWebPage) strWebPage = Left(strWebPage, InStr(strWebPage, vbCr) - 1) 'Change the input argument to notify the calling routine strUrl = strWebPage strWebPage = GetData(strWebPage) Else strWebPage = "" End If Else 'Recursive follow of meta tag redirect If InStr(1, strWebPage, "<META HTTP-EQUIV=""REFRESH"" CONTENT=""", vbTextCompare) <> 0 Then strWebPage = Mid(strWebPage, InStr(1, strWebPage, "<META HTTP-EQUIV=""REFRESH"" CONTENT=""", vbTextCompare)) strWebPage = Mid(strWebPage, InStr(1, strWebPage, "URL=", vbTextCompare) + 4) strWebPage = Left(strWebPage, InStr(strWebPage, ">") - 1) Do While InStr(strWebPage, """") <> 0 : strWebPage = Replace(strWebPage, """", "") : Loop strWebPage = Trim(strWebPage) If InStr(strWebPage, " ") <> 0 Then strWebPage = Left(strWebPage, InStr(strWebPage, " ") - 1) strWebPage = MakeAbsolute(strWebPage, "http://" & strWebSite & strResource) 'Change the input argument to notify the calling routine strUrl = strWebPage strWebPage = GetData(strWebPage) Else 'Remove the header strWebPage = Mid(strWebPage, Instr(strWebPage, vbCrlf & vbCrlf) + 4) End If End If GetData = strWebPage End Function Function GetData(strUrl) 'As String 'Uses MSINET.OCX from http://activex.microsoft.com/controls/vb5/msinet.cab 'Requires a Microsoft developer's license. May require license fix from 'ftp://ftp.microsoft.com/softlib/mslfiles/vbc.exe 'Returns a string containing the contents of a web page Dim web 'As InetCtls.Inet Dim strWebPage 'As String Set web = CreateObject("InetCtls.Inet") web.RequestTimeout = 60 strWebPage = web.OpenURL(Cstr(strUrl)) GetData = strWebPage End Function Function GetData(strUrl) 'As String 'Uses WGET.EXE from http://wget.sunsite.dk/ 'to return a string containing the contents of an http web page Dim ts 'As Scripting.TextStream Dim wsh 'As Wscript.Shell Dim fs 'As Scripting.FileSystemObject Dim fil 'As Scripting.File Dim strWebPage 'As String Dim strTempFile 'As String Const ForReading = 1 Const ForWriting = 2 Const TemporaryFolder = 2 Set fs = CreateObject("Scripting.FileSystemObject") Set wsh = CreateObject("Wscript.Shell") strTempFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder), fs.GetBaseName(Wscript.ScriptFullName) & ".tmp") Set ts = fs.CreateTextFile(strTempFile, True) ts.Close Set fil = fs.GetFile(strTempFile) wsh.Run "wget.exe -O " & fil.ShortPath & " " & strUrl, 0, True Set ts = fs.OpenTextFile(strTempFile, ForReading, True) strWebPage = ts.ReadAll ts.Close fil.Delete True GetData = strWebPage End Function Function GetData(strUrl) 'As String 'This is not my original script, but is one of the public domain 'scripts included as a sample with PrimalSCRIPT. Credit for the 'script is attributed to "Eric K." and "Michael Harris". This 'script does a BINARY download. I've modified it here to suit 'my purposes. The "Chrw-Ascw-Chr-Ascb-Midb" is what is needed to 'perform a byte array to string conversion! Keep it in mind. Dim xml 'As MSXML2.XMLHTTP Dim strWebPage 'As String Dim strTemp 'As String Dim lngCounter 'As Long Set xml = CreateObject("MSXML2.XMLHTTP") xml.Open "GET", strUrl, False 'false tells it to wait for the reply. Will hang if no reply. xml.Send strTemp = xml.ResponseBody 'also responseText for non-binary Set xml = Nothing For lngCounter = 0 to UBound(strTemp) strWebPage = strWebPage & Chrw(Ascw(Chr(Ascb(Midb(strTemp,lngCounter+1,1))))) Next GetData = strWebPage End Function Function GetData(strUrl) 'As String 'Uses WEBGET.EXE from http://www.ericphelps.com/webget/get.zip 'Downloads an http web page and returns a string containing the contents Dim web 'As WebGet.Web Dim sRxData 'As String Set web = CreateObject("WebGet.Web") If Left(strUrl, 7) <> "http://" Then strUrl = "http://" & strUrl web.URL = strUrl sRxData = web.GetText GetData = sRxData End Function
See also:
Both XmlHttpRequest and XMLDOM are unreliable when used from within an ASP server-side context. If you attempt to use XmlHttpRequest from within an ASP page for a server-to-server communication, you'll experience unpredictable results that might vary from an incredibly long completion time to random errors to an inability to connect to SSL sites. The whole problem is fully described in a sadly famous KB article Q237906. Simply put, it seems that MSXML was released without a careful and complete testing cycle. Microsoft admits that both components were designed and tested only to be used from a client machine.
Table 2. XMLHTTP Methods
Method | Description |
---|---|
Abort | Cancels the current HTTP request |
GetAllResponseHeaders | Retrieves all the header fields from the response message |
GetResponseHeader | Retrieves the value of an HTTP header from the response body |
Open | Opens a connection to the HTTP server |
SetRequestHeader | Sets one of the request header fields |
Send | Sends a request to an HTTP server; can include a body |
Check Your Request With the Properties
Besides enabling you to check your request, these XMLHTTP properties let you retrieve the value returned by the server to see if any errors occurred with your request.
Table 3. XMLHT TP Properties
Property | Value | Description |
---|---|---|
OnReadyStateChange | Event Handler reference | Used only with asynchronous operations, this property specifies the event handler call when the ready state changes; for example, when the data is returning from the server. |
ReadyState | Integer | Indicates the status of an asynchronous operation: uninitialized (0), loading (1), loaded (2), interactive (3), or completed (4). |
ResponseBody | Variant array | Returns the body of the response as an array. |
ResponseStream | IStream | Returns the body of the response as an ADO Stream object. |
ResponseText | String | Returns the body of the response as a text string. |
ResponseXML | XMLDocument Object | Returns the body of the response as parsed by the MSXML XMLDOM parser. |
Status | Long | HTTP status code returned by the server. |
StatusText | String | HTTP response line status. |
Questions:
Code:
file: /Techref/language/asp/wwwextract.htm, 16KB, , updated: 2021/2/1 10:30, local time: 2024/10/12 03:38,
3.237.15.145:LOG IN ©2024 PLEASE DON'T RIP! THIS SITE CLOSES OCT 28, 2024 SO LONG AND THANKS FOR ALL THE FISH!
|
©2024 These pages are served without commercial sponsorship. (No popup ads, etc...).Bandwidth abuse increases hosting cost forcing sponsorship or shutdown. This server aggressively defends against automated copying for any reason including offline viewing, duplication, etc... Please respect this requirement and DO NOT RIP THIS SITE. Questions? <A HREF="http://www.piclist.com/Techref/language/asp/wwwextract.htm"> Extract data from the WWW with ASP</A> |
Did you find what you needed? |
PICList 2024 contributors:
o List host: MIT, Site host massmind.org, Top posters @none found - Page Editors: James Newton, David Cary, and YOU! * Roman Black of Black Robotics donates from sales of Linistep stepper controller kits. * Ashley Roll of Digital Nemesis donates from sales of RCL-1 RS232 to TTL converters. * Monthly Subscribers: Gregg Rew. on-going support is MOST appreciated! * Contributors: Richard Seriani, Sr. |
Welcome to www.piclist.com! |
.