<%
'--------------------------------------------------------------------------------------------------
' MODULE:   cRSS20.asp
' AUTHOR:   Terje Hauger
' HOME:     © www.u229.no/stuff/Rss/
' CREATED:  February 2006
' MODIFIED: March 2008
' VERSION:  1.2
'--------------------------------------------------------------------------------------------------
' COMMENT:
' Create RSS 2.0 feeds with classic ASP (Really Simple Syndication).
' RSS 2.0 reference: http://blogs.law.harvard.edu/tech/rss

' This class supports all features described by the RSS 2.0 reference.
'--------------------------------------------------------------------------------------------------
' ROUTINES:

' - Public Property Let SavePath(s)
' - Public Property Let Stylesheet(s)
' - Public Property Let Title(s)
' - Public Property Let Link(s)
' - Public Property Let Description(s)
' - Public Property Let Language(s)
' - Public Property Let Copyright(s)
' - Public Property Let ManagingEditor(s)
' - Public Property Let WebMaster(s)
' - Public Property Let PubDate(s)
' - Public Property Let LastBuildDate(s)
' - Public Property Let Category(s)
' - Public Property Let Generator(s)
' - Public Property Let Docs(s)
' - Public Property Let Cloud(s)
' - Public Property Let TimeToLive(s)
' - Public Property Let Image(s)
' - Public Property Let Rating(s)
' - Public Property Let TextInput(s)
' - Public Property Let SkipHours(s)
' - Public Property Let SkipDays(s)
' - Private Sub Class_Initialize()
' - Public Function CreateRSS20Feed(oRS)
' - Private Sub UTF8(sXml)
' - Public Function CreateRSSTime()
'--------------------------------------------------------------------------------------------------

Const XMLDOM_PROGID = "MSXML2.DOMDocument.6.0"    '// If error try "MSXML2.DOMDocument.3.0"

'--------------------------------------------------------------------------------------------------
Class cRSS20
'--------------------------------------------------------------------------------------------------

'// MODULE VARIABLES
Private m_sFeedSavePath
Private m_sStylesheet
Private m_sTitle
Private m_sLink
Private m_sDescription
Private m_sLanguage
Private m_sCopyright
Private m_sManagingEditor
Private m_sWebMaster
Private m_sPubDate
Private m_sLastBuildDate
Private m_sCategory
Private m_sGenerator
Private m_sDocs
Private m_sCloud
Private m_sTimeToLive
Private m_sImage
Private m_sRating
Private m_sTextInput
Private m_sSkipHours
Private m_sSkipDays

'// MODULE PROPERTIES
Public Property Let SavePath(s): m_sFeedSavePath = s: End Property
Public Property Let Stylesheet(s): m_sStylesheet = s: End Property
Public Property Let Title(s): m_sTitle = s: End Property
Public Property Let Link(s): m_sLink = s: End Property
Public Property Let Description(s): m_sDescription = s: End Property
Public Property Let Language(s): m_sLanguage = s: End Property
Public Property Let Copyright(s): m_sCopyright = s: End Property
Public Property Let ManagingEditor(s): m_sManagingEditor = s: End Property
Public Property Let WebMaster(s): m_sWebMaster = s: End Property
Public Property Let PubDate(s): m_sPubDate = s: End Property
Public Property Let LastBuildDate(s): m_sLastBuildDate = s: End Property
Public Property Let Category(s): m_sCategory = s: End Property
Public Property Let Generator(s): m_sGenerator = s: End Property
Public Property Let Docs(s): m_sDocs = s: End Property
Public Property Let Cloud(s): m_sCloud = s: End Property
Public Property Let TimeToLive(s): m_sTimeToLive = s: End Property
Public Property Let Image(s): m_sImage = s: End Property
Public Property Let Rating(s): m_sRating = s: End Property
Public Property Let TextInput(s): m_sTextInput = s: End Property
Public Property Let SkipHours(s): m_sSkipHours = s: End Property
Public Property Let SkipDays(s): m_sSkipDays = s: End Property

'--------------------------------------------------------------------------------------------------
' Comment:
'--------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
    On Error Resume Next
    
    '// SET DEFAULTS
    m_sLanguage = "en-gb"
    
End Sub

