HEX
Server: Microsoft-IIS/8.5
System: Windows NT YDAWBH120 6.3 build 9600 (Windows Server 2012 R2 Standard Edition) AMD64
User: tentjecom_web (0)
PHP: 7.4.14
Disabled: NONE
Upload Files
File: D:/HostingSpaces/EBos/ellen-paragnost.nl/wwwroot/asp/includes/rss_writer.asp
<%
	'==============================================================
	' RSS/RDF Syndicate Writer v0.95
	' http://www.kattanweb.com/webdev
	'--------------------------------------------------------------
	' Copyright(c) 2002, KattanWeb.com
	'
	' Change Log:
	'--------------------------------------------------------------
	'==============================================================

class kwRSS_writer

	Private Items(500, 6)
	Private CurrentItem
	Public ChannelRSSURI, ChannelURL, ChannelTitle, ChannelDesc, ChannelLanguage
	Public ImageTitle, ImageLink, ImageURL
	Public TextInputURL, TextInputTitle, TextInputDesc, TextInputName
	
	Private myXML

    '>>>>>>>> Setup Initialize event, called automtially when creating an instant of this class using
	'	      Set MyXML = new kwRSS_writer
	Private Sub Class_Initialize
		CurrentItem = -1
	End Sub

    '>>>>>>>> Setup Terminate event, called automtially when killing an instant of this class using
	'	      Set MyXML = nothing
	Private Sub Class_Terminate
		Erase Items
	End Sub

	Public Function SetTitle(ItemTitle)
		Items(CurrentItem, 0) = ItemTitle
	End Function

	Public Function SetLink(ItemLink)
		Items(CurrentItem, 1) = ItemLink
	End Function

	Public Function SetDesc(ItemDesc)
		Items(CurrentItem, 2) = ItemDesc
	End Function
	
	Public Function SetPubDate(ItemDate)
		Items(CurrentItem, 3) = ItemDate
	End Function
	
	Public Function SetAuthor(ItemAuthor)
		Items(CurrentItem, 4) = ItemAuthor
	End Function
	
	Public Function SetGuid(ItemGUID)
		Items(CurrentItem, 5) = ItemGUID
	End Function
	
	Public Function setComments(ItemComments)
		if not isLeeg(ItemComments) then Items(CurrentItem, 6) = ItemComments
	End Function
	
	Public Function AddNew
		CurrentItem = CurrentItem + 1
	End Function

	Public Function GetRSS
		set myXML = new aspXML
			myXML.OpenTag("rss")
			myXML.AddAttribute "version", "2.0"
			myXML.OpenTag("channel")
				myXML.QuickTag "title", ChannelTitle
				myXML.QuickTag "link", ChannelURL
				myXML.QuickTag "description", ChannelDesc
				myXML.QuickTag "language", ChannelLanguage
	
			if ImageURL <> "" then
				myXML.OpenTag("image")
					myXML.QuickTag "title", ImageTitle
					myXML.QuickTag "link", ImageLink
					myXML.QuickTag "url", ImageURL
				myXML.CloseTag
			end if
			
			dim i, ItemTitle, ItemLink, ItemDesc, ItemPubDate, ItemAuthor, ItemGUID,ItemComments
			for i = 0 to CurrentItem
				ItemTitle		= Items(i, 0)
				ItemLink		= Items(i, 1)
				ItemDesc		= Items(i, 2)
				ItemPubDate		= Items(i, 3)
				ItemAuthor		= Items(i, 4)
				ItemGUID		= Items(i, 5)
				ItemComments	= Items(i, 6)
				

				myXML.OpenTag "item"
					myXML.OpenTag "title"
						myXML.AddData ItemTitle
					myXML.CloseTag
					myXML.OpenTag "link"
						myXML.AddData ItemLink
					myXML.CloseTag
					myXML.OpenTag "pubDate"
						myXML.AddData ItemPubDate
					myXML.CloseTag
					myXML.OpenTag "author"
						myXML.AddData ItemAuthor
					myXML.CloseTag
					myXML.OpenTag "guid"
						myXML.AddData ItemGUID
					myXML.CloseTag
					
					if not isLeeg(ItemComments) then 
						myXML.OpenTag "comments"
							myXML.AddData ItemComments
						myXML.CloseTag
					end if
									
					if ItemDesc <> "" then
						myXML.OpenTag "description"
							myXML.AddData ItemDesc
						myXML.CloseTag
					end if
				
				myXML.CloseTag
				
			next

			if TextInputTitle <> "" then
				myXML.OpenTag "textinput"
					myXML.QuickTag "title", TextInputTitle
					myXML.QuickTag "description", TextInputDesc
					myXML.QuickTag "name", TextInputName
					myXML.QuickTag "link",  TextInputURL
				myXML.CloseTag
			end if

			myXML.CloseAllTags
			GetRSS = myXML.GetXML
			
		Set myXML = nothing
		
	end function

	
