|
|
|
|
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>