vb XML Sitemap

<%@ Language=VBScript %>
<%
    Option Explicit
    
    Response.ContentType = "text/xml"

	Set m_objPost = New Post
	
	'header
	m_XML = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
	m_XML = m_XML & "<urlset xmlns=""http://www.sitemaps.org/schemas/sitemap/0.9"">" & vbCrLf

	Response.Write(m_XML)
	m_XML = ""
	
	'items
	Set m_objRS = Server.CreateObject("ADODB.RecordSet")
	m_strSQL = "Execute Feed_Sitemap"
	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("loc").Value, "output")

			m_XML = m_XML & "<url>" & vbCrLf
			m_XML = m_XML & "<loc>" & m_URL & "</loc>" & vbCrLf
			m_XML = m_XML & "<lastmod>" & m_objRS.Fields("lastmod").Value & "</lastmod>" & vbCrLf
			m_XML = m_XML & "<changefreq>" & m_objRS.Fields("changefreq").Value & "</changefreq>" & vbCrLf
			m_XML = m_XML & "<priority>" & IIf((m_objRS.Fields("priority").Value = "1"),"1.0","0.5") & "</priority>" & vbCrLf
			m_XML = m_XML & "</url>" & 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 = "</urlset>" & vbCrLf
	Response.Write(m_XML)
	m_XML = ""

	Set m_objPost = Nothing
%>
Generate an XML Sitemap - as used on slickcms

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

There are 0 comments

Leave a comment of your own

Comments are currently closed.