Simple XML/RSS Parser - Part II
This is second and extended version of simple XMLRSS parser. Simple XML/Parser is a XML parser designed for to parse most valid news and blog feeds. No database required to work with it. All you need is to include a subroutine in your code and call it. This version can also choose and display a limited number of feed.
Example Usage:
<%
rssParser "http://rss.news.yahoo.com/rss/topstories/", 3
%>
rssParser takes two parameters. Fİrst is URL of RSS feed and scond the number of how many headlines will be displayed.
rssParser subroutine:
<%
Sub rssParser(rssFile, num_headlines)
Dim objXML, objRoot, objItems, c
c = 0
Set objXML = Server.CreateObject("Microsoft.XMLDOM")
objXML.Async = False
objXML.SetProperty "ServerHTTPRequest", True
objXML.ResolveExternals = True
objXML.ValidateOnParse = True
objXML.Load(rssFile)
If (objXML.parseError.errorCode = 0) Then
Set objRoot = objXML.documentElement
If IsObject(objRoot) = False Then
response.Write "<h2>No Root Found in Rss File </h2>"
End If
Set objItems = objRoot.getElementsByTagName("item")
If IsObject(objItems) = True Then
Dim objItem
i = 0
For Each objItem in objItems
i = i + 1
if i =< num_headlines then
strTitle = objItem.selectSingleNode("title").Text
On Error Resume Next
strDesc = objItem.selectSingleNode("description").Text
On Error Resume Next
strLink = objItem.selectSingleNode("link").Text
On Error Resume Next
strDate = objItem.selectSingleNode("pubDate").Text
On Error Resume Next
response.Write("<center><table width=""90%"" cellspacing=""1"" celpading=""0"" bgcolor=""#111111"">" & vbnewline)
response.Write("<tr><td bgcolor=""#ffffff"" wrap style=""padding:8px; font:13px Arial, Helvetica, sans-serif"">" & vbnewline )
response.Write("<b>Title:</b> " & strTitle & "<br>" & vbnewline )
response.Write("<b>Link: </b> <a target=""_blank"" href="""& strLink & """>"& strLink &"</a><br>" & vbnewline )
response.Write("<b>Date : </b>" & strDate & "<br>" & vbnewline )
response.Write( strDesc & "<br>" & vbnewline )
response.Write("</td></tr>" & vbnewline )
response.Write("</table></center><br/>")
end if
Next
else
response.Write "<h2>No Root Found in Rss File </h2>"
exit sub
End If
Set objRoot = Nothing
Set objItems = Nothing
End If
Set objXML = Nothing
end sub
%>
Happy Coding
