<% '################################################################################# '## Copyright (C) 2000-04 Michael Anderson, Pierre Gorissen, '## Huw Reddick and Richard Kinser '## '## Article body support added by Mike Belshe, 03-02-04, '## mike@lookoutsoft.com - http://www.lookoutsoft.com/ '## Same license and caveats as defined below. '## '## This program is free software; you can redistribute it and/or '## modify it under the terms of the GNU General Public License '## as published by the Free Software Foundation; either version 2 '## of the License, or any later version. '## '## All copyright notices regarding Snitz Forums 2000 '## must remain intact in the scripts and in the outputted HTML '## The "powered by" text/logo with a link back to '## http://forum.snitz.com in the footer of the pages MUST '## remain visible when the pages are viewed on the internet or intranet. '## '## This program is distributed in the hope that it will be useful, '## but WITHOUT ANY WARRANTY; without even the implied warranty of '## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the '## GNU General Public License for more details. '## '## You should have received a copy of the GNU General Public License '## along with this program; if not, write to the Free Software '## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. '## '## Support can be obtained from support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## manderson@snitz.com '## '################################################################################# %> <% Server.ScriptTimeout = 60 set my_Conn = Server.CreateObject("ADODB.Connection") 'option explicit my_Conn.Open strConnString on error goto 0 dim maxresults, Topic_ID dim showMembers showMembers = "false" ' set to true or false if you want member profiles to be shown or not shown showForums = "true" ' set to true or false if you want forum.asp pages to be shown or not shown maxresults = 50000 ' currently not implemented xml = "" xml = "" & vbNewLine 'Main forum Pages xml = xml & "" & strForumURL & "default.asp"& member8601Date(now(), 1) &"daily" xml = xml & "" & strForumURL & "policy.asp"& member8601Date(now(), 1) &"daily" xml = xml & "" & strForumURL & "active.asp"& member8601Date(now(), 1) &"daily" xml = xml & "" & strForumURL & "faq.asp"& member8601Date(now(), 1) &"daily" xml = xml & "" & strForumURL & "members.asp"& member8601Date(now(), 1) &"daily" xml = xml & "" & strForumURL & "search.asp"& member8601Date(now(), 1) &"daily" '############### Show Topics and Printer Friendly Pages ######################### strSql = "select top 500 T.TOPIC_ID, T.T_LAST_POST FROM " & strTablePrefix & "TOPICS T, " & strTablePrefix & "FORUM F WHERE T.FORUM_ID = F.FORUM_ID AND F.F_PRIVATEFORUMS = 0" strSql = strSql & " ORDER BY TOPIC_ID DESC" set rs = Server.CreateObject("ADODB.Recordset") rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText if rs.EOF then recActiveTopicsCount = "" else allActiveTopics = rs.GetRows(adGetRowsRest) recActiveTopicsCount = UBound(allActiveTopics,2) end if rs.close 'set rs = nothing fTOPIC_ID = 0 fT_LAST_POST = 1 for RowCount = 0 to recActiveTopicsCount Topic_ID = allActiveTopics(fTOPIC_ID,RowCount) Topic_Last_Post = allActiveTopics(fT_LAST_POST,RowCount) xml = xml & "" & strForumURL & "topic.asp?TOPIC_ID=" & Topic_ID & ""& ISO8601Date(Topic_Last_Post) &"daily" xml = xml & "" & strForumURL & "pop_printer_friendly.asp?TOPIC_ID=" & Topic_ID & ""& ISO8601Date(Topic_Last_Post) &"daily" xml = xml & "" & strForumURL & "topic~TOPIC_ID~" & Topic_ID & ".asp"& ISO8601Date(Topic_Last_Post) &"daily" next '################### Show Forums ################################################# if showForums = "true" then strSQL = "select FORUM_ID, F_LAST_POST from " & strTablePrefix & "forum where (F_URL is null or len(F_URL) < 7) and (F_PRIVATEFORUMS = 0) and F_STATUS = 1 order by FORUM_ID ASC" rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText if rs.EOF then recActiveTopicsCount = "" else allActiveTopics3 = rs.GetRows(adGetRowsRest) recActiveTopicsCount3 = UBound(allActiveTopics3,2) end if rs.close 'set rs = nothing fFORUM_ID = 0 fFORUM_LAST_POST = 1 for RowCount = 0 to recActiveTopicsCount3 Forum_ID = allActiveTopics3(fMEMBER_ID,RowCount) Forum_LAST_POST = allActiveTopics3(fFORUM_LAST_POST,RowCount) xml = xml & "" & strForumURL & "forum.asp?FORUM_ID=" & Forum_ID & ""& ISO8601Date(Forum_LAST_POST) &"daily" & vbNewLine next End if '################### Show Members ################################################# if showMembers = "true" then strSQL = "select MEMBER_ID from " & strMemberTablePrefix & "MEMBERS where M_STATUS = 1 order by MEMBER_ID DESC" rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText if rs.EOF then recActiveTopicsCount = "" else allActiveTopics2 = rs.GetRows(adGetRowsRest) recActiveTopicsCount2 = UBound(allActiveTopics2,2) end if rs.close fMEMBER_ID = 0 for RowCount = 0 to recActiveTopicsCount2 Member_ID = allActiveTopics2(fMEMBER_ID,RowCount) xml = xml & "" xml = xml & "" & strForumURL & "pop_profile.asp?mode=display&id=" & Member_ID & "" xml = xml & ""& member8601Date(now(), 1) &"" xml = xml & "daily" xml = xml & "" & vbNewLine next End if '################## END Show Members xml = xml & "" Response.Clear Response.Expires = 0 Response.ContentType = "text/xml" Response.AddHeader "content-type", "text/xml" 'Response.AddHeader "content-disposition","attachment; filename=sitemap.xml" Response.Write xml ' Garbage Collection set rs = nothing my_Conn.close set my_Conn = nothing set xml = nothing set recActiveTopicsCount1 = nothing set recActiveTopicsCount2 = nothing set recActiveTopicsCount3 = nothing set maxresults = nothing set Topic_ID = nothing set showMembers = nothing set showForums = nothing set strSql = nothing 'set ISO8601Date = nothing 'set member8601date = nothing set maxresults = nothing Response.End Function ISO8601Date(Date2Convert) isoYear = left(Date2Convert, 4) isoMonth = mid(Date2Convert, 5, 2) isoDay = mid(Date2Convert, 7, 2) isoHour = mid(Date2Convert, 9, 2) isoMinute = mid(Date2Convert, 11, 2) isoSecond = mid(Date2Convert, 13, 2) ISO8601Date = isoYear & "-" & isoMonth & "-" & isoDay & "T" & isoHour & ":" & isoMinute & ":" & isoSecond & "+00:00" end Function Function member8601date(dLocal,utcOffset) Dim d ' convert local time into UTC d = DateAdd("H",-1 * utcOffset,dLocal) ' compose the date member8601date = Year(d) & "-" & Right("0" & Month(d),2) & "-" & Right("0" & Day(d),2) & "T" & Right("0" & Hour(d),2) & ":" & Right("0" & Minute(d),2) & ":" & Right("0" & Second(d),2) & "+00:00" End Function %>