Code:
<% bUseApp = false 'set to true if you 'want to cache responses in memory '(Application variable) rather than 'file. function ReplaceMultiple(InputString, CharsToReplace) iCount = len(CharsToReplace) sTemp = InputString for iCtr = 1 to iCount sChar = mid(CharsToReplace, iCtr, 1) sTemp = replace(sTemp, sChar, "") Next ReplaceMultiple = sTemp End Function function WriteToFile(FileName, Contents) iMode = 2 'overwrite set oFs = server.createobject("Scripting.FileSystemObject") set oTextFile = oFs.OpenTextFile(FileName, 2, True) oTextFile.Write Contents oTextFile.Close set oTextFile = nothing set oFS = nothing end function Private Function ReadTextFile(fName) set oFs = server.createobject("Scripting.FileSystemObject") If oFs.FileExists(fName) Then Set FSTR = ofs.OpenTextFile(fName) ReadTextFile = FSTR.ReadAll FSTR.Close Set FSTR = Nothing Set FSO = Nothing end if End Function Private Function ReadAppVariable(fName) ReadAppVariable = Application(fName) End Function Private Function WriteAppVariable(FileName, Contents, RSSURL) Application.lock Application(FileName) = contents Application(RSSURL) = Hour(now) Application.unlock end function Function DisplayRSSFeed(RSSURL, FeedName) 'caches the feed, updates every hour, uses a file cache 'if it hasn't been update in an hour or running for the first time 'get it and save from file, 'else read it from file Set objXML = Server.CreateObject("MSXML2.DOMDocument") objXML.async = False 'necessary because MSXML 'doesn't seem to work very well 'when an external DTD is referred to objXML.validateOnParse = false objXML.resolveExternals = false iPos = InstrRev(RSSURL, "/") if iPos = 0 then sFileName = RSSURL else sFileName = mid(RSSURL, iPos + 1) end if sFileName = FeedName & "_" & sFileName & ".xml" 'remove invalid/unwanted chars sFileName = ReplaceMultiple(sFileName,"[]/\\(^+)$,)?&:=") sFileName = Server.MapPath(".") & "\" & sFileName if Application(RSSURL) <> Hour(Now) then set objXMLHTTP = Server.CreateObject("MSXML2.SERVERXMLHTTP") objXMLHTTP.Open "GET", RSSURL, false objXMLHTTP.SetRequestHeader "Content-type", "text/html" on error resume next objXMLHTTP.Send sAns = objXMLHTTP.ResponseText on error goto 0 set objXMLHTTP = nothing 'Ensure you have a valid XML response bAns = objXML.loadXML(sAns) if bAns = true then 'save to file 'Requires ASP user has write permissions to' 'path you use if bUseApp = false then WriteToFile sFileName, sAns Application.Lock 'refresh in an hour Application(RSSURL) = Hour(now) Application.unlock else WriteAppVariable sFileName, sAns, RSSURL end if else 'if invalid, try using a previous version 'response.write "Loading from file " & sFileName & " due to failure" if bUseApp = false then sContents = ReadTextFile(sFileName) else sContents = ReadAppVariable(sFileName) end if bAns = objXML.loadXML(sContents) 'bAns = objXML.load(sFileName) end if else 'try to load from cache on failure to refresh if bUseApp= false then sContents = ReadTextFile(sFileName) else sContents = ReadAppVariable(sFileName) end if bAns = objXML.loadXML(sContents) End if if bAns then 'RSS implementations vary. Some use item as a child of channel 'some don't 'that is what the below is about 'rss .9x and 2.0 implementation set objItemNodes = objXML.DocumentElement.SelectNodes("item") if objItemNodes.length = 0 then 'rss 1.x implemenation set objItemNodes = _ objXML.DocumentElement.SelectSingleNode("channel").SelectNodes("item") end if 'display as table response.write "<p align=center><b>" & FeedName & " recent headlines</b></p>" response.write "<table cellspacing=5>" response.write "<TR><TD><B>Item</B></TD>" response.write "<TD><B>Summary</B></TD>" response.write "</TR>" response.write "<TR><TD> </TD></TR>" for each oNode in objItemNodes sLink = oNode.selectSingleNode("link").Text set oDescriptionNode = oNode.selectSingleNode("description") if not oDescriptionNode is nothing then sDesc= oDescriptionNode.Text else sDesc = "" end if sTitle = oNode.selectSingleNode("title").Text response.write "<TR><TD valign=Top><A HREF ='" & sLink & "'>" & sTitle & _ "</a></td>" response.write "<TD valign=top width='60%'>" & sDesc & "</td>" next response.write "</table>" else response.write "The requested feed is not available" end if set oNode = Nothing set objItemNodes = Nothing set objXML = Nothing End function 'DEMO DisplayRSSFeed "http://slashdot.org/slashdot.rdf", "Slashdot" response.write "<p>" DisplayRSSFeed "http://boingboing.net/rss.xml", "Boing Boing Blog" response.write "<p>" %>