end class


' ---------------------------------------------------
'                    aspXML v1.0
' ---------------------------------------------------
' Author: Rami Kattan
' Web Site: http://www.kattanweb.com/webdev
' Email:  aspXML@kattanweb.8k.com
' Date:   July 3, 2002
'
' This class with make easy the construction of XML
' files using simple ASP, without any components.
'
' Features:
'  - Keep track of opened tags, and closing will close
'    last open one.
'  - Can open tags with attributes passed as string
'  - Automatic format for tag names with special characters.
'  - Automatic check if data inside the tag need CData or no.
'  - Can add Date using XSL date format.
' ---------------------------------------------------

class aspXML
	Private top
	Private TagArray()
	Private XML

    '>>>>>>>> Setup Initialize event, called automtially when creating an instant of this class using
	'	      Set MyXML = new aspXML
	Private Sub Class_Initialize
		Redim TagArray(10)
		top = -1
		XML = "<?xml version=""1.0"" encoding=" & """" & QS_CHARSET & """" & "?>" & vbCrLf
	End Sub

    '>>>>>>>> Setup Terminate event, called automtially when killing an instant of this class using
	'	      Set MyXML = nothing
	Private Sub Class_Terminate
		top = null
		XML = null
		Erase TagArray
	End Sub
	
    '>>>>>>>> Reset the class, as if it was just created, Use with care
	Public Function Reset
		call Class_Terminate
		call Class_Initialize
	End Function

    '>>>>>>>> Open a new element tag
	Public Function OpenTag(tagName)
		tagName = tagName
		top = top + 1
		if top > ubound(TagArray) then
			ReDim Preserve TagArray(ubound(TagArray) + 10)
		end if
		TagArray(top) = tagName
		XML = XML & "<" & tagName & ">"
		if top = 0 then	XML = XML & vbCrLf 'Code format, root tag is on separate line
	end function

    '>>>>>>>> Opens a new tag, add the data, and close the tag
	Public Function QuickTag(tagName, Data)
		tagName = tagName
		XML = XML & "<" & tagName & ">" & CheckString(Data) & "</" & tagName & ">" & vbCrLf
	end function

    '>>>>>>>> Add an attribute to the last open tag (can be used before or after adding data)
	Public Function AddAttribute(attribName, attribValue)
		dim lastTag, TextRemoved
		lastTag = inStrRev(XML, ">")
		TextRemoved = Right(XML, len(XML) - lastTag)
		XML = Left(XML, lastTag - 1)
		XML = XML & " " & attribName & "=""" & attribValue & """>"
		XML = XML & TextRemoved
	End function

    '>>>>>>>> Add data to current open tag (automatic check if need CDATA or no)
	Public Function AddData(Data)
		XML = XML & CheckString(Data)
	end function

    '>>>>>>>> Add Comment in the current location
	Public Function AddComment(Data)
		XML = XML & "<!--" & Data & "-->"
	end function

	'>>>>>>>> Close last open tag
	Public Function CloseTag()
		dim tagName
		tagName = TagArray(top)
		XML = XML & "</" & tagName & ">" & vbCrLf
		top = top - 1
	end function

    '>>>>>>>> Close all open tags, including main root tag
	'after calling this function, it is not recomended opening new
	'tags as XML can only have 1 root element
	Public Function CloseAllTags()
		dim tagName
		while (top >= 0)
			tagName = TagArray(top)
			XML = XML & "</" & tagName & ">" & vbCrLf
			top = top - 1
		wend
	end function

    '>>>>>>>> Returns the XML final code
	Public Function GetXML()
		GetXML = XML
	end function

'---------------------------------------------------------------
' Special internal functions
'---------------------------------------------------------------

    '>>>>>>>> Format the data with or without CData
	Private function CheckString(data)
		dim need
		need = false
		if instr(data, "<") then need = true
		if instr(data, "&") then need = true
		if need then
			CheckString = "<![CDATA[" & data & "]]>"
		else
			CheckString = data
		end if
	end function

end class
%>