Posted By

krisdb on 04/13/07


Tagged

ASP


Versions (?)


Advertising

Website Promotion DIRECTORY is a crucial factor for all websites that need to gain better organic search engine rankings and increase website traffic.
Submitting your website as part of your Web Promotion strategy to our SEO friendly and high traffic Business Directory for review is an excellent way to gain a valuable backlink and increase your websites visibility online.

Submit Site


Who likes this?

4 people have marked this snippet as a favorite

tylerhall
gafsveno
remix4
ShadowKing


Display RSS Feed


Published in: ASP 






Expand | Embed | Plain Text
  1. Sub DisplayFeed(sURL)
  2. dim objXML
  3. Set objXML = CreateObject("MSXML2.DOMDocument.4.0")
  4. objXML.async = False
  5. objXML.validateOnParse = false
  6. objXML.resolveExternals = false
  7. objXML.preserveWhiteSpace = false
  8. objXML.setProperty "ServerHTTPRequest", True
  9.  
  10. if (objXML.Load(sURL)) then
  11. Dim i, k, objChannel, objItemList,sChildNodeName,sChildNodeText,iTotalItems,iCount,objItem,j,sLinkTxt,sLinkURL
  12.  
  13. Set objItemList = objXML.getElementsByTagName("channel")
  14. iTotalItems = objItemList.length - 1
  15.  
  16. If (iTotalItems < 0) Then
  17. dim RootNamespace: RootNamespace = objXML.documentElement.namespaceURI
  18. objXML.setProperty "SelectionNamespaces","xmlns:at='" & RootNamespace & "'"
  19. Set objItemList = objXML.selectNodes("//at:feed")
  20. iTotalItems = objItemList.length - 1
  21. End If
  22.  
  23. i = 0
  24. For iCount = 0 to iTotalItems
  25. Set objItem = objItemList.item(iCount)
  26. For j = 0 to objItem.childNodes.length - 1
  27. sChildNodeName = objItem.childNodes(j).nodeName
  28. sChildNodeText = objItem.childNodes(j).text
  29.  
  30. If (sChildNodeName = "title") Then
  31. sLinkTxt = sChildNodeText
  32. ElseIf (sChildNodeName = "link") Then
  33. sLinkURL = sChildNodeText
  34. End If
  35. Next
  36. response.write "<a href=""" & sLinkURL & """ class=""TblTitles"">" & sLinkTxt & "</a>" & vbCrLf
  37. Next
  38.  
  39. Set objItemList = nothing
  40. Set objItem = nothing
  41.  
  42. 'rss
  43. Set objItemList = objXML.getElementsByTagName("item")
  44. iTotalItems = objItemList.length - 1
  45.  
  46. 'rss
  47. If (iTotalItems < 0) Then
  48. Set objItemList = objXML.getElementsByTagName("entry")
  49. iTotalItems = objItemList.length - 1
  50. end if
  51.  
  52. 'atom
  53. If (iTotalItems < 0) Then
  54. RootNamespace = objXML.documentElement.namespaceURI
  55. objXML.setProperty "SelectionNamespaces","xmlns:at='" & RootNamespace & "'"
  56. Set objItemList = objXML.selectNodes("//at:feed")
  57. iTotalItems = objItemList.length - 1
  58. End If
  59.  
  60. i = 0
  61. For iCount = 0 to iTotalItems
  62. Set objItem = objItemList.item(iCount)
  63. For j = 0 to objItem.childNodes.length - 1
  64. sChildNodeName = objItem.childNodes(j).nodeName
  65. sChildNodeText = objItem.childNodes(j).text
  66.  
  67. If (sChildNodeName = "title") Then
  68. sLinkTxt = sChildNodeText
  69. ElseIf (sChildNodeName = "link") Then
  70. sLinkURL = sChildNodeText
  71. End If
  72. Next
  73.  
  74. response.write "<a href=""" & replace(sLinkURL,"&","&amp;") & """>"& replace(sLinkTxt,"&","&amp;") & "</a><br />" & vbCrLf
  75. i = i + 1
  76. Next
  77.  
  78. else
  79. response.write("Error code:" & objXML.parseError.errorCode & "<br />")
  80. response.write("Error reason:" & objXML.parseError.reason & "<br /><br />")
  81. end If
  82.  
  83. set objItemList = nothing
  84. set objXML = nothing
  85. end sub

Report this snippet 

Comments

RSS Icon Subscribe to comments
Posted By: duvrana on July 9, 2009

where do you add the url of the feed you want to read?

Posted By: krisdb on July 12, 2009

You should just be able to put:

DisplayFeed("http://www.rssurl.com")

Posted By: cms9651 on March 12, 2010

Where do you add the date and the description of the feed you want to read? Can someone help me? Thanks in advance.

You need to login to post a comment.

Download royalty free graphics