<%

Option Explicit ' must be the first statement

' (SS,27/6/07) made into sub and added code to set properties
Dim FURLToRSS, FMaxItems, FItemTemplate, FKeyWord1, FKeyWord2

Initialise

Sub Initialise
	FURLToRSS = "http://news.bbc.co.uk/rss/newsonline_uk_edition/front_page/rss.xml"
	FMaxItems = 7
	' ##### Item template.
  ' ##### {LINK} will be replaced with item link
  ' ##### {TITLE} will be replaced with item title
  ' ##### {DESCRIPTION} will be replaced with item description
  ' ##### {DATE} will be replaced with item date and time
  ' ##### {COMMENTSLINK} will be replaced with link to comments (if you use RSS feed from blog)
  ' ##### {CATEGORY} will be replaced with item category
	FItemTemplate = "<tr><td><strong>{DATE}</strong><br/><strong>{CATEGORY}<br/></strong><a href=" & """{LINK}""" & ">{TITLE}</a><BR>{DESCRIPTION}</td></tr>"
	FKeyWord1 = ""
	FKeyWord2 = ""
End Sub

Sub SetURLToRSS(AValue)
  FURLToRSS = AValue
End Sub

Sub SetMaxItems(AValue)
  FURL = AValue
End Sub

Sub SetMaxItems(AValue)
  FMaxItems = AValue
End Sub

Sub SetItemTemplate(AValue)
  FItemTemplate = AValue
End Sub

Sub SetKeyword1(AValue)
  FKeyWord1 = AValue
End Sub

Sub SetKeyword2(AValue)
  FKeyWord2 = AValue
End Sub

 ' (SS,19/9/05)
Sub SetAllowBlankEmailAndTel(AAllowBlankEmailAndTel)
  FAllowBlankEmailAndTel = AAllowBlankEmailAndTel
End Sub


Sub ShowRSS
 Response.Expires = -1

 ' =========== RSS2HTML.ASP for ASP/ASP.NET ==========
 ' copyright 2005-2007 (c) www.Bytescout.com
 '  version 1.23, 14 June 2007
 ' ===============================================
 ' ##############################################################
 ' ####### CHECK OUR COMMERCIAL PRODUCTS FOR ASP/ASP.NET: #######
 ' SWF Scout [ http://bytescout.com/swfscout.html ]- create, read, modify flash movies (SWF)
 ' SWF SlideShow Scout [ http://bytescout.com/swfslideshowscout.html ]- convert JPEG,PNG,BMP into slideshow flash (SWF) with effects
 ' PDFDoc Scout [ http://bytescout.com/pdfdocscout.html ]- generate PDF documents with security options
 ' ##############################################################

 ' =========== configuration =====================
 ' ##### URL to RSS Feed to display #########
 ' (SS,27/6/07) was ' "http://www.bytescout.com/blog/feed" which didn't work and caused access is denied error
 ' replaced with a bbc one which worked: "http://news.bbc.co.uk/rss/newsonline_uk_edition/front_page/rss.xml"
 ' later replaced it with FURL

 ' (SS,27/6/07) added following because I prefer to use Option Explicit
 Dim MainTemplateHeader, MainTemplateFooter, ErrorMessage
 Dim xmlHttp, RSSXML, xmlDOM, RSSItems, RSSItemsCount, j, i
 Dim RSSItem, child, RSStitle, RSSdescription, RSSLink, RSSDate
 Dim CategoryItems, RSSCategory, categoryitem, ItemContent, RSSCommentsLink

 ' ##### max number of displayed items #####
 ' (SS,27/6/07) replaced 7 with FMaxItems, later removed
 ' MaxNumberOfItems = FMaxItems

 ' ##### Main template constants
 MainTemplateHeader = "<table>"
 MainTemplateFooter = "</table>"
 ' #####

' ######################################
 ' (SS,27/6/07) added parameters AKeyWord1, AKeyWord2
 ' (SS,27/6/07) removed
 'Keyword1 = FKeyWord1 ' ""  ' Keyword1 =  "tech" - set non-empty keyword value to filter by this keyword
 'Keyword2 = FKeyWord2 ' "" ' Keyword1 =  "win" - set non-empty keyword value to filter by this 2nd keyword too
' #################################


 ' (SS,21/6/07) move template to Initialise


 ' ##### Error message that will be displayed if not items etc
 ErrorMessage = "Error has occured while trying to process " & FURLToRSS & "<BR>Please contact web-master"

 ' ================================================

 Set xmlHttp = Server.CreateObject("MSXML2.XMLHTTP.3.0")
 xmlHttp.Open "Get", FURLToRSS, 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 <item>..</item> entries, then try to get <entry>..</entry>
 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 MainTemplateHeader
 End If

 j = -1

 For i = 0 To RSSItemsCount
 Set RSSItem = RSSItems.Item(i)

  for each child in RSSItem.childNodes

   Select case lcase(child.nodeName)
     case "title"
           RSStitle = child.text
     case "link"
	   If RSSLink = "" Then
		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
	   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
     case "comments"
           RSSCommentsLink = child.text
     case "category"
	  	Set CategoryItems = RSSItem.getElementsByTagName("category")
		RSSCategory = ""
	  		for each categoryitem in CategoryItems
           			if RSSCategory <> "" Then
					RSSCategory = RSSCategory & ", "
				End If

					RSSCategory = RSSCategory & categoryitem.text
			Next
   End Select
  next

' now check filter
 ' (SS,27/6/07)added 1,,vbTextCompare, added F in front of KeyWord1 and 2
 If (InStr(1,RSSTitle,FKeyword1,vbTextCompare)>0) or (InStr(1,RSSTitle,FKeyword2,vbTextCompare)>0) or (InStr(1,RSSDescription,FKeyword1,vbTextCompare)>0) or (InStr(1,RSSDescription,FKeyword2,vbTextCompare)>0) then

  j = J+1

  if J < FMaxItems then
  ItemContent = Replace(FItemTemplate,"{LINK}",RSSlink)
  ItemContent = Replace(ItemContent,"{TITLE}",RSSTitle)
  ItemContent = Replace(ItemContent,"{DATE}",RSSDate)
  ItemContent = Replace(ItemContent,"{COMMENTSLINK}",RSSCommentsLink)
  ItemContent = Replace(ItemContent,"{CATEGORY}",RSSCategory)

  Response.Write Replace(ItemContent,"{DESCRIPTION}",RSSDescription)
  ItemContent = ""
  RSSLink = ""
  End if
End If

 Next

 ' writing Footer
 if RSSItemsCount > 0 then
  Response.Write MainTemplateFooter
 else
  Response.Write ErrorMessage
 End If

' Response.End ' uncomment this for use in on-the-fly output
End Sub
%>