dv_rss.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

<!--#include file="Conn.asp"-->
<!-- #include file="inc/const.asp" -->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/dv_ubbcode.asp"-->
<!--#include file="inc/ubblist.asp"-->
<%
Dim XmlDom,Root,Dv_ubb
Dim PageUrl,Forum_url,VisitType
Dim TotalUseTable,Announceid,UserName,PostBuyUser,ReplyID_a,RootID_a,AnnounceID_a,EmotPath
VisitType = Lcase(Request("s"))
Forum_url = Dvbbs.Get_ScriptNameUrl()
'文档浏览地址：
If VisitType = "" Then
	VisitType = "xhtml"
End If
PageUrl = Forum_url & "dv_rss.asp?s="&VisitType
Page_Main()
Page_End()

Sub Page_Main()
	Call CreatRssXml()
	If Dvbbs.Boardid>0 Then
		Root.setAttribute "boardtype",Dvbbs.BoardType
	End If
	Root.setAttribute "visittype",VisitType
	Root.setAttribute "isapiwrite",IsUrlreWrite
	Root.setAttribute "forum_url",Forum_url
	Root.setAttribute "boardid",Dvbbs.Boardid
	Root.setAttribute "pageurl",PageUrl
	Root.setAttribute "sqlquerynum",Dvbbs.SqlQueryNum
	Root.setAttribute "runtime",FormatNumber((Timer()-Startime),5)
	Select Case Lcase(Request("s"))
		Case "xml"
			ShowXML "xml"
		Case "xhtml"
			TransNode XmlDom
		Case "xslt"
			ShowXML "xslt"
		Case Else
			TransNode XmlDom
	End Select
End Sub

Sub Page_End()
	Set XmlDom = Nothing
	Set Dvbbs = Nothing
End Sub

'创建XML文档
Sub CreatRssXml()
	Dim TopicID,PostID
	TopicID = Dvbbs.CheckNumeric(Request.QueryString("id")) 
	PostID = Dvbbs.CheckNumeric(Request.QueryString("replyid"))
	Set XmlDom = Server.CreateObject("Msxml2.FreeThreadedDOMDocument")
	XmlDom.appendChild(XmlDom.createElement("rss"))
	XmlDom.documentElement.setAttribute "version","2.0"
	Set Root = XmlDom.documentElement.appendChild(XmlDom.createNode(1,"channel",""))
	Call CreatHead()
	'分类信息显示
	If Dvbbs.Boardid>0 Then
		'主题ID>0时读取该帖子
		If TopicID>0 Then
			UserFlashGet = 0
			Set Dv_ubb = new Dvbbs_UbbCode
				Dv_ubb.PostType = 1
				PostList(TopicID)
			Set Dv_ubb = Nothing
		Else
			TopicList()
		End If
	Else
		Call BoardList()
	End If
End Sub

Sub ShowXML(Stype)
	Response.Clear
	Response.CharSet="gb2312"  '数据集
	Response.ContentType="text/xml"  '数据流格式定义
	Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
	If Stype = "xslt" Then
		Response.Write "<?xml-stylesheet type=""text/xsl"" href=""inc/Templates/sitemap.xslt"" ?>"&vbNewLine
	End If
	Response.Write XmlDom.xml
End Sub

Sub TransNode(XmlDoc)
	'XSLT模板转换开始
	Dim Xmlskin,Proc,XmlStyle
	Set Xmlskin = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
	If Not (Xmlskin.load(Server.MapPath("inc/Templates/sitemap.xslt"))) Then
		Response.Write "模板数据出错，请与管理员联系！"
		Response.End
	End If
	Set XMLStyle=Server.CreateObject("msxml2.XSLTemplate" & MsxmlVersion)
	XMLStyle.stylesheet=Xmlskin
	Set Proc=XMLStyle.createProcessor()
	Proc.input = XmlDoc
  	proc.transform()
  	Response.Write proc.output
	Set XmlStyle = Nothing
	Set Xmlskin = Nothing
End Sub

'--------------------------------------------------------------------
'文档内容数据
'--------------------------------------------------------------------

