Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

CraigTP

By: a guest on Jan 7th, 2010  |  syntax: VB.NET  |  size: 11.85 KB  |  views: 250  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Imports Microsoft.VisualBasic
  2. Imports System.Web
  3. Imports System.Web.Configuration
  4. Imports System.Net
  5. Imports System.IO
  6. Imports System.Xml
  7. '
  8. '
  9. Public Class RssReader
  10.     '
  11.     '
  12.     Public Function GetFeed(ByVal url As String, ByVal maxItems As Integer) As RssFeed
  13.         '
  14.         Dim feed As RssFeed = New RssFeed()
  15.         Dim _item As RssItem = Nothing
  16.         Dim request As WebRequest
  17.         Dim response As WebResponse
  18.         Dim rssStream As Stream
  19.         Dim rssDoc As New XmlDocument()
  20.         Dim rssItems As XmlNodeList
  21.         Dim rssHeader As XmlNodeList
  22.         Dim rssDetail As XmlNode
  23.         Dim upperlimit As Integer = maxItems
  24.         Dim itemtitle As String = ""
  25.         Dim itemlink As String = ""
  26.         Dim itemdate As Date = Date.MinValue
  27.  
  28.         feed.URL = url
  29.  
  30.         If upperlimit > 50 Then
  31.             upperlimit = 50
  32.         End If
  33.         If upperlimit <= 0 Then
  34.             Return feed
  35.         End If
  36.  
  37.         Try            
  38.             request = WebRequest.Create(url)
  39.             request.Timeout = 3000
  40.             response = request.GetResponse()
  41.             rssStream = response.GetResponseStream()
  42.             rssDoc.Load(rssStream)
  43.             rssStream.Close()
  44.             '
  45.             ' Attempt retrieval for RSS v2.0
  46.             rssHeader = rssDoc.SelectNodes("rss/channel")
  47.             If rssHeader.Count < 1 Then
  48.                 ' Attempt retrieval for RSS v0.90, v0.91, v1.0
  49.                 rssHeader = rssDoc.SelectNodes("RDF/channel")
  50.             End If
  51.             If rssHeader.Count < 1 Then
  52.                 ' Attempt retrieval for Atom v1.0
  53.                 rssDoc = AtomToRssConverter(rssDoc)
  54.                 rssHeader = rssDoc.SelectNodes("rss/channel")
  55.             End If
  56.             If rssHeader.Count < 1 Then
  57.                 ' No matching XML nodes could be found, so this maynot be a valid RSS/Atom feed.
  58.                 Return feed
  59.             End If
  60.  
  61.  
  62.             rssDetail = rssHeader.Item(0).SelectSingleNode("title")
  63.             If Not rssDetail Is Nothing Then
  64.                 feed.Title = rssDetail.InnerText
  65.             End If
  66.             rssDetail = rssHeader.Item(0).SelectSingleNode("description")
  67.             If Not rssDetail Is Nothing Then
  68.                 feed.Description = rssDetail.InnerText
  69.             End If
  70.             rssDetail = rssHeader.Item(0).SelectSingleNode("subtitle")
  71.             If Not rssDetail Is Nothing Then
  72.                 feed.Description = rssDetail.InnerText
  73.             End If
  74.  
  75.  
  76.             ' Attempt retrieval for RSS v2.0
  77.             rssItems = rssDoc.SelectNodes("rss/channel/item")
  78.             If rssItems.Count < 1 Then
  79.                 ' Attempt retrieval for RSS v0.90, v0.91, v1.0
  80.                 rssItems = rssDoc.SelectNodes("RDF/item")
  81.             End If
  82.             If rssItems.Count < 1 Then
  83.                 ' Attempt retrieval for Atom v1.0
  84.                 rssItems = rssDoc.SelectNodes("atom:feed/entry")
  85.             End If
  86.             '
  87.             If rssItems.Count > 0 Then
  88.                 Dim i As Integer = 0
  89.                 While i < upperlimit
  90.                     rssDetail = rssItems.Item(i).SelectSingleNode("title")
  91.                     If Not rssDetail Is Nothing Then
  92.                         itemtitle = rssDetail.InnerText
  93.                     Else
  94.                         itemtitle = ""
  95.                     End If
  96.                     rssDetail = rssItems.Item(i).SelectSingleNode("link")
  97.                     If Not rssDetail Is Nothing Then
  98.                         itemlink = rssDetail.InnerText
  99.                     Else
  100.                         itemlink = ""
  101.                     End If
  102.                     rssDetail = rssItems.Item(i).SelectSingleNode("pubDate")
  103.                     If Not rssDetail Is Nothing Then
  104.                         If IsDate(rssDetail.InnerText) Then
  105.                             itemdate = CDate(rssDetail.InnerText)
  106.                         End If
  107.                     End If
  108.                     rssDetail = rssItems.Item(i).SelectSingleNode("updated")
  109.                     If Not rssDetail Is Nothing Then
  110.                         If IsDate(rssDetail.InnerText) Then
  111.                             itemdate = CDate(rssDetail.InnerText)
  112.                         End If
  113.                     End If
  114.                     '
  115.                     If itemtitle <> "" And itemlink <> "" Then
  116.                         _item = New RssItem
  117.                         _item.Title = itemtitle
  118.                         _item.Link = itemlink
  119.                         _item.PublishDate = itemdate
  120.                         feed.Items.Add(_item)
  121.                     End If
  122.                     i += 1
  123.                 End While
  124.             End If
  125.             '
  126.         Catch ex As Exception
  127.             '
  128.         End Try
  129.         '
  130.         Return feed
  131.         '
  132.     End Function
  133.     '
  134.     '
  135.     Public Class RssFeed
  136.         '
  137.         Dim _url As String = ""
  138.         Dim _title As String = ""
  139.         Dim _description As String = ""
  140.         Dim _items As List(Of RssItem) = New List(Of RssItem)()
  141.         '
  142.         Public Property URL() As String
  143.             Get
  144.                 Return _url
  145.             End Get
  146.             Set(ByVal value As String)
  147.                 _url = value
  148.             End Set
  149.         End Property
  150.         '
  151.         Public Property Title() As String
  152.             Get
  153.                 Return _title
  154.             End Get
  155.             Set(ByVal value As String)
  156.                 _title = value
  157.             End Set
  158.         End Property
  159.         '
  160.         Public Property Description() As String
  161.             Get
  162.                 Return _description
  163.             End Get
  164.             Set(ByVal value As String)
  165.                 _description = value
  166.             End Set
  167.         End Property
  168.         '
  169.         Public Property Items() As List(Of RssItem)
  170.             Get
  171.                 Return _items
  172.             End Get
  173.             Set(ByVal value As List(Of RssItem))
  174.                 _items = value
  175.             End Set
  176.         End Property
  177.         '
  178.     End Class
  179.     '
  180.     '
  181.     Public Class RssItem
  182.         '
  183.         '
  184.         Dim _title As String = ""
  185.         Dim _link As String = ""
  186.         Dim _pubDate As Date = Date.MinValue
  187.         '
  188.         Public Property Title() As String
  189.             Get
  190.                 Return _title
  191.             End Get
  192.             Set(ByVal value As String)
  193.                 _title = value
  194.             End Set
  195.         End Property
  196.         '
  197.         Public Property Link() As String
  198.             Get
  199.                 Return _link
  200.             End Get
  201.             Set(ByVal value As String)
  202.                 _link = value
  203.             End Set
  204.         End Property
  205.         '
  206.         Public Property PublishDate() As Date
  207.             Get
  208.                 Return _pubDate
  209.             End Get
  210.             Set(ByVal value As Date)
  211.                 _pubDate = value
  212.             End Set
  213.         End Property
  214.         '
  215.         '
  216.     End Class
  217.     '
  218.     '
  219.     Private Function AtomToRssConverter(ByVal atomDoc As XmlDocument) As XmlDocument
  220.         Dim xmlDoc As XmlDocument = atomDoc
  221.         Dim xmlNode As XmlNode = Nothing
  222.         Dim mgr As New XmlNamespaceManager(xmlDoc.NameTable)
  223.         mgr.AddNamespace("atom", "http://purl.org/atom/ns#")
  224.         Const rssVersion As String = "2.0"
  225.         Const rssLanguage As String = "en-US"
  226.         Dim rssGenerator As String = "RDFFeedConverter"
  227.         Dim memoryStream As New MemoryStream()
  228.         Dim xmlWriter As New XmlTextWriter(memoryStream, Nothing)
  229.         xmlWriter.Formatting = Formatting.Indented
  230.         Dim feedTitle As String = ""
  231.         Dim feedLink As String = ""
  232.         Dim rssDescription As String = ""
  233.  
  234.         xmlNode = xmlDoc.SelectSingleNode("//atom:title", mgr)
  235.         If xmlNode Is Nothing Then
  236.               This looks like an ATOM v1.0 format, rather than ATOM v0.3.
  237.             mgr.RemoveNamespace("atom", "http://purl.org/atom/ns#")
  238.             mgr.AddNamespace("atom", "http://www.w3.org/2005/Atom")
  239.         End If
  240.  
  241.         xmlNode = xmlDoc.SelectSingleNode("//atom:title", mgr)
  242.         If Not xmlNode Is Nothing Then
  243.             feedTitle = xmlNode.InnerText
  244.         End If
  245.         xmlNode = xmlDoc.SelectNodes("//atom:link/@href", mgr)(2)
  246.         If Not xmlNode Is Nothing Then
  247.             feedLink = xmlNode.InnerText
  248.         End If
  249.         xmlNode = xmlDoc.SelectSingleNode("//atom:tagline", mgr)
  250.         If Not xmlNode Is Nothing Then
  251.             rssDescription = xmlNode.InnerText
  252.         End If
  253.         xmlNode = xmlDoc.SelectSingleNode("//atom:subtitle", mgr)
  254.         If Not xmlNode Is Nothing Then
  255.             rssDescription = xmlNode.InnerText
  256.         End If
  257.  
  258.         xmlWriter.WriteStartElement("rss")
  259.         xmlWriter.WriteAttributeString("version", rssVersion)
  260.         xmlWriter.WriteStartElement("channel")
  261.         xmlWriter.WriteElementString("title", feedTitle)
  262.         xmlWriter.WriteElementString("link", feedLink)
  263.         xmlWriter.WriteElementString("description", rssDescription)
  264.         xmlWriter.WriteElementString("language", rssLanguage)
  265.         xmlWriter.WriteElementString("generator", rssGenerator)
  266.         Dim items As XmlNodeList = xmlDoc.SelectNodes("//atom:entry", mgr)
  267.         If items Is Nothing Then
  268.             Throw New FormatException("Atom feed is not in expected format. ")
  269.         Else
  270.             Dim title As String = [String].Empty
  271.             Dim link As String = [String].Empty
  272.             Dim description As String = [String].Empty
  273.             Dim author As String = [String].Empty
  274.             Dim pubDate As String = [String].Empty
  275.             For i As Integer = 0 To items.Count - 1
  276.                 Dim nodTitle As XmlNode = items(i)
  277.                 xmlNode = nodTitle.SelectSingleNode("atom:title", mgr)
  278.                 If Not xmlNode Is Nothing Then
  279.                     title = xmlNode.InnerText
  280.                 End If
  281.                 Try
  282.                     link = items(i).SelectSingleNode("atom:link[@rel= alternate ]", mgr).Attributes("href").InnerText
  283.                 Catch ex As Exception
  284.                     link = items(i).SelectSingleNode("atom:link", mgr).Attributes("href").InnerText
  285.                 End Try
  286.                 xmlNode = items(i).SelectSingleNode("atom:content", mgr)
  287.                 If Not xmlNode Is Nothing Then
  288.                     description = xmlNode.InnerText
  289.                 End If
  290.                 xmlNode = items(i).SelectSingleNode("//atom:name", mgr)
  291.                 If Not xmlNode Is Nothing Then
  292.                     author = xmlNode.InnerText
  293.                 End If
  294.                 xmlNode = items(i).SelectSingleNode("atom:issued", mgr)
  295.                 If Not xmlNode Is Nothing Then
  296.                     pubDate = xmlNode.InnerText
  297.                 End If
  298.                 xmlNode = items(i).SelectSingleNode("atom:updated", mgr)
  299.                 If Not xmlNode Is Nothing Then
  300.                     pubDate = xmlNode.InnerText
  301.                 End If
  302.                 xmlWriter.WriteStartElement("item")
  303.                 xmlWriter.WriteElementString("title", title)
  304.                 xmlWriter.WriteElementString("link", link)
  305.                 If pubDate.Length < 1 Then
  306.                     pubDate = Date.MinValue.ToString()
  307.                 End If
  308.                 xmlWriter.WriteElementString("pubDate", Convert.ToDateTime(pubDate).ToUniversalTime().ToString("ddd, dd MMM yyyy HH:mm:ss G\MT"))
  309.                 xmlWriter.WriteElementString("author", author)
  310.                 xmlWriter.WriteElementString("description", description)
  311.                 xmlWriter.WriteEndElement()
  312.             Next
  313.             xmlWriter.WriteEndElement()
  314.             xmlWriter.Flush()
  315.             xmlWriter.Close()
  316.         End If
  317.         Dim retDoc As New XmlDocument()
  318.         Dim outStr As String = Encoding.UTF8.GetString(memoryStream.ToArray())
  319.         retDoc.LoadXml(outStr)
  320.         Return retDoc
  321.     End Function
  322.     '
  323.     '
  324. End Class