Soren Winslow Soren Winslow
Multi RSS News Feed Reader
This script will take several RSS feeds and combine them into one feed for display.
This script will take several RSS feeds and combine them into one feed for display. For example on my Triumph Motorcycle News page, I use Google for my news feeds searching for several key terms that relate to Triumph motorcycles. The script below will take those feeds, throw out the duplicate news articles and also sort them by date making it all appear to the visitor as a single news feed.
The examples below show using RSS News Feeds from Google. However, it will work with feeds from any valid RSS source.
It works by grabbing each RSS Feed then creating an array out of each news item. As it cycles through the next news feed it then compares each headline to see if it has already been added into the array. After each news feed has been downloaded and filtered for duplicates, it then sorts the new news feed array by publication date. After the sorting takes place we then have the option of how we want to display the new news feed.
You can use this script to display multiple RSS feeds to the web browser or to generate a new RSS feed.

Here is the code for the Multi RSS News Feed Reader for on screen viewing:



 <%

 x = 0 'Declare Article Count

 dim TitleArr() 'Declare array for news feed titles

 dim LinkArr() 'Declare array for news feed links

 dim DescArr() 'Declare array for news feed descriptions

 dim DateArr() 'Declare array for news feed dates





 Sub BuildRSS(TheFeed)



    Set objXML = Server.CreateObject("Microsoft.XMLDOM")



       objXML.Async = False

       objXML.SetProperty "ServerHTTPRequest", True

       objXML.ResolveExternals = True

       objXML.ValidateOnParse = True

       objXML.Load(TheFeed) 'Load News Feed



       If (objXML.parseError.errorCode = 0) Then

          Set objRoot = objXML.documentElement

          If IsObject(objRoot) = False Then

             Response.Write "There was an error retrieving the <i>" & _

                            TheFeed & _

                            "</i> news feed "

          Else



             Set objItems = objRoot.getElementsByTagName("item")

                If IsObject(objItems) = True Then

                   For Each objItem in objItems

                      On Error Resume Next

                      TheTitle =  objItem.selectSingleNode("title").Text

                      TheLink =  objItem.selectSingleNode("link").Text

                      TheDesc =  objItem.selectSingleNode("description").Text

                      TheDate =  objItem.selectSingleNode("pubDate").Text



                     DoAddToArr = True

                     'Cycle through title array looking for duplicate articles

                     'If it does not exist, add to array

                     If x > 0 Then

                       For y = 0 to UBound(TitleArr)

                          If TheTitle = TitleArr(y) Then

                            DoAddToArr = False

                          End If

                       Next

                     End If



                      ReDim Preserve TitleArr(x)

                      ReDim Preserve LinkArr(x)

                      ReDim Preserve DescArr(x)

                      ReDim Preserve DateArr(x)



                     If DoAddToArr = True Then



                      TitleArr(x) = TheTitle

                      LinkArr(x) = TheLink

                      DescArr(x) = TheDesc

                      DateArr(x) = TheDate



                       x = x + 1

                     End If



                   Next

                End If

             Set objItems = Nothing

          End If

          Set objRoot = Nothing

       Else

          Response.Write "There was an error retrieving the <i>" & _

                            TheFeed & _

                            "</i> news feed "

       End If



    Set objXML = Nothing

 End Sub



  'Get the news feed

  TheFeed =  "http://news.google.com/news" & _

             "?output=rss" & _

             "&num=100" & _

             "&q=triumph-motorcycles"

 BuildRSS(TheFeed)



  'Get the next news feed

  TheFeed =  "http://news.google.com/news" & _

             "?output=rss" & _

             "&num=100" & _

             "&q=triumph-speedmaster"

 BuildRSS(TheFeed)

 

 ' Keep repeating the above until you have

 ' all the feeds you would like to combine



 ' Sort the news articles by date

 ' The newest one on top

 TempLinkVal = ""

 TempTitleVal = ""

 TempDescVal = ""

 TempDateVal = ""

 For r = 0 to UBound(DateArr)

      For s=r+1 to UBound(DateArr)

         If DateArr(r)<DateArr(s) then

            TempLinkVal = LinkArr(r)

            TempTitleVal = TitleArr(r)

            TempDescVal = DescArr(r)

            TempDateVal = DateArr(r)



            LinkArr(r)=LinkArr(s)

            TitleArr(r)=TitleArr(s)

            DescArr(r)=DescArr(s)

            DateArr(r)=DateArr(s)



            LinkArr(s) = TempLinkVal

            TitleArr(s) = TempTitleVal

            DescArr(s) = TempDescVal

            DateArr(s) = TempDateVal

         End If

      Next

 Next



 'Display the results

 For x = 0 to UBound(TitleArr)

    Response.Write "<div id=" & chr(34) & "Newsitem" & x & chr(34) & ">" & chr(13)





    Response.Write "<a href=" & chr(34) & LinkArr(x) & chr(34) & " " & _

                       "style=" & chr(34) & "font-weight:bold;" & chr(34) & ">" & chr(13) & _

                       TitleArr(x) & chr(13) & _

                    "</a>" & chr(13) & _

                        

    Response.Write "<div style=" & chr(34) & "padding-left:20px;" & chr(34) & ">" & chr(13) & _

                        DescArr(x) & chr(13) & _

                            "<div style=" & chr(34) & "padding-left:20px;" & chr(34) & ">" & chr(13) & _

                            DateArr(x) & chr(13) & _

                            "</div>" & chr(13) & _

                        "</div>" & chr(13)



    Response.Write "</div>" & chr(13) & chr(13)

 Next

 %>

               
