<%
Dim ChildTopicNum,Page,action,TopicNum,XMLDOM,XMLStyle,XSLT,ListNodeObject
Dim BoardTopic,BoardTopicImg,BoardTopicMode,BoardTopicMode_a,iii,TopicMode,SelectBoardTopic,Forum_AllTopNum
If Request("action")<>"xml" Then
Main
Else
Showxml()
End If
Sub Showxml()
Set XMLDOM=Application(Dvbbs.CacheName&"_sBoradlist").cloneNode(True)
Dim node
If Dvbbs.GroupSetting(37)="0" Then'去掉隐藏论坛
For each node in XMLDOM.documentElement.getElementsByTagName("board")
If node.attributes.getNamedItem("hidden").text="1" Then
node.parentNode.removeChild(node)
End If
Next
End If
Response.Clear
Response.CharSet="gb2312"
Response.ContentType="text/xml"
Response.Write ""&vbNewLine
Response.Write XMLDom.documentElement.XML
Set XMLDOM=Nothing
End Sub
Sub Main()
Dvbbs.LoadTemplates("index")
If Dvbbs.BoardID < 0 Then
Response.Write "参数错误"
Exit Sub
End If
Select Case Dvbbs.BoardID
Case "0"
Show_Index_Main()
Case "444"
Response.Write "参数错误"
Exit Sub
Case "777"
Response.Write "参数错误"
Exit Sub
Case Else
Chk_List_Err
If Cint(Dvbbs.Board_Setting(43))=0 Then
Dvbbs.Stats=Dvbbs.LanStr(7)
Else
Dvbbs.Stats=Dvbbs.LanStr(8)
End If
Dvbbs.Nav()
Dvbbs.ActiveOnline()
Dvbbs.Head_var 1,Dvbbs.BoardNode.attributes.getNamedItem("depth").text,"",""
ChildTopicNum = 0
GetForumTextAd(1)
'如果有下属版面，则显示Board_Data(6,0)
If Not (Dvbbs.BoardNode.selectSingleNode("board") is Nothing) Then
Show_Index_BoardList
End If
If Dvbbs.boardmaster or Dvbbs.master or Dvbbs.superboardmaster Then
action=Request("action")
ElseIf Dvbbs.GroupSetting(45)=1 Then
action=Request("action")
Else
action=""
End If
TopicMode=0
BoardTopic=Split(Dvbbs.Board_Setting(48),"$$")
BoardTopicImg=Split(Dvbbs.Board_Setting(49),"$$")
If Ubound(BoardTopic)>0 Then
If Request("topicmode")<>"" and IsNumeric(Request("topicmode")) Then TopicMode=Cint(Request("topicmode"))
For iii=0 to Ubound(BoardTopic)-1
If BoardTopicImg(iii)<>"" and Instr(BoardTopicImg(iii),".gif") Then BoardTopicMode=BoardTopicMode+""
BoardTopicMode=BoardTopicMode+"["
BoardTopicMode_a=BoardTopicMode_a+"["
If TopicMode=iii+1 Then
BoardTopicMode=BoardTopicMode+""&BoardTopic(iii)&""
BoardTopicMode_a=BoardTopicMode_a+""&BoardTopic(iii)&""
Else
BoardTopicMode=BoardTopicMode+BoardTopic(iii)
BoardTopicMode_a=BoardTopicMode_a+BoardTopic(iii)
End If
BoardTopicMode=BoardTopicMode+"]"
BoardTopicMode_a=BoardTopicMode_a+"]"
SelectBoardTopic=SelectBoardTopic+""
If iii<>(Ubound(BoardTopic)-1) Then
BoardTopicMode=BoardTopicMode+ " | "
BoardTopicMode_a=BoardTopicMode_a+ " | "
End If
Next
End If
'分版浮动广告
If Dvbbs.Forum_ads(2)="1" or Dvbbs.Forum_ads(13)="1" Then Response.Write ""
If Dvbbs.Board_Setting(43)="0" Then
Call News
Call Board_Rules
Call Board_Online
Call Show_List_Top
Show_TopicList_Top()
Else
Response.Write ""
End If
End Select
Dvbbs.Footer
End Sub
Sub Show_TopicList_Top()
Dim CMD,limitime,n
If TopicMode>0 Then
Set Rs=Dvbbs.Execute("Select count(Topicid) From Dv_topic Where Boardid="&Dvbbs.Boardid&" and mode="&TopicMode)
TopicNum=Rs(0)
Rs.close:Set Rs=Nothing
Else
TopicNum = Int(Dvbbs.BoardNode.attributes.getNamedItem("topicnum").text) - ChildTopicNum
End If
Set XMLDOM=Application(Dvbbs.CacheName&"_topiclist").cloneNode(True)
Set ListNodeObject=XMLDOM.documentElement.selectSingleNode("DvCopy/list")
Set XSLT=Application(Dvbbs.CacheName&"_listtemplate_"&Dvbbs.SkinID)
Page=Request("Page")
If isNumeric(Page) = 0 or Page="" Then Page=1
Page=Clng(Page)
If Page=1 Then
Forum_AllTopNum=Dvbbs.CacheData(28,0)
If Trim(Dvbbs.BoardNode.attributes.getNamedItem("boardtopstr").text)<>"" Then
If Trim(Forum_AllTopNum)<>"" Then
Forum_AllTopNum = Forum_AllTopNum & ("," & Dvbbs.BoardNode.attributes.getNamedItem("boardtopstr").text)
Else
Forum_AllTopNum = Dvbbs.BoardNode.attributes.getNamedItem("boardtopstr").text
End If
End If
If Trim(Forum_AllTopNum)<>"" Then
Dim Rs,SQL,i,TopicTempStr,Showtitle,postusername,UseTools
Set Rs=Dvbbs.Execute("Select TopicID,boardid,title,postusername,postuserid,dateandtime,child,hits,votetotal,lastpost,lastposttime,istop,isvote,isbest,locktopic,Expression,TopicMode,Mode,GetMoney,GetMoneyType,UseTools,IsSmsTopic from dv_topic Where istop>0 and TopicID in ("&Forum_AllTopNum&") Order By istop desc, Lastposttime Desc")
If Rs.Eof And Rs.Bof Then
Forum_AllTopNum = 0
Else
SQL=Rs.GetRows(-1)
Forum_AllTopNum = 0
TopicListToXML SQL,1
SQL=Null
End If
Rs.Close
Set Rs=Nothing
Else
Forum_AllTopNum = 0
End If
End If
If Dvbbs.BoardNode.attributes.getNamedItem("toptopiccount").text = "" Then
Dvbbs.BoardNode.attributes.getNamedItem("toptopiccount").text = Forum_AllTopNum
Dvbbs.NodeUpdate = True
Else
Forum_AllTopNum = Replace(Dvbbs.BoardNode.attributes.getNamedItem("toptopiccount").text,"_TopTopic","")
End If
If Not IsNumeric(Forum_AllTopNum) Then Forum_AllTopNum = 0
TopicNum = TopicNum - Forum_AllTopNum
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")=Cint(Dvbbs.Board_Setting(26))
Cmd("@topicmode")=TopicMode
If limitime="" Then
Cmd("@tl")=0
Else
Cmd("@tl")=limitime
End If
set Rs=Cmd.Execute
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 From Dv_Topic Where BoardID="&Dvbbs.BoardID&" And IsTop=0 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 From Dv_Topic Where BoardID="&Dvbbs.BoardID&" And IsTop=0 And Mode="&TopicMode&" Order By LastPostTime Desc"
End If
Rs.Open Sql,Conn,1,1
End If
Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 1
If Not (Rs.Eof And Rs.Bof) Then
If IsSqlDatabase = 1 And IsBuss=1 Then
SQL=Rs.GetRows(-1)
Else
If TopicNum Mod Cint(Dvbbs.Board_Setting(26))=0 Then
n = TopicNum \ Cint(Dvbbs.Board_Setting(26))
Else
n = TopicNum \ Cint(Dvbbs.Board_Setting(26))+1
End If
Rs.MoveFirst
If page > n Then page = n
If page < 1 Then page = 1
If page > 1 Then
Rs.Move (page-1) * Clng(Dvbbs.Board_Setting(26))
End if
SQL=Rs.GetRows(Dvbbs.Board_Setting(26))
End If
Set Rs=Nothing
TopicListToXML SQL,0
Else
Set Rs=Nothing
End If
XMLDOM.documentElement.selectSingleNode("settings").attributes.getNamedItem("alertcolor").text=Dvbbs.mainsetting(1)
XMLDOM.documentElement.selectSingleNode("settings").attributes.getNamedItem("timestr").text=Dvbbs.Forum_Info(9)
XMLDOM.documentElement.selectSingleNode("settings").attributes.getNamedItem("Forum_name").text=Dvbbs.Forum_Info(0)
XMLDOM.documentElement.selectSingleNode("settings").attributes.getNamedItem("ShowNewPic").text=Dvbbs.Board_Setting(60)
XMLDOM.documentElement.selectSingleNode("settings").attributes.getNamedItem("titleshowlen").text=Dvbbs.Board_Setting(25)
'插入对应风格的图片路径 by Dv.ADRX
XMLDOM.documentElement.selectSingleNode("settings").attributes.setNamedItem(XMLDOM.createNode(2,"picurl","")).text=Dvbbs.Forum_PicUrl
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("page").text=page
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("dispsize").text=Dvbbs.Board_Setting(27)
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("PageSize").text=Dvbbs.Board_Setting(26)
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("boardid").text=Dvbbs.BoardID
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("tablewidth").text=Dvbbs.mainsetting(0)
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("action").text=action
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("HotTopicChild").text=Dvbbs.Forum_Setting(44)
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("topicmode").text=TopicMode
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("topiccount").text=TopicNum
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("Forum_AllTopNum").text=Forum_AllTopNum
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("IcoLimMinute").text=Dvbbs.Board_Setting(61)
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("BoardJumpList").text="if(this.options[this.selectedIndex].value!=''){location='index.asp?boardid='+this.options[this.selectedIndex].value;}"
If action="batch" Then
XMLDOM.documentElement.selectSingleNode("info").attributes.getNamedItem("SelectBoardTopic").text=SelectBoardTopic
End If
Dim proc
Set proc = XSLT.createProcessor()
proc.input = XMLDOM
proc.transform()
Response.Write proc.output
Set XmlDom=Nothing
Set XMLStyle=Nothing
Set XSLT=Nothing
End Sub
Sub TopicListToXML(DataArray,MyIsTop)
Dim i,Node,CNode,PostTime,LastPostInfo,Expression,UseTools
For i=0 To UBound(DataArray,2)
If Ubound(Split(DataArray(9,i),"$")) = 7 Then
LastPostInfo = Split(Dvbbs.ChkBadWords(DataArray(9,i)),"$")
Else
LastPostInfo = Split(DataArray(3,i) & "$" & DataArray(0,i) & "$" & DataArray(5,i) & "$" & DataArray(3,i) & "$$" & DataArray(4,i) & "$" & DataArray(0,i) & "$" & Dvbbs.BoardID,"$")
End If
Expression = Split(DataArray(15,i) & "","|")
If Dvbbs.Board_Setting(38) = "0" Then
PostTime = Split(DataArray(9,i),"$")(2) '最后跟帖时间
Else
PostTime = DataArray(5,i) '帖子发表时间
End If
Set Cnode=ListNodeObject.cloneNode(True)
Cnode.attributes.getNamedItem("title").Text=Dvbbs.ChkBadWords(DataArray(2,i)&"")
Cnode.attributes.getNamedItem("istop").text=DataArray(11,i)
Cnode.attributes.getNamedItem("isvote").text=DataArray(12,i)
Cnode.attributes.getNamedItem("isbest").text=DataArray(13,i)
Cnode.attributes.getNamedItem("locktopic").text=DataArray(14,i)
Cnode.attributes.getNamedItem("child").text=DataArray(6,i)
Cnode.attributes.getNamedItem("hits").text=DataArray(7,i)
Cnode.attributes.getNamedItem("postusername").text=Dvbbs.ChkBadWords(DataArray(3,i))
Cnode.attributes.getNamedItem("postuserid").text=DataArray(4,i)
Cnode.attributes.getNamedItem("boardid").text=DataArray(1,i)
Cnode.attributes.getNamedItem("TopicID").text=DataArray(0,i)
Cnode.attributes.getNamedItem("IsSmsTopic").text=DataArray(21,i)
Cnode.attributes.getNamedItem("dateandtime").text=DataArray(5,i)
Cnode.attributes.getNamedItem("Expression").text=Expression(UBound(Expression))
If UBound(Expression)>0 Then
Cnode.attributes.getNamedItem("topicmagicface").text=Expression(0)
End If
Cnode.attributes.getNamedItem("Mode").text=DataArray(17,i)
Cnode.attributes.getNamedItem("votetotal").text=DataArray(8,i)
Cnode.attributes.getNamedItem("DateDiffTime").text=DateDiff("n",Posttime,Now)+Cint(Dvbbs.Forum_Setting(0))
If TopicMode>0 Then
Cnode.attributes.getNamedItem("TopicMode").text=DataArray(16,i)
Else
If DataArray(17,i) - 1 >= 0 And BoardTopicMode_a <> "" And Dvbbs.BoardID = DataArray(1,i) Then
Cnode.attributes.getNamedItem("TopicMode").text=Split(BoardTopicMode_a," | ")(DataArray(17,i)-1)
Else
'修正TopicMode为NULL值时无法显示主题 2005-3-26 Dv.Yz
If Isnull(DataArray(16,i)) Or DataArray(16,i) = "" Then DataArray(16,i) = 0
Cnode.attributes.getNamedItem("TopicMode").text = DataArray(16,i)
End If
End If
Cnode.attributes.getNamedItem("LastPostUser").text=LastPostInfo(0)
Cnode.attributes.getNamedItem("LastPostID").text=LastPostInfo(1)
Cnode.attributes.getNamedItem("LastPostTime").text=LastPostInfo(2)
Cnode.attributes.getNamedItem("LastPostBody").text=LastPostInfo(3)
Cnode.attributes.getNamedItem("LastPostPic").text=LastPostInfo(4)
Cnode.attributes.getNamedItem("LastPostUserID").text=LastPostInfo(5)
Cnode.attributes.getNamedItem("GetMoney").text=DataArray(18,i)&""
Cnode.attributes.getNamedItem("GetMoneyType").text=DataArray(19,i)&""
If Dvbbs.Forum_Setting(90)="1" Then
If DataArray(20,i) = "" or IsNull(DataArray(20,i)) Then
UseTools = "0"
Else
UseTools = Split(DataArray(20,i),",")(0)
If Not IsNumeric(UseTools) Then UseTools = 0
End If
Cnode.attributes.getNamedItem("UseTools").text=UseTools
End If
XMLDOM.documentElement.appendChild(Cnode)
'固顶帖子数量
If MyIsTop = 1 Then
If TopicMode>0 Then
If DataArray(1,i)=Dvbbs.BoardID And DataArray(17,i)=TopicMode Then Forum_AllTopNum=Forum_AllTopNum+1
Else
If DataArray(1,i)=Dvbbs.BoardID Then Forum_AllTopNum=Forum_AllTopNum+1
End If
End If
Next
Set Cnode=Nothing
End Sub
Sub Show_Index_Main()
Dim TempArray
Dvbbs.Stats=template.Strings(0)
Dvbbs.Nav()
GetForumTextAd(0)
Dvbbs.ActiveOnline()
TempArray = Split(template.html(3),"||")
Show_Index_Top
Show_Index_BoardList
If Dvbbs.Forum_setting(29)="1" Then Show_Index_BirthUser()
If Dvbbs.Forum_ads(2)="1" or Dvbbs.Forum_ads(13)="1" Then Response.Write ""
Show_Index_Footer
End Sub
Sub Show_Index_Top
Dim newsstr,TempStr,TopArray
Dvbbs.Name="news"&Dvbbs.BoardID
newsstr = Split(Dvbbs.Value,"|||")
If newsstr(1)="" Or Not IsDate(newsstr(1)) Then newsstr(1)=Now()
TempStr = template.html(0)
TopArray = Split(template.html(2),"||")
Dim tmpdata,nexhour
If Dvbbs.Forum_Setting(69)="1" Then
tmpdata=Split(Dvbbs.Forum_Setting(70),"|")
nexhour=Hour(Now())+1
nexhour=nexhour mod 24
If tmpdata(nexhour)="0" And Minute(now())>40 Then newsstr(1)=newsstr(1)&Replace(template.Strings(11),"{$LeaveTime}",(60-Minute(now())))
End If
TempStr=Replace(TempStr,"{$news}",newsstr(0))
TempStr=Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
TempStr=Replace(TempStr,"{$lastUser}",Dvbbs.CacheData(14,0))
If Dvbbs.UserID=0 Then
TempStr=Replace(TempStr,"{$myinfo}",Replace(TopArray(0),"{$forumname}",Dvbbs.Forum_Info(0)))
If Dvbbs.Forum_ChanSetting(0)="1" Then TempStr=Replace(TempStr,"{$isray}",TopArray(1))
TempStr=Replace(TempStr,"{$isray}","")
If Dvbbs.forum_setting(79)="0" Then
TempStr=Replace(TempStr,"{$getcode}","")
Else
TempStr=Replace(TempStr,"{$getcode}",template.Strings(12)&Dvbbs.GetCode())
End If
Else
TopArray = Split(Dvbbs.mainhtml(12),"||")
Dim UserMsg
If Clng(Dvbbs.SendMsgNum)>0 Then
UserMsg = TopArray(0)
If Dvbbs.Forum_Setting(10)="1" Then
UserMsg = UserMsg & TopArray(1) & TopArray(2)
Else
UserMsg = UserMsg & TopArray(2)
End If
UserMsg = Replace(UserMsg,"{$smsid}",Dvbbs.sendmsgid)
UserMsg = Replace(UserMsg,"{$sender}",Dvbbs.sendmsguser)
UserMsg = Replace(UserMsg,"{$newmsgnum}",Dvbbs.sendmsgnum)
Else
UserMsg = TopArray(3)
End If
Dim i,UserGroupList,iGroupName
If Dvbbs.UserGroupParent = 4 Then
UserMsg = UserMsg & TopArray(4)
For i = 0 To Ubound(Dvbbs.UserGroupParentID)
Dvbbs.Name = "GroupSetting_" & Dvbbs.UserGroupParentID(i)
iGroupName = Split(Dvbbs.value,"§§§")(3)
If i = 0 Then
UserGroupList = ""&iGroupName&" "
Else
UserGroupList = UserGroupList & ""&iGroupName&""
End If
Next
UserMsg = Replace(UserMsg,"{$UserGroupList}",UserGroupList)
ElseIf Cint(Dvbbs.MyUserInfo(42)) > 0 Then
UserMsg = UserMsg & TopArray(4)
Dvbbs.Name = "GroupSetting_" & Dvbbs.MyUserInfo(42)
iGroupName = Split(Dvbbs.value,"§§§")(3)
UserGroupList = ""&iGroupName&" "
UserMsg = Replace(UserMsg,"{$UserGroupList}",UserGroupList)
End If
If Dvbbs.Forum_Setting(43)="1" Then
UserMsg = Dvbbs.lanstr(10) & UserMsg
End If
template.html(1) = Replace(template.html(1),"{$umsg}",UserMsg)
TempStr=Replace(TempStr,"{$myinfo}",template.html(1))
TempStr=Replace(TempStr,"{$UserID}",Dvbbs.Userid)
If IsNumeric(Dvbbs.MyUserInfo(12)) And IsNumeric(Dvbbs.MyUserInfo(13)) And Dvbbs.MyUserInfo(13)<>"" And Dvbbs.MyUserInfo(12)<>"" Then
If Clng(Dvbbs.MyUserInfo(13))=Clng(Dvbbs.Forum_Setting(39)) And Clng(Dvbbs.MyUserInfo(12))=Clng(Dvbbs.Forum_Setting(38)) Then
TempStr=Replace(TempStr,"{$userlogo}","")
Else
TempStr=Replace(TempStr,"{$userlogo}","")
End If
Else
TempStr=Replace(TempStr,"{$userlogo}","")
End If
End If
If Dvbbs.Forum_ChanSetting(2)="0" Or Dvbbs.Forum_ChanSetting(1)="1" Then
TempStr=Replace(TempStr,"{$xmlandwap}",Split(Dvbbs.mainhtml(19),"||")(0))
If Dvbbs.Forum_ChanSetting(2)="0" Then
TempStr=Replace(TempStr,"{$isxml}",Split(Dvbbs.mainhtml(19),"||")(1))
TempStr=Replace(TempStr,"{$isboard}","")
Else
TempStr=Replace(TempStr,"{$isxml}","")
End If
If Dvbbs.Forum_ChanSetting(1)="1" Then
TempStr=Replace(TempStr,"{$iswap}",Split(Dvbbs.mainhtml(19),"||")(2))
Else
TempStr=Replace(TempStr,"{$iswap}","")
End If
Else
TempStr=Replace(TempStr,"{$xmlandwap}","")
End If
Response.Write Chr(10) & Replace(TempStr,"{$boardid}",Dvbbs.Boardid)
Response.Write Chr(10) & "" & Chr(10)
End Sub
Sub Show_Index_BoardList()
Dim Node,Nodelist,Newnode,Board_Data,LastPost,i,HaveNew,Forum_Boards,CNode,Setings,ShowMod
If Dvbbs.BoardID=0 Then
Set XMLDOM=Application(Dvbbs.CacheName&"_Boradlist").cloneNode(True)
XMLDOM.documentElement.attributes.getNamedItem("boardid").text=Dvbbs.BoardID
Else
Set XMLDOM=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
XMLDOM.appendChild(XMLDOM.createElement("BoardList"))
XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"boardid","")).text=Dvbbs.BoardID
Set Node=Dvbbs.BoardNode.cloneNode(True)
XMLDOM.documentElement.appendChild(Node)
'计算下级论坛发贴总数
Set Nodelist=Dvbbs.BoardNode.selectnodes("board")
For Each Node in nodelist
If node.attributes.getNamedItem("boardid").text<>CStr(Dvbbs.BoardID) Then
ChildTopicNum = ChildTopicNum + Clng(node.attributes.getNamedItem("topicnum").text)
End If
Next
End If
'插入对应风格的图片路径 by Dv.ADRX
XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"picurl","")).text=Dvbbs.Forum_PicUrl
If Dvbbs.GroupSetting(37)="0" Then'去掉隐藏论坛
For each node in XMLDOM.documentElement.getElementsByTagName("board")
If node.attributes.getNamedItem("hidden").text="1" Then
node.parentNode.removeChild(node)
End If
Next
End If
Set Nodelist=XMLDOM.documentElement.selectnodes("board")
For Each Node in nodelist
ShowMod=Request.Cookies("List")("list"&node.attributes.getNamedItem("boardid").text)
If ShowMod<>"" And IsNumeric(ShowMod)Then
node.attributes.getNamedItem("mode").text=ShowMod
End If
Next
Set Nodelist=XMLDOM.documentElement.selectnodes("board/board")
For Each Node in nodelist
LastPost=node.attributes.getNamedItem("lastpost2").text
If Not IsDate(LastPost) Then LastPost=Now()
If DateDiff("h",Dvbbs.Lastlogin,LastPost)=0 Then
node.attributes.getNamedItem("hasnew").text=1
End If
Next
Set XSLT =Application(Dvbbs.CacheName&"_indextemplate_"&Dvbbs.SkinID)
Dim proc
Set proc = XSLT.createProcessor()
proc.input = XMLDOM
proc.transform()
Response.Write proc.output
Set XmlDom=Nothing
Set XMLStyle=Nothing
Set XSLT=Nothing
End Sub
Sub Show_Index_Footer()
Dim TempStr,GetGroupTitle
Dvbbs.GetBrowser
Dvbbs.Name = "GroupTitle"
GetGroupTitle = Dvbbs.Value
TempStr = template.html(6)
TempStr = Replace(TempStr,"{$piclist}",GetGroupTitle)
TempStr = Replace(TempStr,"{$nonewpic}",template.pic(0))
TempStr = Replace(TempStr,"{$isnewpic}",template.pic(1))
TempStr = Replace(TempStr,"{$islockpic}",template.pic(2))
Response.Write TempStr
'进入JS赋值：用户IP、系统、浏览器、显示详细列表字样、总在线、用户在线、客人在线、最大在线、最大在线时间、论坛建立时间
Response.Write Chr(10) & "" & Chr(10)
If Dvbbs.Forum_Setting(14)="1" Or Dvbbs.Forum_Setting(15)="1" Then
Response.Write ""
Else
Response.Write ""
End If
TempStr = Null
End Sub
Sub Show_Index_BirthUser()
Dim Strings
Strings = Dvbbs.CacheData(16,0)
Strings = Split(Strings,"$$")
If Not IsDate(Strings(0)) Then Strings(0) = Now() - 1
If CDate(Strings(0)) <> Date() Then Exit Sub
Strings = Split(Dvbbs.CacheData(16,0),"$$")
Strings(1) = Replace(Strings(1),"{$bpic}",template.pic(3))
Response.Write Strings(1)
End Sub
Sub Board_Rules()
Dim TempStr
TempStr=Dvbbs.BoardNode.attributes.getNamedItem("rules").text
If TempStr<>"" Then
Response.Write Replace(template.html(14),"{$GetRules}",TempStr)
End If
End Sub
Sub news()
Dim TempStr,SQL
'TempStr=Dvbbs.Board_Data(23,0)
TempStr = Dvbbs.BoardNode.attributes.getNamedItem("boardnews").text
SQL=Split(TempStr,"|||")
If Ubound(SQL)<1 Then
Exit Sub
End If
Dim tmpdata,nexhour
TempStr=template.html(8)
If Dvbbs.Board_Setting(21)="1" Then
tmpdata=split(Dvbbs.Board_Setting(22),"|")
nexhour=Hour(Now())+1
nexhour=nexhour mod 24
If tmpdata(nexhour)="0" And Minute(now())>40 Then
sql(1)=sql(1)&"--本版将于"&(60-Minute(now()))&"分钟后暂停开放,敬请留意"
End If
End If
TempStr=Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
TempStr=Replace(TempStr,"{$news}",SQL(0)&"")
TempStr=Replace(TempStr,"{$newstime}",SQL(1))
Response.Write vbNewLine & TempStr
TempStr="":SQL=Null
End Sub
Sub Board_online()
Dim TempStr
TempStr=template.html(9)
TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
TempStr=Replace(TempStr,"{$allonline}",MyBoardOnline.Forum_Online)
TempStr=Replace(TempStr,"{$boardtype}",Dvbbs.Boardtype)
TempStr=Replace(TempStr,"{$boardonline}",MyBoardOnline.Board_UserOnline)
TempStr=Replace(TempStr,"{$boardguest}",MyBoardOnline.Board_GuestOnline)
TempStr=Replace(TempStr,"{$todaynum}",Dvbbs.BoardNode.attributes.getNamedItem("todaynum").text)
TempStr=Replace(TempStr,"{$alertcolor}",Dvbbs.mainsetting(1))
Response.Write vbNewLine & TempStr
TempStr=""
If Dvbbs.forum_setting(14)="1" Or Dvbbs.forum_setting(15)="1" Then
Response.Write vbNewLine & ""
Else
Response.Write vbNewLine & ""
End If
Response.Write vbNewLine & "" & vbNewLine
End Sub
Sub Show_List_Top()
Dim TempStr,TempBoardMaster,BoardMaster,i
If Dvbbs.BoardMaster="" Then
BoardMaster="暂无版主"
Else
TempBoardMaster=Split(Dvbbs.BoardMasterList & "","|")
For i=0 To Ubound(TempBoardMaster)
BoardMaster = BoardMaster & ""&TempBoardMaster(i)&" "
Next
End If
If (Dvbbs.Board_Setting(43)="0" And Dvbbs.Board_Setting(0)="0") Or (Dvbbs.Board_Setting(43)="0" And Dvbbs.Board_Setting(0)="1" And (Dvbbs.Master Or Dvbbs.SuperBoardMaster Or Dvbbs.BoardMaster)) Then
TempStr=template.html(11)
TempStr=Replace(TempStr,"{$pic_postnew}",Dvbbs.mainpic(7))
TempStr=Replace(TempStr,"{$pic_postvote}",Dvbbs.mainpic(8))
TempStr=Replace(TempStr,"{$pic_postxzb}",Dvbbs.mainpic(9))
Else
If Dvbbs.Board_Setting(0)="1" Then TempStr=template.Strings(13)
End If
TempStr=Replace(template.html(10),"{$showpostinfo}",TempStr)
TempStr=Replace(TempStr,"{$page}",page)
TempStr=Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
TempStr=Replace(TempStr,"{$alertcolor}",Dvbbs.mainsetting(1))
TempStr=Replace(TempStr,"{$boardmasterlist}",BoardMaster)
TempStr=Replace(TempStr,"{$smallpaper}",Split(Dvbbs.BoardNode.attributes.getNamedItem("boardnews").text,"|||")(2))
If Dvbbs.Forum_ChanSetting(2)="0" Or Dvbbs.Forum_ChanSetting(1)="1" Then
TempStr=Replace(TempStr,"{$xmlandwap}",Split(Dvbbs.mainhtml(19),"||")(0))
If Dvbbs.Forum_ChanSetting(2)="0" Then
TempStr=Replace(TempStr,"{$isxml}",Split(Dvbbs.mainhtml(19),"||")(1))
TempStr=Replace(TempStr,"{$isboard}",Split(Dvbbs.mainhtml(19),"||")(3))
Else
TempStr=Replace(TempStr,"{$isxml}","")
End If
If Dvbbs.Forum_ChanSetting(1)="1" Then
TempStr=Replace(TempStr,"{$iswap}",Split(Dvbbs.mainhtml(19),"||")(2))
Else
TempStr=Replace(TempStr,"{$iswap}","")
End If
Else
TempStr=Replace(TempStr,"{$xmlandwap}","")
End If
TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
If Dvbbs.Board_Setting(3)="1" Or Dvbbs.Board_Setting(57)="1" Then
Dim allaudit,rs
Set rs=dvbbs.execute("select count(*) from "&Dvbbs.Nowusebbs&" where boardid=777 and locktopic="&Dvbbs.BoardID)
allaudit=rs(0)
If IsNull(allaudit) Then allaudit=0
Set Rs=Nothing
TempStr=Replace(TempStr,"{$isaudit}","| "&template.Strings(14)&"("&allaudit&")")
Else
TempStr=Replace(TempStr,"{$isaudit}","")
End If
If BoardTopicMode="" Then
TempStr=Replace(TempStr,"{$topictype}","")
Else
TempStr=Replace(TempStr,"{$topictype}",template.html(12))
TempStr=Replace(TempStr,"{$TopicMode}",BoardTopicMode)
End If
Response.Write TempStr & vbNewLine
TempStr=Null
End Sub
Sub Chk_List_Err
If Cint(Dvbbs.Board_Setting(2))=1 Then
If Dvbbs.UserID=0 Then
Dvbbs.AddErrCode(24)
End If
End If
If Cint(Dvbbs.Board_Setting(1))=1 and Cint(Dvbbs.GroupSetting(37))=0 Then Dvbbs.AddErrCode(26)
If Cint(Dvbbs.GroupSetting(0))=0 Then Dvbbs.AddErrCode(27)
If action="batch" Then
If CInt(Dvbbs.GroupSetting(45))<>1 Then Dvbbs.AddErrCode(28)
End If
End Sub
'缓存道具信息
Function LoadToolsInfo()
Dim Tools_Info,i,ShowTools,TempStr
Dvbbs.Name="Plus_ToolsInfo"
If Dvbbs.ObjIsEmpty() Then
Dim Rs,Sql
Sql = "Select ID,ToolsName From Dv_Plus_Tools_Info order by ID"
Set Rs = Dvbbs.Plus_Execute(Sql)
If Not Rs.Eof Then
Sql = Rs.GetString(,, "§§§", "@#@", "")
End If
Rs.Close : Set Rs = Nothing
Tools_Info = Split(Sql,"@#@")
TempStr = "var ShowTools = new Array();" & vbNewLine
For i=0 To Ubound(Tools_Info)-1
ShowTools = Split(Tools_Info(i),"§§§")
TempStr = TempStr & "ShowTools["&ShowTools(0)&"]='"&Replace(Replace(Replace(ShowTools(1),"\","\\"),"'","\'"),chr(13),"")&"';"
Next
Dvbbs.value = TempStr & vbNewLine
End If
LoadToolsInfo = Dvbbs.value
End Function
%>
")
End If
End If
If Dvbbs.Forum_ChanSetting(2)="0" Or Dvbbs.Forum_ChanSetting(1)="1" Then
TempStr=Replace(TempStr,"{$xmlandwap}",Split(Dvbbs.mainhtml(19),"||")(0))
If Dvbbs.Forum_ChanSetting(2)="0" Then
TempStr=Replace(TempStr,"{$isxml}",Split(Dvbbs.mainhtml(19),"||")(1))
TempStr=Replace(TempStr,"{$isboard}","")
Else
TempStr=Replace(TempStr,"{$isxml}","")
End If
If Dvbbs.Forum_ChanSetting(1)="1" Then
TempStr=Replace(TempStr,"{$iswap}",Split(Dvbbs.mainhtml(19),"||")(2))
Else
TempStr=Replace(TempStr,"{$iswap}","")
End If
Else
TempStr=Replace(TempStr,"{$xmlandwap}","")
End If
Response.Write Chr(10) & Replace(TempStr,"{$boardid}",Dvbbs.Boardid)
Response.Write Chr(10) & "" & Chr(10)
End Sub
Sub Show_Index_BoardList()
Dim Node,Nodelist,Newnode,Board_Data,LastPost,i,HaveNew,Forum_Boards,CNode,Setings,ShowMod
If Dvbbs.BoardID=0 Then
Set XMLDOM=Application(Dvbbs.CacheName&"_Boradlist").cloneNode(True)
XMLDOM.documentElement.attributes.getNamedItem("boardid").text=Dvbbs.BoardID
Else
Set XMLDOM=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
XMLDOM.appendChild(XMLDOM.createElement("BoardList"))
XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"boardid","")).text=Dvbbs.BoardID
Set Node=Dvbbs.BoardNode.cloneNode(True)
XMLDOM.documentElement.appendChild(Node)
'计算下级论坛发贴总数
Set Nodelist=Dvbbs.BoardNode.selectnodes("board")
For Each Node in nodelist
If node.attributes.getNamedItem("boardid").text<>CStr(Dvbbs.BoardID) Then
ChildTopicNum = ChildTopicNum + Clng(node.attributes.getNamedItem("topicnum").text)
End If
Next
End If
'插入对应风格的图片路径 by Dv.ADRX
XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"picurl","")).text=Dvbbs.Forum_PicUrl
If Dvbbs.GroupSetting(37)="0" Then'去掉隐藏论坛
For each node in XMLDOM.documentElement.getElementsByTagName("board")
If node.attributes.getNamedItem("hidden").text="1" Then
node.parentNode.removeChild(node)
End If
Next
End If
Set Nodelist=XMLDOM.documentElement.selectnodes("board")
For Each Node in nodelist
ShowMod=Request.Cookies("List")("list"&node.attributes.getNamedItem("boardid").text)
If ShowMod<>"" And IsNumeric(ShowMod)Then
node.attributes.getNamedItem("mode").text=ShowMod
End If
Next
Set Nodelist=XMLDOM.documentElement.selectnodes("board/board")
For Each Node in nodelist
LastPost=node.attributes.getNamedItem("lastpost2").text
If Not IsDate(LastPost) Then LastPost=Now()
If DateDiff("h",Dvbbs.Lastlogin,LastPost)=0 Then
node.attributes.getNamedItem("hasnew").text=1
End If
Next
Set XSLT =Application(Dvbbs.CacheName&"_indextemplate_"&Dvbbs.SkinID)
Dim proc
Set proc = XSLT.createProcessor()
proc.input = XMLDOM
proc.transform()
Response.Write proc.output
Set XmlDom=Nothing
Set XMLStyle=Nothing
Set XSLT=Nothing
End Sub
Sub Show_Index_Footer()
Dim TempStr,GetGroupTitle
Dvbbs.GetBrowser
Dvbbs.Name = "GroupTitle"
GetGroupTitle = Dvbbs.Value
TempStr = template.html(6)
TempStr = Replace(TempStr,"{$piclist}",GetGroupTitle)
TempStr = Replace(TempStr,"{$nonewpic}",template.pic(0))
TempStr = Replace(TempStr,"{$isnewpic}",template.pic(1))
TempStr = Replace(TempStr,"{$islockpic}",template.pic(2))
Response.Write TempStr
'进入JS赋值：用户IP、系统、浏览器、显示详细列表字样、总在线、用户在线、客人在线、最大在线、最大在线时间、论坛建立时间
Response.Write Chr(10) & "" & Chr(10)
If Dvbbs.Forum_Setting(14)="1" Or Dvbbs.Forum_Setting(15)="1" Then
Response.Write ""
Else
Response.Write ""
End If
TempStr = Null
End Sub
Sub Show_Index_BirthUser()
Dim Strings
Strings = Dvbbs.CacheData(16,0)
Strings = Split(Strings,"$$")
If Not IsDate(Strings(0)) Then Strings(0) = Now() - 1
If CDate(Strings(0)) <> Date() Then Exit Sub
Strings = Split(Dvbbs.CacheData(16,0),"$$")
Strings(1) = Replace(Strings(1),"{$bpic}",template.pic(3))
Response.Write Strings(1)
End Sub
Sub Board_Rules()
Dim TempStr
TempStr=Dvbbs.BoardNode.attributes.getNamedItem("rules").text
If TempStr<>"" Then
Response.Write Replace(template.html(14),"{$GetRules}",TempStr)
End If
End Sub
Sub news()
Dim TempStr,SQL
'TempStr=Dvbbs.Board_Data(23,0)
TempStr = Dvbbs.BoardNode.attributes.getNamedItem("boardnews").text
SQL=Split(TempStr,"|||")
If Ubound(SQL)<1 Then
Exit Sub
End If
Dim tmpdata,nexhour
TempStr=template.html(8)
If Dvbbs.Board_Setting(21)="1" Then
tmpdata=split(Dvbbs.Board_Setting(22),"|")
nexhour=Hour(Now())+1
nexhour=nexhour mod 24
If tmpdata(nexhour)="0" And Minute(now())>40 Then
sql(1)=sql(1)&"--本版将于"&(60-Minute(now()))&"分钟后暂停开放,敬请留意"
End If
End If
TempStr=Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
TempStr=Replace(TempStr,"{$news}",SQL(0)&"")
TempStr=Replace(TempStr,"{$newstime}",SQL(1))
Response.Write vbNewLine & TempStr
TempStr="":SQL=Null
End Sub
Sub Board_online()
Dim TempStr
TempStr=template.html(9)
TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
TempStr=Replace(TempStr,"{$allonline}",MyBoardOnline.Forum_Online)
TempStr=Replace(TempStr,"{$boardtype}",Dvbbs.Boardtype)
TempStr=Replace(TempStr,"{$boardonline}",MyBoardOnline.Board_UserOnline)
TempStr=Replace(TempStr,"{$boardguest}",MyBoardOnline.Board_GuestOnline)
TempStr=Replace(TempStr,"{$todaynum}",Dvbbs.BoardNode.attributes.getNamedItem("todaynum").text)
TempStr=Replace(TempStr,"{$alertcolor}",Dvbbs.mainsetting(1))
Response.Write vbNewLine & TempStr
TempStr=""
If Dvbbs.forum_setting(14)="1" Or Dvbbs.forum_setting(15)="1" Then
Response.Write vbNewLine & ""
Else
Response.Write vbNewLine & ""
End If
Response.Write vbNewLine & "" & vbNewLine
End Sub
Sub Show_List_Top()
Dim TempStr,TempBoardMaster,BoardMaster,i
If Dvbbs.BoardMaster="" Then
BoardMaster="暂无版主"
Else
TempBoardMaster=Split(Dvbbs.BoardMasterList & "","|")
For i=0 To Ubound(TempBoardMaster)
BoardMaster = BoardMaster & ""&TempBoardMaster(i)&" "
Next
End If
If (Dvbbs.Board_Setting(43)="0" And Dvbbs.Board_Setting(0)="0") Or (Dvbbs.Board_Setting(43)="0" And Dvbbs.Board_Setting(0)="1" And (Dvbbs.Master Or Dvbbs.SuperBoardMaster Or Dvbbs.BoardMaster)) Then
TempStr=template.html(11)
TempStr=Replace(TempStr,"{$pic_postnew}",Dvbbs.mainpic(7))
TempStr=Replace(TempStr,"{$pic_postvote}",Dvbbs.mainpic(8))
TempStr=Replace(TempStr,"{$pic_postxzb}",Dvbbs.mainpic(9))
Else
If Dvbbs.Board_Setting(0)="1" Then TempStr=template.Strings(13)
End If
TempStr=Replace(template.html(10),"{$showpostinfo}",TempStr)
TempStr=Replace(TempStr,"{$page}",page)
TempStr=Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
TempStr=Replace(TempStr,"{$alertcolor}",Dvbbs.mainsetting(1))
TempStr=Replace(TempStr,"{$boardmasterlist}",BoardMaster)
TempStr=Replace(TempStr,"{$smallpaper}",Split(Dvbbs.BoardNode.attributes.getNamedItem("boardnews").text,"|||")(2))
If Dvbbs.Forum_ChanSetting(2)="0" Or Dvbbs.Forum_ChanSetting(1)="1" Then
TempStr=Replace(TempStr,"{$xmlandwap}",Split(Dvbbs.mainhtml(19),"||")(0))
If Dvbbs.Forum_ChanSetting(2)="0" Then
TempStr=Replace(TempStr,"{$isxml}",Split(Dvbbs.mainhtml(19),"||")(1))
TempStr=Replace(TempStr,"{$isboard}",Split(Dvbbs.mainhtml(19),"||")(3))
Else
TempStr=Replace(TempStr,"{$isxml}","")
End If
If Dvbbs.Forum_ChanSetting(1)="1" Then
TempStr=Replace(TempStr,"{$iswap}",Split(Dvbbs.mainhtml(19),"||")(2))
Else
TempStr=Replace(TempStr,"{$iswap}","")
End If
Else
TempStr=Replace(TempStr,"{$xmlandwap}","")
End If
TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
If Dvbbs.Board_Setting(3)="1" Or Dvbbs.Board_Setting(57)="1" Then
Dim allaudit,rs
Set rs=dvbbs.execute("select count(*) from "&Dvbbs.Nowusebbs&" where boardid=777 and locktopic="&Dvbbs.BoardID)
allaudit=rs(0)
If IsNull(allaudit) Then allaudit=0
Set Rs=Nothing
TempStr=Replace(TempStr,"{$isaudit}","| "&template.Strings(14)&"("&allaudit&")")
Else
TempStr=Replace(TempStr,"{$isaudit}","")
End If
If BoardTopicMode="" Then
TempStr=Replace(TempStr,"{$topictype}","")
Else
TempStr=Replace(TempStr,"{$topictype}",template.html(12))
TempStr=Replace(TempStr,"{$TopicMode}",BoardTopicMode)
End If
Response.Write TempStr & vbNewLine
TempStr=Null
End Sub
Sub Chk_List_Err
If Cint(Dvbbs.Board_Setting(2))=1 Then
If Dvbbs.UserID=0 Then
Dvbbs.AddErrCode(24)
End If
End If
If Cint(Dvbbs.Board_Setting(1))=1 and Cint(Dvbbs.GroupSetting(37))=0 Then Dvbbs.AddErrCode(26)
If Cint(Dvbbs.GroupSetting(0))=0 Then Dvbbs.AddErrCode(27)
If action="batch" Then
If CInt(Dvbbs.GroupSetting(45))<>1 Then Dvbbs.AddErrCode(28)
End If
End Sub
'缓存道具信息
Function LoadToolsInfo()
Dim Tools_Info,i,ShowTools,TempStr
Dvbbs.Name="Plus_ToolsInfo"
If Dvbbs.ObjIsEmpty() Then
Dim Rs,Sql
Sql = "Select ID,ToolsName From Dv_Plus_Tools_Info order by ID"
Set Rs = Dvbbs.Plus_Execute(Sql)
If Not Rs.Eof Then
Sql = Rs.GetString(,, "§§§", "@#@", "")
End If
Rs.Close : Set Rs = Nothing
Tools_Info = Split(Sql,"@#@")
TempStr = "var ShowTools = new Array();" & vbNewLine
For i=0 To Ubound(Tools_Info)-1
ShowTools = Split(Tools_Info(i),"§§§")
TempStr = TempStr & "ShowTools["&ShowTools(0)&"]='"&Replace(Replace(Replace(ShowTools(1),"\","\\"),"'","\'"),chr(13),"")&"';"
Next
Dvbbs.value = TempStr & vbNewLine
End If
LoadToolsInfo = Dvbbs.value
End Function
%>