Imports Microsoft.VisualBasic
Imports System.Web
Imports System.Web.Configuration
Imports System.Net
Imports System.IO
Imports System.Xml
'
'
Public Class RssReader
'
'
Public Function GetFeed(ByVal url As String, ByVal maxItems As Integer) As RssFeed
'
Dim feed As RssFeed = New RssFeed()
Dim _item As RssItem = Nothing
Dim request As WebRequest
Dim response As WebResponse
Dim rssStream As Stream
Dim rssDoc As New XmlDocument()
Dim rssItems As XmlNodeList
Dim rssHeader As XmlNodeList
Dim rssDetail As XmlNode
Dim upperlimit As Integer = maxItems
Dim itemtitle As String = ""
Dim itemlink As String = ""
Dim itemdate As Date = Date.MinValue
feed.URL = url
If upperlimit > 50 Then
upperlimit = 50
End If
If upperlimit <= 0 Then
Return feed
End If
Try
request = WebRequest.Create(url)
request.Timeout = 3000
response = request.GetResponse()
rssStream = response.GetResponseStream()
rssDoc.Load(rssStream)
rssStream.Close()
'
' Attempt retrieval for RSS v2.0
rssHeader = rssDoc.SelectNodes("rss/channel")
If rssHeader.Count < 1 Then
' Attempt retrieval for RSS v0.90, v0.91, v1.0
rssHeader = rssDoc.SelectNodes("RDF/channel")
End If
If rssHeader.Count < 1 Then
' Attempt retrieval for Atom v1.0
rssDoc = AtomToRssConverter(rssDoc)
rssHeader = rssDoc.SelectNodes("rss/channel")
End If
If rssHeader.Count < 1 Then
' No matching XML nodes could be found, so this maynot be a valid RSS/Atom feed.
Return feed
End If
rssDetail = rssHeader.Item(0).SelectSingleNode("title")
If Not rssDetail Is Nothing Then
feed.Title = rssDetail.InnerText
End If
rssDetail = rssHeader.Item(0).SelectSingleNode("description")
If Not rssDetail Is Nothing Then
feed.Description = rssDetail.InnerText
End If
rssDetail = rssHeader.Item(0).SelectSingleNode("subtitle")
If Not rssDetail Is Nothing Then
feed.Description = rssDetail.InnerText
End If
' Attempt retrieval for RSS v2.0
rssItems = rssDoc.SelectNodes("rss/channel/item")
If rssItems.Count < 1 Then
' Attempt retrieval for RSS v0.90, v0.91, v1.0
rssItems = rssDoc.SelectNodes("RDF/item")
End If
If rssItems.Count < 1 Then
' Attempt retrieval for Atom v1.0
rssItems = rssDoc.SelectNodes("atom:feed/entry")
End If
'
If rssItems.Count > 0 Then
Dim i As Integer = 0
While i < upperlimit
rssDetail = rssItems.Item(i).SelectSingleNode("title")
If Not rssDetail Is Nothing Then
itemtitle = rssDetail.InnerText
Else
itemtitle = ""
End If
rssDetail = rssItems.Item(i).SelectSingleNode("link")
If Not rssDetail Is Nothing Then
itemlink = rssDetail.InnerText
Else
itemlink = ""
End If
rssDetail = rssItems.Item(i).SelectSingleNode("pubDate")
If Not rssDetail Is Nothing Then
If IsDate(rssDetail.InnerText) Then
itemdate = CDate(rssDetail.InnerText)
End If
End If
rssDetail = rssItems.Item(i).SelectSingleNode("updated")
If Not rssDetail Is Nothing Then
If IsDate(rssDetail.InnerText) Then
itemdate = CDate(rssDetail.InnerText)
End If
End If
'
If itemtitle <> "" And itemlink <> "" Then
_item = New RssItem
_item.Title = itemtitle
_item.Link = itemlink
_item.PublishDate = itemdate
feed.Items.Add(_item)
End If
i += 1
End While
End If
'
Catch ex As Exception
'
End Try
'
Return feed
'
End Function
'
'
Public Class RssFeed
'
Dim _url As String = ""
Dim _title As String = ""
Dim _description As String = ""
Dim _items As List(Of RssItem) = New List(Of RssItem)()
'
Public Property URL() As String
Get
Return _url
End Get
Set(ByVal value As String)
_url = value
End Set
End Property
'
Public Property Title() As String
Get
Return _title
End Get
Set(ByVal value As String)
_title = value
End Set
End Property
'
Public Property Description() As String
Get
Return _description
End Get
Set(ByVal value As String)
_description = value
End Set
End Property
'
Public Property Items() As List(Of RssItem)
Get
Return _items
End Get
Set(ByVal value As List(Of RssItem))
_items = value
End Set
End Property
'
End Class
'
'
Public Class RssItem
'
'
Dim _title As String = ""
Dim _link As String = ""
Dim _pubDate As Date = Date.MinValue
'
Public Property Title() As String
Get
Return _title
End Get
Set(ByVal value As String)
_title = value
End Set
End Property
'
Public Property Link() As String
Get
Return _link
End Get
Set(ByVal value As String)
_link = value
End Set
End Property
'
Public Property PublishDate() As Date
Get
Return _pubDate
End Get
Set(ByVal value As Date)
_pubDate = value
End Set
End Property
'
'
End Class
'
'
Private Function AtomToRssConverter(ByVal atomDoc As XmlDocument) As XmlDocument
Dim xmlDoc As XmlDocument = atomDoc
Dim xmlNode As XmlNode = Nothing
Dim mgr As New XmlNamespaceManager(xmlDoc.NameTable)
mgr.AddNamespace("atom", "http://purl.org/atom/ns#")
Const rssVersion As String = "2.0"
Const rssLanguage As String = "en-US"
Dim rssGenerator As String = "RDFFeedConverter"
Dim memoryStream As New MemoryStream()
Dim xmlWriter As New XmlTextWriter(memoryStream, Nothing)
xmlWriter.Formatting = Formatting.Indented
Dim feedTitle As String = ""
Dim feedLink As String = ""
Dim rssDescription As String = ""
xmlNode = xmlDoc.SelectSingleNode("//atom:title", mgr)
If xmlNode Is Nothing Then
This looks like an ATOM v1.0 format, rather than ATOM v0.3.
mgr.RemoveNamespace("atom", "http://purl.org/atom/ns#")
mgr.AddNamespace("atom", "http://www.w3.org/2005/Atom")
End If
xmlNode = xmlDoc.SelectSingleNode("//atom:title", mgr)
If Not xmlNode Is Nothing Then
feedTitle = xmlNode.InnerText
End If
xmlNode = xmlDoc.SelectNodes("//atom:link/@href", mgr)(2)
If Not xmlNode Is Nothing Then
feedLink = xmlNode.InnerText
End If
xmlNode = xmlDoc.SelectSingleNode("//atom:tagline", mgr)
If Not xmlNode Is Nothing Then
rssDescription = xmlNode.InnerText
End If
xmlNode = xmlDoc.SelectSingleNode("//atom:subtitle", mgr)
If Not xmlNode Is Nothing Then
rssDescription = xmlNode.InnerText
End If
xmlWriter.WriteStartElement("rss")
xmlWriter.WriteAttributeString("version", rssVersion)
xmlWriter.WriteStartElement("channel")
xmlWriter.WriteElementString("title", feedTitle)
xmlWriter.WriteElementString("link", feedLink)
xmlWriter.WriteElementString("description", rssDescription)
xmlWriter.WriteElementString("language", rssLanguage)
xmlWriter.WriteElementString("generator", rssGenerator)
Dim items As XmlNodeList = xmlDoc.SelectNodes("//atom:entry", mgr)
If items Is Nothing Then
Throw New FormatException("Atom feed is not in expected format. ")
Else
Dim title As String = [String].Empty
Dim link As String = [String].Empty
Dim description As String = [String].Empty
Dim author As String = [String].Empty
Dim pubDate As String = [String].Empty
For i As Integer = 0 To items.Count - 1
Dim nodTitle As XmlNode = items(i)
xmlNode = nodTitle.SelectSingleNode("atom:title", mgr)
If Not xmlNode Is Nothing Then
title = xmlNode.InnerText
End If
Try
link = items(i).SelectSingleNode("atom:link[@rel= alternate ]", mgr).Attributes("href").InnerText
Catch ex As Exception
link = items(i).SelectSingleNode("atom:link", mgr).Attributes("href").InnerText
End Try
xmlNode = items(i).SelectSingleNode("atom:content", mgr)
If Not xmlNode Is Nothing Then
description = xmlNode.InnerText
End If
xmlNode = items(i).SelectSingleNode("//atom:name", mgr)
If Not xmlNode Is Nothing Then
author = xmlNode.InnerText
End If
xmlNode = items(i).SelectSingleNode("atom:issued", mgr)
If Not xmlNode Is Nothing Then
pubDate = xmlNode.InnerText
End If
xmlNode = items(i).SelectSingleNode("atom:updated", mgr)
If Not xmlNode Is Nothing Then
pubDate = xmlNode.InnerText
End If
xmlWriter.WriteStartElement("item")
xmlWriter.WriteElementString("title", title)
xmlWriter.WriteElementString("link", link)
If pubDate.Length < 1 Then
pubDate = Date.MinValue.ToString()
End If
xmlWriter.WriteElementString("pubDate", Convert.ToDateTime(pubDate).ToUniversalTime().ToString("ddd, dd MMM yyyy HH:mm:ss G\MT"))
xmlWriter.WriteElementString("author", author)
xmlWriter.WriteElementString("description", description)
xmlWriter.WriteEndElement()
Next
xmlWriter.WriteEndElement()
xmlWriter.Flush()
xmlWriter.Close()
End If
Dim retDoc As New XmlDocument()
Dim outStr As String = Encoding.UTF8.GetString(memoryStream.ToArray())
retDoc.LoadXml(outStr)
Return retDoc
End Function
'
'
End Class