Here is the code for the Multi RSS News Feed Reader for creating a brand new RSS news feed:



 <?xml version="1.0" encoding="ISO-8859-1"?>

 <%

   Response.Buffer = true

   Response.ContentType = "text/xml"

 %>

 <rss version="2.0">



 <channel>

 <title>Triumph motorcycles in the headlines and news</title>

 <link>http://www.SorenWinslow.com/TriumphNews.asp</link>

 <description>

          Triumph Motorcycle News and Headlines

 </description>

 <image>

       <url>http://www.SorenWinslow.com/Img/Triumph/TriumphCentury.jpg</url>

       <title>Triumph motorcycles in the headlines and news</title>

       <link>http://www.SorenWinslow.com/TriumphNews.asp</link>

 </image>

 <language>en-us</language>

 <%



 x = 0 'Declare Article Count

 dim TitleArr() 'Declare array for news feed titles

 dim LinkArr() 'Declare array for news feed links

 dim DescArr() 'Declare array for news feed descriptions

 dim DateArr() 'Declare array for news feed dates





 Sub BuildRSS(TheFeed)



    Set objXML = Server.CreateObject("Microsoft.XMLDOM")



       objXML.Async = False

       objXML.SetProperty "ServerHTTPRequest", True

       objXML.ResolveExternals = True

       objXML.ValidateOnParse = True

       objXML.Load(TheFeed) 'Load News Feed



       If (objXML.parseError.errorCode = 0) Then

          Set objRoot = objXML.documentElement

          If IsObject(objRoot) = False Then

             Response.Write "There was an error retrieving the <i>" & _

                            TheFeed & _

                            "</i> news feed "

          Else



             Set objItems = objRoot.getElementsByTagName("item")

                If IsObject(objItems) = True Then

                   For Each objItem in objItems

                      On Error Resume Next

                      TheTitle =  objItem.selectSingleNode("title").Text

                      TheLink =  objItem.selectSingleNode("link").Text

                      TheDesc =  objItem.selectSingleNode("description").Text

                      TheDate =  objItem.selectSingleNode("pubDate").Text



                     DoAddToArr = True

                     'Cycle through title array looking for duplicate articles

                     'If it does not exist, add to array

                     If x > 0 Then

                       For y = 0 to UBound(TitleArr)

                          If TheTitle = TitleArr(y) Then

                            DoAddToArr = False

                          End If

                       Next

                     End If



                      ReDim Preserve TitleArr(x)

                      ReDim Preserve LinkArr(x)

                      ReDim Preserve DescArr(x)

                      ReDim Preserve DateArr(x)



                     If DoAddToArr = True Then



                      TitleArr(x) = TheTitle

                      LinkArr(x) = TheLink

                      DescArr(x) = TheDesc

                      DateArr(x) = TheDate



                       x = x + 1

                     End If



                   Next

                End If

             Set objItems = Nothing

          End If

          Set objRoot = Nothing

       Else

          Response.Write "There was an error retrieving the <i>" & _

                            TheFeed & _

                            "</i> news feed "

       End If



    Set objXML = Nothing

 End Sub



  'Get the news feed

  TheFeed =  "http://news.google.com/news" & _

             "?output=rss" & _

             "&num=100" & _

             "&q=triumph-motorcycles"

 BuildRSS(TheFeed)



  'Get the next news feed

  TheFeed =  "http://news.google.com/news" & _

             "?output=rss" & _

             "&num=100" & _

             "&q=triumph-speedmaster"

 BuildRSS(TheFeed)

 

 ' Keep repeating the above until you have

 ' all the feeds you would like to combine



 ' Sort the news articles by date

 ' The newest one on top

 TempLinkVal = ""

 TempTitleVal = ""

 TempDescVal = ""

 TempDateVal = ""

 For r = 0 to UBound(DateArr)

      For s=r+1 to UBound(DateArr)

         If DateArr(r)<DateArr(s) then

            TempLinkVal = LinkArr(r)

            TempTitleVal = TitleArr(r)

            TempDescVal = DescArr(r)

            TempDateVal = DateArr(r)



            LinkArr(r)=LinkArr(s)

            TitleArr(r)=TitleArr(s)

            DescArr(r)=DescArr(s)

            DateArr(r)=DateArr(s)



            LinkArr(s) = TempLinkVal

            TitleArr(s) = TempTitleVal

            DescArr(s) = TempDescVal

            DateArr(s) = TempDateVal

         End If

      Next

 Next



 For x = 0 to UBound(TitleArr)



    Response.Write "<item>" & chr(13)

    Response.Write "<title>" & TitleArr(x) & "</title>" & chr(13)

    Response.Write "<link>#34; & LinkArr(x) & "</link>" & chr(13)

    Response.Write "<description>" & DescArr(x) & "</description>" & chr(13)

    Response.Write "<pubDate>" & DateArr(x) & "</pubDate>" & chr(13)

    Response.Write "</item>" & chr(13)



 Next

%>



 </channel>

 </rss>

               
© 1967 - 2024 Soren Winslow