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