%
Response.Expires = -1
' ##### URL to RSS Feed to display #########
URLToRSS = ""
' ##### max number of displayed items #####
NumberOfItems = 7
' ##### Main template constants
TemplateHeader = "
"
' ######################################
Keyword1 = "" ' Keyword1 = "yourkeyword1" - set non-empty keyword value to filter by this keyword
Keyword2 = "" ' Keyword1 = "yourkeyword2" - set non-empty keyword value to filter by this 2nd keyword too
' #################################
ItemTemplate = "{DATE} {CATEGORY} {TITLE} {DESCRIPTION} |
"
' ##### Error message that will be displayed if not items etc
ErrorMessage = "Error has occured while trying to process " &URLToRSS & "
Please contact web-master"
' ================================================
Set xmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
xmlHttp.Open "GET", URLToRSS, false
xmlHttp.Send()
RSSXML = xmlHttp.ResponseText
Set xmlDOM = Server.CreateObject("MSXML2.DomDocument.3.0")
xmlDOM.async = False
xmlDOM.validateOnParse = False
xmlDom.resolveExternals = False
If not xmlDOM.LoadXml(RSSXML) Then
ErrorMessage = "Can not load XML:" & vbCRLF & xmlDOM.parseError.reason & vbCRLF & ErrorMessage
End If
Set xmlHttp = Nothing ' clear HTTP object
Set RSSItems = xmlDOM.getElementsByTagName("item") ' collect all "items" from downloaded RSS
RSSItemsCount = RSSItems.Length-1
' if not - ..
entries, then try to get ..
if RSSItemsCount = -1 Then
Set RSSItems = xmlDOM.getElementsByTagName("entry") ' collect all "entry" (atom format) from downloaded RSS
RSSItemsCount = RSSItems.Length-1
End If
Set xmlDOM = Nothing ' clear XML
' writing Header
if RSSItemsCount > 0 then
Response.Write TemplateHeader
End If
j = -1
For i = 0 To RSSItemsCount
Set RSSItem = RSSItems.Item(i)
' fix for the issue when a description from a previous item
' is used if current item description is empty provided by George Sexton
RSSdescription=" "
RSSCommentsLink=" "
for each child in RSSItem.childNodes
Select case lcase(child.nodeName)
case "title"
RSStitle = child.text
case "link"
If child.Attributes.length>0 Then
RSSLink = child.GetAttribute("href")
if (RSSLink <> "") Then
if child.GetAttribute("rel") <> "alternate" Then
RSSLink = ""
End If
End If
End If ' if has attributes
If RSSLink = "" Then
RSSlink = child.text
End If
case "description"
RSSdescription = child.text
case "content" ' atom format
RSSdescription = child.text
case "published"' atom format
RSSDate = child.text
case "pubdate"
RSSDate = child.text
End Select
next
' now check filter
If (InStr(RSSTitle,Keyword1)>0) or (InStr(RSSTitle,Keyword2)>0) or (InStr(RSSDescription,Keyword1)>0) or (InStr(RSSDescription,Keyword2)>0) then
j = J+1
if J 0 then
Response.Write TemplateFooter
else
Response.Write ErrorMessage
End If
%>