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 web.Quit GetData = strWebPage End Function Function GetData(strUrl) 'Uses the Microsoft WinHttp 5.1 object included with: 'Windows 2000 SP3, Windows XP SP1, Windows Server 2003 'Falls back to using the older 5.0 object if available. Dim web, strWebPage Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0 Const HTTPREQUEST_SETCREDENTIALS_FOR_PROXY = 1 Const WinHttpRequestOption_UserAgentString = 0 Const WinHttpRequestOption_EscapePercentInURL = 3 Const WinHttpRequestOption_EnableRedirects = 6 Const WinHttpRequestOption_UrlEscapeDisable = 7 Const WinHttpRequestOption_UrlEscapeDisableQuery = 8 Set web = Nothing On Error Resume Next Set web = CreateObject("WinHttp.WinHttpRequest.5.1") On Error Resume Next If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest.5") End If web.Option(WinHttpRequestOption_EnableRedirects) = True web.Open "GET", strURL, False ''''''''' ' Can use below text if needed to log in to server ' web.SetCredentials(strUserName, strPassword, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER) ''''''''' ''''''''' ' Could also use the below commented text to get all or specific header ' web.Open "HEAD", strURL, False ' web.Send ' GetData = web.GetResponseHeader("Set-Cookie") ' GetData = web.GetAllResponseHeaders ''''''''' ''''''''' ' Can use the below code to set a custom header ' web.SetRequestHeader "Cookie", "username=foo" ''''''''' ''''''''' ' Can use below text to POST data to a server ' web.Open "PUT", strURL, False ' web.Send "username=foo&password=bar" ''''''''' ''''''''' ' Can use below text to retrieve a binary (very slow string function conversion) ' web.Send ' varByteArray = web.ResponseBody ' For lngCounter = 0 to UBound(varByteArray) ' strWebPage = strWebPage & Chrw(Ascw(Chr(Ascb(Midb(varByteArray,lngCounter+1,1))))) ' Next ''''''''' web.Send If web.Status = "200" Then strWebPage = web.ResponseText 'Try to follow META redirect pages If InStr(1, strWebPage, " 0 Then strWebPage = Mid(strWebPage, InStr(1, 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 the Microsoft XML parser (Windows 2000) or from: 'http://download.microsoft.com/download/9/6/5/9657c01e-107f-409c-baac-7d249561629c/msxmlcab.exe 'http://download.microsoft.com/download/9/6/5/9657c01e-107f-409c-baac-7d249561629c/msxml.msi Dim web Set web = CreateObject("Microsoft.XMLHTTP") web.Open "GET", strUrl, False ', strUserName, strPassword web.Send ' Could also use this to get all or specific header: ' web.Open "HEAD", strUrl, False ' web.Send ' GetData = web.getAllResponseHeaders ' GetData = web.getResponseHeader("server") GetData = web.responseText 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, " 0 Then strWebPage = Mid(strWebPage, InStr(1, 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 Microsoft.XMLHTTP Dim strWebPage 'As String Dim varByteArray 'As Variant Dim lngCounter 'As Long Set xml = CreateObject("Microsoft.XMLHTTP") xml.Open "GET", strUrl, False xml.Send varByteArray = xml.ResponseBody Set xml = Nothing For lngCounter = 0 to UBound(varByteArray) strWebPage = strWebPage & Chrw(Ascw(Chr(Ascb(Midb(varByteArray,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