vb RSS Feed

Private Sub RSS_Posts()
	Set m_objPost = New Post

	'header
	m_XML = "<?xml version=""1.0""?>" & vbCrLf
	m_XML = m_XML & "<rss version=""2.0"" xmlns:atom=""http://www.w3.org/2005/Atom"">" & vbCrLf
	m_XML = m_XML & "<channel>" & vbCrLf
	m_XML = m_XML & "<title>" & Application("SiteName") & " Posts</title>" & vbCrLf
	m_XML = m_XML & "<link>" & Application("SiteURL") & "</link>" & vbCrLf
	m_XML = m_XML & "<description>" & Application("SiteName") & " Posts RSS 2.0 Feed</description>" & vbCrLf
	m_XML = m_XML & "<language>en</language>" & vbCrLf
	m_XML = m_XML & "<pubDate>" & RSS_Date(now(), "GMT") & "</pubDate>" & vbCrLf
	m_XML = m_XML & "<generator>Weblog Editor 2.0</generator>" & vbCrLf
	m_XML = m_XML & "<ttl>60</ttl>" & vbCrLf
	m_XML = m_XML & "<atom:link href=""" & Application("SiteURL") & "rss2.asp?t=posts"" rel=""self"" type=""application/rss+xml"" />" & vbCrLf
	
	Response.Write(m_XML)
	m_XML = ""

	'items      
	Set m_objRS = Server.CreateObject("ADODB.RecordSet")
	m_strSQL = "Execute Feed_RSS20"
	m_objRS.Open m_strSQL, Application("ConnectionString"), 0, 1
	
	If Not m_objRS.BOF Then
		Do While Not m_objRS.EOF
			m_URL = m_objPost.FormatURL(m_objRS.Fields("URL").Value, "output")

			m_XML = m_XML & "<item>" & vbCrLf
			m_XML = m_XML & "<title>" & m_objRS.Fields("Title").Value & "</title>" & vbCrLf
			m_XML = m_XML & "<link>" & m_URL & "</link>" & vbCrLf
			m_XML = m_XML & "<guid>" & m_URL & "</guid>" & vbCrLf
			m_XML = m_XML & "<description><![CDATA[" & CleanDescription(m_objRS.Fields("Content").Value) & "]]></description>" & vbCrLf
			m_XML = m_XML & "<comments>" & m_URL & "#comments" & "</comments>" & vbCrLf
			m_XML = m_XML & "<pubDate>" & m_objRS.Fields("DateCreated").Value & "</pubDate>" & vbCrLf
			m_XML = m_XML & "</item>" & vbCrLf
			
			Response.Write(m_XML)
			m_XML = ""
			
			m_objRS.MoveNext
		Loop
	Else
		'no posts
	End If
	
	If m_objRS.State <> 0 Then m_objRS.Close
	Set m_objRS = Nothing

	'footer
	m_XML = "</channel>" & vbCrLf
	m_XML = m_XML & "</rss>" & vbCrLf
	Response.Write(m_XML)
	m_XML = ""

	Set m_objPost = Nothing
End Sub

Private Sub RSS_Comments()
	Set m_objPost = New Post

	'header
	m_XML = "<?xml version=""1.0""?>" & vbCrLf
	m_XML = m_XML & "<rss version=""2.0"" xmlns:atom=""http://www.w3.org/2005/Atom"">" & vbCrLf
	m_XML = m_XML & "<channel>" & vbCrLf
	m_XML = m_XML & "<title>" & Application("SiteName") & " Comments</title>" & vbCrLf
	m_XML = m_XML & "<link>" & Application("SiteURL") & "</link>" & vbCrLf
	m_XML = m_XML & "<description>" & Application("SiteName") & " Comments RSS 2.0 Feed</description>" & vbCrLf
	m_XML = m_XML & "<language>en</language>" & vbCrLf
	m_XML = m_XML & "<pubDate>" & RSS_Date(now(), "GMT") & "</pubDate>" & vbCrLf
	m_XML = m_XML & "<generator>SlickCMS " & Application("SlickCMS_Version") & "</generator>" & vbCrLf
	m_XML = m_XML & "<ttl>60</ttl>" & vbCrLf
	m_XML = m_XML & "<atom:link href=""" & Application("SiteURL") & "rss2.asp?t=comments"" rel=""self"" type=""application/rss+xml"" />" & vbCrLf
	
	Response.Write(m_XML)
	m_XML = ""

	'items      
	Set m_objRS = Server.CreateObject("ADODB.RecordSet")
	m_strSQL = "Execute Feed_RSS20_Comments"
	m_objRS.Open m_strSQL, Application("ConnectionString"), 0, 1
	
	If Not m_objRS.BOF Then
		Do While Not m_objRS.EOF
			m_URL = Application("SiteUrl") & m_objRS.Fields("URL").Value

			m_XML = m_XML & "<item>" & vbCrLf
			m_XML = m_XML & "<title>" & m_objRS.Fields("Title").Value & "</title>" & vbCrLf
			m_XML = m_XML & "<link>" & m_URL & "</link>" & vbCrLf
			m_XML = m_XML & "<guid>" & m_URL & "</guid>" & vbCrLf
			m_XML = m_XML & "<description><![CDATA[" & CleanDescription(m_objRS.Fields("Content").Value) & "]]></description>" & vbCrLf
			m_XML = m_XML & "<pubDate>" & m_objRS.Fields("DateCreated").Value & "</pubDate>" & vbCrLf
			m_XML = m_XML & "</item>" & vbCrLf
			
			Response.Write(m_XML)
			m_XML = ""
			
			m_objRS.MoveNext
		Loop
	Else
		'no comments
	End If
	
	If m_objRS.State <> 0 Then m_objRS.Close
	Set m_objRS = Nothing

	'footer
	m_XML = "</channel>" & vbCrLf
	m_XML = m_XML & "</rss>" & vbCrLf
		
	Response.Write(m_XML)
	m_XML = ""

	Set m_objPost = Nothing
End Sub

Private Function RSS_Date(dDate, offset)
	Dim dDay, dDays, dMonth, dYear
	Dim dHours, dMinutes, dSeconds

	dDate = CDate(dDate)
	dDay = WeekdayName(Weekday(dDate),true)
	dDays = Day(dDate)
	dMonth = MonthName(Month(dDate), true)
	dYear = Year(dDate)
	dHours = zeroPad(Hour(dDate), 2)
	dMinutes = zeroPad(Minute(dDate), 2)
	dSeconds = zeroPad(Second(dDate), 2)

	RSS_Date = dDay & ", " & dDays & " " & dMonth & " " & dYear & " "& dHours & ":" & dMinutes & ":" & dSeconds & " " & offset
End Function 

Private Function zeroPad(m, t)
   zeroPad = String((t - Len(m)),"0") & m
End Function

Private Function CleanDescription(str)
	'removes whitespace from the <description>
	str = Replace(str, vbCrLf, "")
	CleanDescription = str
End Function
Generates an RSS Feed for Posts and Comments - as used on slickcms

Updated: Saturday 9th October 2010, 06:05pm

There are 0 comments

Leave a comment of your own

Comments are currently closed.