%
Dim RssDataMode,rsbody
RssDataMode = "0"'0为不取帖子内容,1为取帖子内容,取帖子内容较为消耗资源
'用参数控制
Dim XMLDOM,node,Cnode,Cnode1,msginfo
Set XMLDOM=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument")
XMLDOM.appendChild(XMLDOM.createElement("rss"))
XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"version","")).text="2.0"
Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"channel",""))
RssDataMode=Request("RssDataMode")
If RssDataMode="" Then RssDataMode="0"
Dim dv_ubb,replyid_a
Dim EmotPath,board_Setting
If RssDataMode<>"0" Then
Dvbbs.LoadTemplates("")
Set dv_ubb=new Dvbbs_UbbCode
dv_ubb.posttype=1
EmotPath=Dvbbs.Get_ScriptNameUrl & Split(Dvbbs.Forum_emot,"|||")(0)
End If
Dim Rs,Sql,i,RssTitle,RssID
Dim RssHomePageUrl
RssHomePageUrl = Dvbbs.Get_ScriptNameUrl
RssID = Request("RssID")
If RssID="" Or Not IsNumeric(RssID) Then RssID = 0
RssID = Clng(RssID)
Sql = "Select Top 20 TopicID,Title,PostUserName,PostUserID,DateAndTime,BoardID,PostTable,GetMoneyType,HideName "
Select Case RssID
Case 1
RssTitle = "最新20篇论坛主题"
Sql = Sql & " From Dv_Topic Where Boardid <> 444 and BoardID <> 777 Order By DateAndTime Desc"
Case 2
RssTitle = "最新20篇论坛精华"
If Dvbbs.BoardID=0 Then
Sql = Sql & " From Dv_Topic Where IsBest=1 And Boardid <> 444 and BoardID <> 777 Order By DateAndTime Desc"
Else
Sql = Sql & " From Dv_Topic Where BoardID="&Dvbbs.BoardID&" and IsBest=1 And Boardid <> 444 and BoardID <> 777 Order By DateAndTime Desc"
End If
Case 3
RssTitle = "今日热门主题"
If IsSqlDataBase = 1 Then
Sql = Sql & " From Dv_Topic Where DateDiff(d,DateAndTime,"&SqlNowString&")=0 and Boardid <> 444 and BoardID <> 777 Order By Hits Desc"
Else
Sql = Sql & " From Dv_Topic Where DateDiff('d',DateAndTime,"&SqlNowString&")=0 And Boardid <> 444 and BoardID <> 777 Order By Hits Desc"
End If
Case 4
If Dvbbs.BoardID = 0 Then
RssTitle = "最新20篇论坛主题"
Sql = Sql & " From Dv_Topic where Boardid <> 444 and BoardID <> 777 Order By DateAndTime Desc"
Else
RssTitle = Dvbbs.BoardType & "最新20篇论坛主题"
Sql = Sql & " From Dv_Topic Where BoardID="&Dvbbs.BoardID&" Order By DateAndTime Desc"
End If
Case 5
RssTitle = "最新20篇论坛精华"
If Dvbbs.BoardID=0 Then
Sql = Sql & " From Dv_Topic Where IsBest=1 And Boardid <> 444 and BoardID <> 777 Order By DateAndTime Desc"
Else
Sql = Sql & " From Dv_Topic Where BoardID="&Dvbbs.BoardID&" and IsBest=1 And Boardid <> 444 and BoardID <> 777 Order By DateAndTime Desc"
End If
Case 6
If Dvbbs.BoardID = 0 Then
RssTitle = "今日热门主题"
If IsSqlDataBase = 1 Then
Sql = Sql & " From Dv_Topic Where DateDiff(d,DateAndTime,"&SqlNowString&")=0 and Boardid <> 444 and BoardID <> 777 Order By Hits Desc"
Else
Sql = Sql & " From Dv_Topic Where DateDiff('d',DateAndTime,"&SqlNowString&")=0 and Boardid <> 444 and BoardID <> 777 Order By Hits Desc"
End If
Else
RssTitle = Dvbbs.BoardType & "今日热门主题"
If IsSqlDataBase = 1 Then
Sql = Sql & " From Dv_Topic Where BoardID="&Dvbbs.BoardID&" And DateDiff(d,DateAndTime,"&SqlNowString&")=0 and Boardid <> 444 and BoardID <> 777 Order By Hits Desc"
Else
Sql = Sql & " From Dv_Topic Where BoardID="&Dvbbs.BoardID&" And DateDiff('d',DateAndTime,"&SqlNowString&")=0 and Boardid <> 444 and BoardID <> 777 Order By Hits Desc"
End If
End If
Case 7
If Dvbbs.UserID = 0 Then
RssTitle = "错误信息"
Else
RssTitle = "收取论坛短信"
End If
Case 8
Case 9
Case Else
RssTitle = "获取频道列表"
End Select
If RssDataMode<>"0" Then RssTitle =RssTitle &"-全文"
node.appendChild(XMLDOM.createNode(1,"title","")).text=Dvbbs.Forum_Info(0)&"--"&RssTitle
node.appendChild(XMLDOM.createNode(1,"link","")).text=Dvbbs.Forum_info(1)
node.appendChild(XMLDOM.createNode(1,"language","")).text="zh-cn"
node.appendChild(XMLDOM.createNode(1,"description","")).text=Dvbbs.Forum_Info(0)
node.appendChild(XMLDOM.createNode(1,"copyright","")).text=Dvbbs.Forum_info(3)
node.appendChild(XMLDOM.createNode(1,"generator","")).text="Rss Generator By Dvbbs.Net"
node.appendChild(XMLDOM.createNode(1,"webMaster","")).text=Dvbbs.Forum_info(5)
Set Cnode = node.appendChild(XMLDOM.createNode(1,"image",""))
Cnode.appendChild(XMLDOM.createNode(1,"url","")).text = Dvbbs.Forum_Info(6)
Cnode.appendChild(XMLDOM.createNode(1,"title","")).text = Dvbbs.Forum_Info(0)
Select Case RssID
Case 0
Set Cnode=node.appendChild(XMLDOM.createNode(1,"item",""))
Cnode.appendChild(XMLDOM.createNode(1,"title","")).text=Dvbbs.Forum_Info(0)&"--频道列表"
Cnode.appendChild(XMLDOM.createNode(1,"link","")).text=Dvbbs.Forum_info(1)
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text=Dvbbs.Forum_info(0)
Cnode.appendChild(XMLDOM.createNode(1,"pubDate","")).text=Now()
Set Cnode1=Cnode.appendChild(XMLDOM.createNode(1,"description",""))
msginfo= "最新20篇论坛主题:"&RssHomePageUrl&"RssFeed.asp?RssID=1"
msginfo=msginfo& "
"
msginfo=msginfo& "最新20篇论坛主题-全文:"&RssHomePageUrl&"RssFeed.asp?RssID=1&RssDataMode=1"
msginfo=msginfo& "
"
msginfo=msginfo& "最新20篇论坛精华:"&RssHomePageUrl&"RssFeed.asp?RssID=2"
msginfo=msginfo& "
"
msginfo=msginfo& "最新20篇论坛精华-全文:"&RssHomePageUrl&"RssFeed.asp?RssID=2&RssDataMode=1"
msginfo=msginfo& "
"
msginfo=msginfo& "今日热门主题:"&RssHomePageUrl&"RssFeed.asp?RssID=3"
msginfo=msginfo& "
"
msginfo=msginfo& "今日热门主题-全文:"&RssHomePageUrl&"RssFeed.asp?RssID=3&RssDataMode=1"
msginfo=msginfo& "
"
msginfo=msginfo& "版面信息订阅,点击相关字样查看连接:"
msginfo=msginfo& "
"
Dim bnode
For each bnode in Application(Dvbbs.CacheName&"_boardlist").documentElement.selectNodes("board")
msginfo=msginfo& BNode.attributes.getNamedItem("boardtype").text & "的 最新主题、今日热门、最新精华"
msginfo=msginfo& "
"
msginfo=msginfo& BNode.attributes.getNamedItem("boardtype").text & "的 最新主题-全文、今日热门-全文、最新精华-全文"
msginfo=msginfo& "
"
Next
msginfo=msginfo& "收取论坛短信:"&RssHomePageUrl&"RssFeed.asp?RssID=7"
msginfo=msginfo& "
"
Cnode1.appendChild(XMLDOM.createCDATASection(replace(msginfo,"]]>","]]>")))
Case 7
Case Else
Set Rs=Dvbbs.Execute(Sql)
If Rs.Eof And Rs.Bof Then
Set Cnode=node.appendChild(XMLDOM.createNode(1,"item",""))
Cnode.appendChild(XMLDOM.createNode(1,"title","")).text="今日没有更新信息"
Cnode.appendChild(XMLDOM.createNode(1,"link","")).text=Dvbbs.Forum_info(1)
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text=Dvbbs.Forum_info(0)
Cnode.appendChild(XMLDOM.createNode(1,"pubDate","")).text=Now()
Set Cnode1=Cnode.appendChild(XMLDOM.createNode(1,"description",""))
msginfo= "今日没有更新信息!"
Cnode1.appendChild(XMLDOM.createCDATASection(replace(msginfo,"]]>","]]>")))
Else
Do While Not Rs.Eof
Set Cnode=node.appendChild(XMLDOM.createNode(1,"item",""))
Cnode.appendChild(XMLDOM.createNode(1,"title","")).text=Rs(1)&""
If RssID = 5 Then
Cnode.appendChild(XMLDOM.createNode(1,"link","")).text=RssHomePageUrl&"dispbbs.asp?BoardID="&Rs(5)&"&ID="&Rs(0)&"&Page=1&replyID="&Rs(6)&"&skin=1"
Else
Cnode.appendChild(XMLDOM.createNode(1,"link","")).text=RssHomePageUrl&"dispbbs.asp?BoardID="&Rs(5)&"&ID="&Rs(0)&"&Page=1"
End If
If Dvbbs.Boardid <>0 Then
If Rs(8)=1 And Dvbbs.Board_Setting(68)="1" And Not Dvbbs.Boardmaster Then
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text="匿名用户"
Else
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text=Rs(2)&""
End If
Else
If Rs(8)=1 and Not(Dvbbs.Master Or Dvbbs.Superboardmaster) Then
If Board_Setting68(Rs(5))=1 Then
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text="匿名用户"
Else
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text=Rs(2)&""
End If
Else
Cnode.appendChild(XMLDOM.createNode(1,"author","")).text=Rs(2)&""
End If
End If
Cnode.appendChild(XMLDOM.createNode(1,"pubDate","")).text=Rs(4)&""
Set Cnode1=Cnode.appendChild(XMLDOM.createNode(1,"description",""))
If RssDataMode="0" Then
msginfo= "要浏览本条信息请点击标题。"
Else
If Rs("GetMoneyType")=3 Then
msginfo = "本贴子内容经过特殊加密,请到论坛直接查看"
Else
Set rsbody=Dvbbs.Execute("Select top 1 t.body,t.ubblist,u.LockUser,U.UserGroupID,t.isbest,t.BoardID From "&Rs("posttable")&" t Inner Join [dv_user] U On T.postuserid=u.userid Where RootID="&Rs(0)&" And t.BoardID<>444 and t.BoardID <>777 Order by AnnounceID asc")
If RsBody.EOF Then
msginfo = "数据错误或丢失。"
Else
If Dvbbs.BoardID<>0 Then
If Rsbody(2)=0 Then
If Rsbody(4)=0 Or Dvbbs.GroupSetting(41)="1" Then
Ubblists=RSbody(1)&""
msginfo= dv_ubb.Dv_UbbCode(Rsbody(0),Rsbody(3),2,0)
Else
msginfo = "精华贴内容需要有权限才可以浏览"
End If
Else
msginfo = "此用户已经被锁定,或屏蔽,不显示发言内容"
End If
Else
If GetSetting(Rsbody(5)) Then
If Rsbody(2)=0 Then
If Rsbody(4)=0 Or Dvbbs.GroupSetting(41)="1" Then
Ubblists=RSbody(1)&""
msginfo = dv_ubb.Dv_UbbCode(Rsbody(0),Rsbody(3),2,0)
Else
msginfo = "精华贴内容需要有权限才可以浏览"
End If
Else
msginfo = "此用户已经被锁定,或屏蔽,不显示发言内容"
End If
Else
msginfo = "您没有查看内容的权限。"
End If
End If
End If
End If
End If
Cnode1.appendChild(XMLDOM.createCDATASection(replace(msginfo,"]]>","]]>")))
Rs.MoveNext
Loop
End If
Rs.Close
Set Rs=Nothing
End Select
Dvbbs.PageEnd()
Function Board_Setting68(bid)
Dim board_Setting
board_Setting = Split(Application(CacheName &"_boarddata_" & bid).documentElement.selectSingleNode("boarddata/@board_setting").text,",")
Board_Setting68=board_Setting(68)
End Function
Sub TransNode(XmlDoc)
'XSLT模板转换开始
Dim Xmlskin,Proc,XmlStyle
Set Xmlskin = Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
If Not (Xmlskin.load(Server.MapPath("inc/Templates/rss.xslt"))) Then
Response.Write "模板数据出错,请与管理员联系!"
Response.End
End If
Set XMLStyle=Dvbbs.iCreateObject("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 ShowXML()
Response.Clear
Response.CharSet="gb2312" '数据集
Response.ContentType="text/xml" '数据流格式定义
Response.Write ""&vbNewLine
Response.Write ""&vbNewLine
Response.Write XMLDOM.xml
Set XMLDOM=Nothing
End Sub
Sub ShowHtml()
Response.Clear
Response.CharSet="gb2312" '数据集
TransNode(XMLDOM)
Set XMLDOM=Nothing
End Sub
If RssDataMode<>"0" Then
Set dv_ubb=Nothing
End If
If Request.QueryString("html")="1" Then
ShowHtml()
Else
ShowXML()
End If
Function GetSetting(BoardID)
GetSetting=True
Dim Node
Dim Rs,IsGroupSetting
If Not IsObject(Application(dvbbs.CacheName &"_boarddata_" & boardid)) Then Dvbbs.LoadBoardData boardid
board_Setting=split(Application(Dvbbs.CacheName &"_boarddata_" & boardid).documentElement.selectSingleNode("boarddata/@board_setting").text,",")
IsGroupSetting=Application(Dvbbs.CacheName &"_boarddata_" & boardid).documentElement.selectSingleNode("boarddata/@isgroupsetting").text
BoardUser=split(Application(Dvbbs.CacheName &"_boarddata_" & boardid).documentElement.selectSingleNode("boarddata/@boarduser").text,",")
If IsGroupSetting<>"" Then
IsGroupSetting = "," & IsGroupSetting & ","
If InStr(IsGroupSetting,"," & Dvbbs.UserGroupID & ",")>0 Then
Set Rs=Dvbbs.Execute("Select PSetting From Dv_BoardPermission Where Boardid="&Dvbbs.Boardid&" And GroupID="&Dvbbs.UserGroupID)
If Not (Rs.Eof And Rs.Bof) Then
GroupSetting = Split(Rs(0),",")
End If
Set Rs=Nothing
End If
If Dvbbs.UserID>0 And InStr(IsGroupSetting,",0,")>0 Then
Set Rs=Dvbbs.execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid="&Dvbbs.BoardID&" And uc_UserID="&Dvbbs.Userid)
If Not(Rs.Eof And Rs.Bof) Then
Dvbbs.UserPermission=Split(Rs(0),",")
Dvbbs.GroupSetting = Split(Rs(0),",")
Dvbbs.FoundUserPer=True
End If
Set Rs=Nothing
End If
End If
If Board_Setting(1)="1" And Dvbbs.GroupSetting(37)="0" Then
GetSetting=False
Exit Function
End If
If Dvbbs.GroupSetting(0)="0" Then Dvbbs.AddErrCode(27)
'访问论坛限制(包括文章、积分、金钱、魅力、威望、精华、被删数、注册时间)
Dim BoardUserLimited
BoardUserLimited = Split(Board_Setting(54),"|")
If Ubound(BoardUserLimited)=8 Then
'文章
If Trim(BoardUserLimited(0))<>"0" And IsNumeric(BoardUserLimited(0)) Then
If Dvbbs.UserID = 0 Then
GetSetting=False
Exit Function
End If
If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text)"0" And IsNumeric(BoardUserLimited(1)) Then
If Dvbbs.UserID = 0 Then
GetSetting=False
Exit Function
End If
If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text)"0" And IsNumeric(BoardUserLimited(2)) Then
If Dvbbs.UserID = 0 Then
GetSetting=False
Exit Function
End If
If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text)"0" And IsNumeric(BoardUserLimited(3)) Then
If Dvbbs.UserID = 0 Then
GetSetting=False
Exit Function
End If
If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text)"0" And IsNumeric(BoardUserLimited(4)) Then
If Dvbbs.UserID = 0 Then
GetSetting=False
Exit Function
End If
If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text)"0" And IsNumeric(BoardUserLimited(5)) Then
If Dvbbs.UserID = 0 Then
GetSetting=False
Exit Function
End If
If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userisbest").text)"0" And IsNumeric(BoardUserLimited(6)) Then
If Dvbbs.UserID = 0 Then
GetSetting=False
Exit Function
End If
If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text)>Clng(BoardUserLimited(6)) Then
GetSetting=False
Exit Function
End If
End If
'注册时间
If Trim(BoardUserLimited(7))<>"0" And IsNumeric(BoardUserLimited(7)) Then
If Dvbbs.UserID = 0 Then
GetSetting=False
Exit Function
End If
If DateDiff("s",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@joindate").text,Now)