'创建文档信息
Sub CreatHead()
	Dim Node,RssTitle
	RssTitle = "Rss & SiteMap"
	Root.appendChild(XmlDom.createNode(1,"title","")).text = Dvbbs.Forum_Info(0)
	Root.appendChild(XmlDom.createNode(1,"link","")).text = Dvbbs.Forum_info(1)
	Root.appendChild(XmlDom.createNode(1,"description","")).text = Dvbbs.Forum_Info(10)
	Root.appendChild(XmlDom.createNode(1,"language","")).text = "zh-cn"
	Root.appendChild(XmlDom.createNode(1,"copyright","")).text = Dvbbs.Forum_Copyright
	Root.appendChild(XmlDom.createNode(1,"generator","")).text = "Rss Generator By Dvbbs.Net"
	Root.appendChild(XmlDom.createNode(1,"webMaster","")).text = Dvbbs.Forum_info(5)

	Root.appendChild(XmlDom.createNode(1,"powered","")).text = "Powered By <a href = ""http://www.dvbbs.net/"" target = ""_blank"">Dvbbs</a>  <a href = ""http://www.dvbbs.net/download.asp"" target = ""_blank"">Version " & fVersion & "</a>"
	'Root.appendChild(XmlDom.createNode(1,"copyright","")).text = Dvbbs.Forum_Copyright

	Set Node = Root.appendChild(XmlDom.createNode(1,"image",""))
	Node.appendChild(XmlDom.createNode(1,"url","")).text = Dvbbs.Forum_Info(6)
	Node.appendChild(XmlDom.createNode(1,"title","")).text = Dvbbs.Forum_Info(0)
End Sub

'版面列表
Sub BoardList()
	Dim BoardNodes,ChildNode
	Dim Node
	Set BoardNodes = Application(Dvbbs.CacheName&"_boardlist").documentElement.childNodes
	For Each ChildNode in BoardNodes
		If Not (ChildNode.getAttribute("hidden")="1" and Dvbbs.GroupSetting(37)="0") Then
			Set Node = Root.appendChild(XmlDom.createNode(1,"item",""))
			Node.setAttribute "type","board"
			Node.setAttribute "depth",ChildNode.getAttribute("depth")
			Node.setAttribute "bid",ChildNode.getAttribute("boardid")
			Node.setAttribute "child",ChildNode.getAttribute("child")
			Node.appendChild(XmlDom.createNode(1,"title","")).text = ChildNode.getAttribute("boardtype")
			Node.appendChild(XmlDom.createNode(1,"author","")).text = ""
			Node.appendChild(XmlDom.createNode(1,"pubDate","")).text = Now()
			Node.appendChild(XmlDom.createNode(1,"description","")).text = ChildNode.getAttribute("readme")
			If IsUrlreWrite = 1 Then
				Node.appendChild(XmlDom.createNode(1,"link","")).text = Forum_url&"dv_rss_"&VisitType&"_"&ChildNode.getAttribute("boardid")&".html"
				Node.appendChild(XmlDom.createNode(1,"bbslink","")).text = Forum_url & "index_"&ChildNode.getAttribute("boardid")&".html"
			Else
				Node.appendChild(XmlDom.createNode(1,"link","")).text = PageUrl&"&boardid="&ChildNode.getAttribute("boardid")
				Node.appendChild(XmlDom.createNode(1,"bbslink","")).text = Forum_url & "index.asp?boardid="&ChildNode.getAttribute("boardid")
			End If
		End If
	Next
End Sub

