Display Headlines From an RSS Feed on Your Website

Category:

ASP, HTML and XML

Type:

Snippets

Difficulty:

Intermediate

Author: Intelligent Solutions Inc.

Version Compatibility: ASP

More information:

RSS, which stands for Really Simple Syndication, is a standard that allows web sites to syndicate their content and other web sites to publish this content. This code will allow you to display RSS syndicated feeds on your web site, using ASP. You can find sites that syndicate their content via RSS at http://www.syndic8.com.

Updated 7/8/03 with a few changes that make the feed display more flexible in dealing with the various flavors of RSS. In addition, a flag (bUseApp, line 1) can be toggled so the feeds are cached either as files or in memory (i.e., within the Application object)

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

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 "" & FeedName & " recent headlines"
response.write "<table cellspacing=5>"
response.write "<TR><TD>Item</td>"
response.write "<TD>Summary</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 ""
DisplayRSSFeed "http://boingboing.net/rss.xml", "Boing Boing Blog"
response.write ""