|
News in Scotland
Today
<%
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 & " recent headlines "
response.write ""
response.write "| Item | "
response.write "Summary | "
response.write " "
response.write "| | "
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 "| " & sTitle & _
" | "
response.write "" & sDesc & " | "
next
response.write " "
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 ""
%> |