'主题列表
Sub TopicList()
	Dim Sql,Rs,Cmd,Page,TopicMode,Count,PageCount,PageSize
	Dim Posttime
	Dim Topidlist,Node,ChildNode
	'参数处理
	Page = Dvbbs.CheckNumeric(Request("Page"))	'分页
	TopicMode = Dvbbs.CheckNumeric(Request("topicmode")) '专题
	Count = Dvbbs.CheckNumeric(Request("Count"))
	PageSize = Dvbbs.CheckNumeric(Dvbbs.Board_Setting(26))
	If Page<1 Then Page = 1
	If Count = 0 Then
		Count = Dvbbs.Execute("Select Count(topicid) From Dv_Topic Where BoardID="&Dvbbs.BoardID&"")(0)
	End If
	If Count Mod PageSize = 0 Then
		PageCount = Count \ PageSize
	Else
		PageCount = Count \ PageSize + 1
	End If
	If Page>PageCount Then Page = PageCount

	If Not IsObject(Conn) Then ConnectionDatabase
	If IsSqlDataBase=1 And IsBuss=1 Then
		Set Cmd = Server.CreateObject("ADODB.Command")
		Set Cmd.ActiveConnection=conn
		Cmd.CommandText="dv_list"
		Cmd.CommandType=4
		Cmd.Parameters.Append cmd.CreateParameter("@boardid",3)
		Cmd.Parameters.Append cmd.CreateParameter("@pagenow",3)
		Cmd.Parameters.Append cmd.CreateParameter("@pagesize",3)
		Cmd.Parameters.Append cmd.CreateParameter("@tl",3)
		Cmd.Parameters.Append cmd.CreateParameter("@topicmode",3)
		Cmd.Parameters.Append cmd.CreateParameter("@totalrec",3,2)
		Cmd("@boardid")=Dvbbs.BoardID
		Cmd("@pagenow")=page
		Cmd("@pagesize")=PageSize
		Cmd("@topicmode")=TopicMode
		Cmd("@tl")=0
		Set Rs=Cmd.Execute
		If Not Rs.EoF Then
			Sql = Rs.GetRows(PageSize)
			Set Topidlist=Dvbbs.ArrayToxml(sql,rs,"item","topic")
		Else
			Set Topidlist=Nothing
		End If
	Else
		Set Rs = Server.CreateObject ("adodb.recordset")
		If Cint(TopicMode)=0 Then
			Sql="Select  TopicID,boardid,title,postusername,postuserid,dateandtime,child,hits,votetotal,lastpost,lastposttime,istop,isvote,isbest,locktopic,Expression,TopicMode,Mode,GetMoney,GetMoneyType,UseTools,IsSmsTopic,hidename From Dv_Topic Where BoardID="&Dvbbs.BoardID&" Order By LastPostTime Desc"
		Else
			Sql="Select  TopicID,boardid,title,postusername,postuserid,dateandtime,child,hits,votetotal,lastpost,lastposttime,istop,isvote,isbest,locktopic,Expression,TopicMode,Mode,GetMoney,GetMoneyType,UseTools,IsSmsTopic,hidename From Dv_Topic Where Mode="&TopicMode&" and BoardID="&Dvbbs.BoardID&" Order By LastPostTime Desc"
		End If
		Rs.Open Sql,Conn,1,1
		If Page >1 Then
			Rs.Move (page-1) * PageSize
		End If
		If Not Rs.EoF Then
			Sql = Rs.GetRows(PageSize)
			Set Topidlist=Dvbbs.ArrayToxml(sql,rs,"item","topic")
		Else
			Set Topidlist=Nothing
		End If
	End If
	Rs.Close
	Set Rs = Nothing
	Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 1
	Sql = Empty
	If Not Topidlist Is Nothing Then 
		For Each ChildNode in Topidlist.documentElement.SelectNodes("item")
			'数据信息调整
			If Dvbbs.Board_Setting(60)<>"" And Dvbbs.Board_Setting(60)<>"0" Then
				Posttime = ChildNode.getAttribute("lastposttime")
				If Not IsDate(Posttime) Then
					Posttime = Now()
				Else
					Posttime = CDate(Posttime)
				End If
				If DateDiff("n",Posttime,Now)+Cint(Dvbbs.Forum_Setting(0)) < CLng(Dvbbs.Board_Setting(61)) Then
					ChildNode.setAttribute "lastposttime",DateDiff("n",Posttime,Now)+Cint(Dvbbs.Forum_Setting(0))
				End If
			End If
			'建立item节点信息
			'Set Node = Root.appendChild(XmlDom.createNode(1,"item",""))
			ChildNode.setAttribute "type","topic"
			ChildNode.appendChild(XmlDom.createNode(1,"title","")).text = Dvbbs.ChkBadWords(ChildNode.getAttribute("title"))
			ChildNode.appendChild(XmlDom.createNode(1,"author","")).text = Dvbbs.ChkBadWords(ChildNode.getAttribute("postusername"))
			ChildNode.appendChild(XmlDom.createNode(1,"pubDate","")).text = ChildNode.getAttribute("lastposttime")
			ChildNode.appendChild(XmlDom.createNode(1,"description","")).text = ""
			'ChildNode.appendChild(XmlDom.createNode(1,"link","")).text = PageUrl&"&boardid="&Dvbbs.Boardid&"&id="&ChildNode.getAttribute("topicid")&"&page="&Page

			If IsUrlreWrite = 1 Then
				ChildNode.appendChild(XmlDom.createNode(1,"link","")).text = Forum_url&"dv_rss_"&VisitType&"_"&Dvbbs.Boardid&"_"&ChildNode.getAttribute("topicid")&"_"&Page&".html"

				ChildNode.appendChild(XmlDom.createNode(1,"bbslink","")).text = Forum_url & "dispbbs_"&ChildNode.getAttribute("boardid")&"_"&ChildNode.getAttribute("topicid")&"_"&Page&".html"
			Else
				ChildNode.appendChild(XmlDom.createNode(1,"link","")).text = PageUrl&"&boardid="&Dvbbs.Boardid&"&id="&ChildNode.getAttribute("topicid")&"&page="&Page
				ChildNode.appendChild(XmlDom.createNode(1,"bbslink","")).text = Forum_url & "dispbbs.asp?boardid="&ChildNode.getAttribute("boardid")&"&id="&ChildNode.getAttribute("topicid")&"page="&page
			End If

			'清理不需要的属性
			ChildNode.removeAttribute "dateandtime"