'--------------------------------------------------------------------------------------------------
' Comment: Create a RSS 2.0 feed.
'--------------------------------------------------------------------------------------------------
Public Sub CreateRSS20Feed(oRS)
    On Error Resume Next

    Dim sXml
    Dim aTmp
    Dim iCounter

    '// BUILD THE FEED HEADER
    sXml = "<?xml version=""1.0"" encoding=""utf-8"" ?>"
    
    If Len(m_sStylesheet) > 0 Then sXml = sXml & "<?xml-stylesheet title=""XSL_formatting"" href=""" & _
        m_sStylesheet & """ type=""text/xsl""?>"
    
    '// THESE 3 ARE REQURIED
    sXml = sXml & "<rss version=""2.0""><channel><title><![CDATA[" & m_sTitle & "]]></title>"
    sXml = sXml & "<link>" & m_sLink & "</link>"
    sXml = sXml & "<description><![CDATA[" & m_sDescription & "]]></description>"
    
    '// THESE ARE OPTIONAL
    If Len(m_sLanguage) > 0 Then sXml = sXml & "<language>" & m_sLanguage & "</language>"
    If Len(m_sCopyright) > 0 Then sXml = sXml & "<copyright><![CDATA[" & m_sCopyright & "]]></copyright>"
    If Len(m_sManagingEditor) > 0 Then sXml = sXml & "<managingEditor><![CDATA[" & m_sManagingEditor & "]]></managingEditor>"
    If Len(m_sWebMaster) > 0 Then sXml = sXml & "<webMaster><![CDATA[" & m_sWebMaster & "]]></webMaster>"
    If Len(m_sPubDate) > 0 Then sXml = sXml & "<pubDate>" & m_sPubDate & "</pubDate>"
    If Len(m_sLastBuildDate) > 0 Then sXml = sXml & "<lastBuildDate>" & m_sLastBuildDate & "</lastBuildDate>"
    If Len(m_sCategory) > 0 Then sXml = sXml & "<category><![CDATA[" & m_sCategory & "]]></category>"
    If Len(m_sGenerator) > 0 Then sXml = sXml & "<generator><![CDATA[" & m_sGenerator & "]]></generator>"
    If Len(m_sDocs) > 0 Then sXml = sXml & "<docs>" & m_sDocs & "</docs>"
    If Len(m_sCloud) > 0 Then sXml = sXml & m_sCloud
    If Len(m_sTimeToLive) > 0 Then sXml = sXml & "<ttl>" & m_sTimeToLive & "</ttl>"

    If Len(m_sImage) > 0 Then
        aTmp = Split(m_sImage, ",")
        sXml = sXml & "<image><title><![CDATA[" & Trim(aTmp(0)) & "]]></title><url>"
        sXml = sXml & Trim(aTmp(1)) & "</url><link>" & Trim(aTmp(2)) & "</link>"
        sXml = sXml & "<width>" & Trim(aTmp(3)) & "</width><height>" & Trim(aTmp(4)) & "</height>"
	sXml = sXml & "<description>" & Trim(aTmp(5)) & "</description></image>"
    End If

    If Len(m_sRating) > 0 Then sXml = sXml & "<rating>" & m_sRating & "</rating>"

    If Len(m_sTextInput) > 0 Then
        aTmp = Split(m_sTextInput, ",")
        sXml = sXml & "<textInput><title><![CDATA[" & Trim(aTmp(0)) & "]]></title>"
        sXml = sXml & "<description><![CDATA[" & Trim(aTmp(1)) & "]]></description>"
        sXml = sXml & "<name><![CDATA[" & Trim(aTmp(2)) & "]]></name><link>" & Trim(aTmp(3)) & "</link></textInput>"
    End If

    If Len(m_sSkipHours) > 0 Then
        On Error Resume Next
        aTmp = Split(m_sSkipHours, ",")

        If Err Then ReDim aTmp(0): Err.Clear

        sXml = sXml & "<skipHours>"

        For iCounter = 0 To UBound(aTmp)
            sXml = sXml & "<hour>" & Trim(aTmp(iCounter)) & "</hour>"
        Next
                
        sXml = sXml & "</skipHours>"
    End If

    If Len(m_sSkipDays) > 0 Then
        On Error Resume Next
        aTmp = Split(m_sSkipDays, ",")

        If Err Then ReDim aTmp(0): Err.Clear

        sXml = sXml & "<skipDays>"

        For iCounter = 0 To UBound(aTmp)
            sXml = sXml & "<day>" & Trim(aTmp(iCounter)) & "</day>"
        Next
                
        sXml = sXml & "</skipDays>"
    End If

    '// LOOP THE RECORDSET FOR THE ITEM ELEMENTS
    Do While Not oRS.EOF

        sXml = sXml & "<item>"

        If Len(oRS("title")) > 0 Then sXml = sXml & "<title><![CDATA[" & oRS("title") & "]]></title>"
        If Len(oRS("link")) > 0 Then sXml = sXml & "<link>" & oRS("link") & "</link>"
        If Len(oRS("description")) > 0 Then sXml = sXml & "<description><![CDATA[" & oRS("description") & "]]></description>"

        If Len(oRS("author_email")) > 0 Then
            sXml = sXml & "<author><![CDATA[" & oRS("author_email")

            If Len(oRS("author_name")) > 0 Then sXml = sXml & "(" & oRS("author_name") & ")"

            sXml = sXml & "]]></author>"
        End If

        If Len(oRS("category")) > 0 Then
            If Len(oRS("category_domain")) > 0 Then
                sXml = sXml & "<category domain=""" & oRS("category_domain") & """><![CDATA[" & oRS("category") & "]]></category>"
            Else
                sXml = sXml & "<category><![CDATA[" & oRS("category") & "]]></category>"
            End If
        End If

        If Len(oRS("comments")) > 0 Then sXml = sXml & "<comments>" & oRS("comments") & "</comments>"

        If Len(oRS("enclosure_url")) > 0 Then
            sXml = sXml & "<enclosure url=""" & oRS("enclosure_url") & """ length=""" & _
			    oRS("enclosure_length") & """ type=""" & oRS("enclosure_type") & """ />"
        End If

        If Len(oRS("guid")) > 0 Then
            If Len(oRS("guid_isPermalink")) > 0 Then
                sXml = sXml & "<guid isPermaLink=""" & LCase(oRS("guid_isPermalink")) & """>" & oRS("guid") & "</guid>"
            Else
                sXml = sXml & "<guid>" & oRS("guid") & "</guid>"
            End If
        End If

        If Len(oRS("pubDate")) > 0 Then
            sXml = sXml & "<pubDate>" & oRS("pubDate") & "</pubDate>"
        Else
            sXml = sXml & "<pubDate>" & CreateRSSTime & "</pubDate>"
        End If

        If Len(oRS("source")) > 0 Then
            sXml = sXml & "<source url=""" & oRS("source") & """><![CDATA[" & oRS("source_title") & "]]></source>"
        End If

        sXml = sXml & "</item>"

        oRS.MoveNext
    Loop

    sXml = sXml & "</channel></rss>"

    '// SAVE THE RESULTING RSS 2.0 FEED TO FILE AS UTF-8
    Call UTF8(sXml)

End Sub

'--------------------------------------------------------------------------------------------------
' Comment: Save RSS Feed to file. Default encoding for Xmldom is utf-8.
'--------------------------------------------------------------------------------------------------
Private Sub UTF8(sXml)
    On Error Resume Next

    Dim oXML: Set oXML = CreateObject(XMLDOM_PROGID)

    With oXML
        .async = False
        .loadXML (sXml)
        .save m_sFeedSavePath
    End With

    If (oXML.parseError.errorCode <> 0) Then
        Response.Write "XML parseError errorCode " & oXML.parseError.errorCode & "<br />"
        Response.Write "XML parseError on line " & oXML.parseError.Line & "<br />"
        Response.Write "XML parseError linepos " & oXML.parseError.linepos & "<br />"
        Response.Write "XML parseError reason " & oXML.parseError.reason & "<br />"
    End If

    Set oXML = Nothing

End Sub

'------------------------------------------------------------------------------------------------------------
' Comment: Create valid RFC822 timestamp for RSS 2.0. Example: Wed, 1 Feb 2006 15:00:00 GMT
'------------------------------------------------------------------------------------------------------------
Private Function CreateRSSTime()
    On Error Resume Next
    
    '// USE JSCRIPT TO GET THE CURRENT UTC (GMT) TIME STAMP AND STORE IT IN Session("ServerGMT")
    Server.Execute "GetServerGMT.asp"

    '// REPLACE STRING UTC WITH GMT
    CreateRSSTime = Replace(Session("ServerGMT"), "UTC", "GMT")

End Function

'--------------------------------------------------------------------------------------------------
End Class
'--------------------------------------------------------------------------------------------------
%>