<% bUseApp = true '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 "
" & FeedName & " (Neuerscheinungen)
" response.write "Titel | " response.write "Beschreibung | " response.write "
" & sTitle & _ " | " response.write "" & sDesc & " | " next response.write "
" %>