<% Rem 首页页面设置 Const CachePage=false '是否做页面缓存 Const CacheTime=60 '缓存失效时间 Dim XMLDom,page,TopicMode,Cmd If Request("w") = "1" Then Passport_Main() Response.End End If 'Dvbbs.SHOWSQL=1 Select Case Request("action") Case "xml" : Showxml() Case "frameon" : ShowIsLeft() Case Else If Dvbbs.CheckStr(Request.Cookies("geturl"))="" And Dvbbs.forum_setting(103)=1 Then Response.Cookies("geturl") = "index.asp" Response.redirect "index.asp?action=frameon" Else Main() End if End Select Sub ShowIsleft() Dim RightUrl RightUrl = Request.QueryString("url") If RightUrl = "" Then RightUrl = Dvbbs.ArchiveHtml("index.asp") Else If Request.Cookies("geturl")<>RightUrl Then RightUrl = Dvbbs.ArchiveHtml(Request.Cookies("geturl")) End If End If %> <% End Sub Sub Showxml() Dim node,BoardNode Set XMLDOM=Application(Dvbbs.CacheName&"_boardlist").cloneNode(True) For each node in XMLDOM.documentElement.getElementsByTagName("board") If node.attributes.getNamedItem("hidden").text="1" and Dvbbs.GroupSetting(37)="0" Then node.parentNode.removeChild(node) End If If Request("pid") <> "" and node.attributes.getNamedItem("parentid").text<>Request("pid") Then node.parentNode.removeChild(node) End If node.removeAttribute "indeximg" node.removeAttribute "readme" Next Response.Clear Response.CharSet="gb2312" Response.ContentType="text/xml" Response.Write ""&vbNewLine Response.Write XMLDom.documentElement.XML Response.Flush Set XMLDOM=Nothing Set Dvbbs=Nothing Response.End End Sub Sub Main() Dvbbs.LoadTemplates("index") If Dvbbs.BoardID=0 Then Dvbbs.Stats=template.Strings(0) Dvbbs.Nav() Dvbbs.ActiveOnline() 'GetForumTextAd(0) '自定义首页 Dim CustomIndex If Not TypeName(Application(Dvbbs.CacheName & "_style"))="DOMDocument" Then Dvbbs.Loadstyle() If Application(Dvbbs.CacheName &"_style").documentElement.selectSingleNode("style[@id='"&Dvbbs.SkinID&"']") Is Nothing Then CustomIndex = "" Else CustomIndex = Dvbbs.CheckStr(Application(Dvbbs.CacheName &"_style").documentElement.selectSingleNode("style[@id='"&Dvbbs.SkinID&"']").getAttribute("layout")) End If If CustomIndex<>"" Then CustomMain() If Dvbbs.Boardid=0 Then If Dvbbs.Forum_Setting(14)="1" Or Dvbbs.Forum_Setting(15)="1" Then Response.Write "" Else Response.Write "" End If End If Else BoardList() End If Else Chk_List_Err() TopicMode=0 If Request("topicmode")<>"" and IsNumeric(Request("topicmode")) Then TopicMode=Cint(Request("topicmode")) If 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,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"","" 'GetForumTextAd(1) BoardList() Page=Request("Page") If ( Not isNumeric(Page) )or Page="" Then Page=1 Page=Clng(Page) If Page <1 Then Page=1 If Dvbbs.Board_Setting(43)="0" Then topicList() End If End If Dvbbs.Footer() Dvbbs.PageEnd() End Sub Sub Chk_List_Err() If Dvbbs.Board_Setting(1)="1" and Dvbbs.GroupSetting(37)="0" Then Dvbbs.AddErrCode(26) ElseIf Request("action")="batch" and Dvbbs.GroupSetting(45)<>"1"Then Dvbbs.AddErrCode(28) End If Dvbbs.showerr() End Sub Sub topicList() Dim Node,modelist,modelistimg,i,cpost,ctopic Dim Rs cpost=0 ctopic=0 If Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@child").text<>"0" Then For Each Node In Application(Dvbbs.CacheName&"_boardlist").documentElement.selectNodes("board[@parentid='"&Dvbbs.BoardID&"']/@boardid") ctopic=ctopic+CLng(Application(Dvbbs.CacheName &"_information_" & node.text).documentElement.selectSingleNode("information/@topicnum").text) cpost=cpost+CLng(Application(Dvbbs.CacheName &"_information_" & node.text).documentElement.selectSingleNode("information/@postnum").text) Next End If Set XMLDom=Application(Dvbbs.CacheName &"_boarddata_" & Dvbbs.boardid).cloneNode(True) XMLDom.documentElement.firstChild.removeAttribute "boarduser" XMLDom.documentElement.firstChild.removeAttribute "board_ads" XMLDom.documentElement.firstChild.removeAttribute "board_user" XMLDom.documentElement.firstChild.removeAttribute "isgroupsetting" XMLDom.documentElement.firstChild.removeAttribute "rootid" XMLDom.documentElement.firstChild.removeAttribute "board_setting" XMLDom.documentElement.firstChild.removeAttribute "sid" XMLDom.documentElement.firstChild.removeAttribute "cid" XMLDom.documentElement.firstChild.setAttribute "boardtype",Dvbbs.boardtype XMLDom.documentElement.firstChild.setAttribute "forum_online",MyBoardOnline.Forum_Online 'XMLDom.documentElement.firstChild.setAttribute "board_useronline",MyBoardOnline.Board_UserOnline 'XMLDom.documentElement.firstChild.setAttribute "board_guestonline",MyBoardOnline.Board_GuestOnline XMLDom.documentElement.firstChild.setAttribute "postnum",CLng(Application(Dvbbs.CacheName &"_information_" & Dvbbs.boardid).documentElement.selectSingleNode("information/@postnum").text)-cpost Set Rs = Dvbbs.Execute("Select Count(*) From Dv_Topic Where BoardID="&Dvbbs.BoardID&" And isTop>0") XMLDom.documentElement.firstChild.setAttribute "topicnum",CLng(Application(Dvbbs.CacheName &"_information_" & Dvbbs.boardid).documentElement.selectSingleNode("information/@topicnum").text)-ctopic-Dvbbs.CheckNumeric(Rs(0)) Rs.Close 'XMLDom.documentElement.firstChild.setAttribute "topicnum",CLng(Application(Dvbbs.CacheName &"_information_" & Dvbbs.boardid).documentElement.selectSingleNode("information/@topicnum").text)-ctopic XMLDom.documentElement.firstChild.setAttribute "todaynum",CLng(Application(Dvbbs.CacheName &"_information_" & Dvbbs.boardid).documentElement.selectSingleNode("information/@todaynum").text) modelist=Split(Dvbbs.Board_Setting(48),"$$") modelistimg=Split(Dvbbs.Board_Setting(49),"$$") For i= 0 to UBound(modelist) -1 Set Node = XMLDom.documentElement.firstChild.appendChild(XMLDom.createNode(1,"mode","")) Node.text=modelist(i) If i < UBound(modelistimg) Then Node.setAttribute "pic",modelistimg(i) Next XMLDOM.documentElement.setAttribute "picurl",Dvbbs.Forum_PicUrl If Dvbbs.Forum_Setting(14)="1" Or Dvbbs.Forum_Setting(15)="1" Then XMLDom.documentElement.firstChild.setAttribute "showonline","1" Else XMLDom.documentElement.firstChild.setAttribute "showonline","0" End If XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName &"_boardmaster").documentElement.selectSingleNode("boardmaster[@boardid='"& Dvbbs.boardid&"']").cloneNode(True)) Rem ===============传送论坛信息和设置数据到XML=============================================================== Set Node=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"forum_setting","")) Node.setAttribute "logincheckcode",Dvbbs.forum_setting(79)'登录验证码设置 If Dvbbs.Forum_ChanSetting(0)=1 And Dvbbs.Forum_ChanSetting(10)=1 Then Node.setAttribute "loginmobile",""'手机会员登录 Node.setAttribute "rss",Dvbbs.Forum_ChanSetting(2)'rss订阅 ' Node.setAttribute "wap",Dvbbs.Forum_ChanSetting(1)'wap访问 Node.setAttribute "ishot",Dvbbs.Forum_Setting(44)'热贴最少回复 Node.setAttribute "pagesize",Dvbbs.Board_Setting(26)'列表分页大小 Node.setAttribute "postalipay",Dvbbs.Board_Setting(67) Node.setAttribute "dispsize",Dvbbs.Board_Setting(27) '贴子分页大小 Node.setAttribute "tools",Dvbbs.Forum_Setting(90)'道具中心开关 Node.setAttribute "newfalgpic",Dvbbs.Board_Setting(60) '显示新贴标志的设置 Node.setAttribute "ForumUrl",Dvbbs.Get_ScriptNameUrl() Node.setAttribute "isapi_write",isUrlreWrite If Dvbbs.Board_Setting(3)="1" Or Dvbbs.Board_Setting(57)="1" Then Node.setAttribute "auditcount",auditcount End If Rem 参数传递 XMLDom.documentElement.setAttribute "action",Request("action") XMLDom.documentElement.setAttribute "page",Page XMLDom.documentElement.setAttribute "topicmode",topicmode If Dvbbs.Boardmaster Then XMLDom.documentElement.setAttribute "ismaster","1" Else XMLDom.documentElement.setAttribute "ismaster","0" End If If Dvbbs.Board_Setting(68)="1" Then XMLDom.documentElement.setAttribute "cananony","1" Else XMLDom.documentElement.setAttribute "cananony","0" End If XMLDom.documentElement.setAttribute "canlookuser",Dvbbs.GroupSetting(1) If Not IsObject(Application(Dvbbs.CacheName & "_smallpaper")) Then LoadBoardNews_Paper() For Each Node in Application(Dvbbs.CacheName & "_smallpaper").documentElement.SelectNodes("smallpaper[@s_boardid='"&Dvbbs.Boardid&"']") XMLDom.documentElement.appendChild(Node.cloneNode(True)) Next LoadTopiclist() Response.Write vbNewLine & "" & vbNewLine If Cint(TopicMode) <> "0" Then XMLDom.documentElement.setAttribute "modecount",Dvbbs.Execute("Select Count(*) From Dv_Topic Where Mode="&TopicMode&" and BoardID="&Dvbbs.BoardID&" And IsTop=0")(0) End If transform_topicList() End Sub Function auditcount() Dim Rs Set Rs=Dvbbs.Execute("select count(*) from "& Dvbbs.Nowusebbs &" where boardid=777 and locktopic="&Dvbbs.BoardID) If IsNull(Rs(0)) Then auditcount=0 Else auditcount=Rs(0) End If Set Rs=Nothing End Function Sub LoadTopiclist() Dim Node,nodes,topidlist,Rs,Sql,lastpost,i,PostTime,limitime If Page=1 Then topidlist=Dvbbs.CacheData(28,0) If topidlist="" Then topidlist=Application(Dvbbs.CacheName &"_information_" & Dvbbs.boardid).documentElement.selectSingleNode("information/@boardtopstr").text ElseIf Trim(Application(Dvbbs.CacheName &"_information_" & Dvbbs.boardid).documentElement.selectSingleNode("information/@boardtopstr").text)<>"" Then topidlist=topidlist &","& Application(Dvbbs.CacheName &"_information_" & Dvbbs.boardid).documentElement.selectSingleNode("information/@boardtopstr").text End If If Trim(topidlist) <>"" Then 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,hidename from dv_topic Where istop > 0 and topicid in ("& Dvbbs.Checkstr(topidlist) &") Order By istop desc, Lastposttime Desc") If Not Rs.EOF Then SQL=Rs.GetRows(-1) Set topidlist=Dvbbs.ArrayToxml(sql,rs,"row","toptopic") Rs.Close SQL=Empty For Each Node in topidlist.documentElement.SelectNodes("row") Node.selectSingleNode("@title").text=Dvbbs.ChkBadWords(Node.selectSingleNode("@title").text) If Not Node.selectSingleNode("@topicmode").text ="1" Then Node.selectSingleNode("@title").text=replace(Node.selectSingleNode("@title").text,"<","<") End If Node.selectSingleNode("@lastpost").text=Dvbbs.ChkBadWords(Node.selectSingleNode("@lastpost").text) Node.selectSingleNode("@postusername").text=Dvbbs.ChkBadWords(Node.selectSingleNode("@postusername").text) i=0 For each lastpost in split(Node.selectSingleNode("@lastpost").text,"$") Node.setAttribute "lastpost_"& i,lastpost i=i+1 Next If Dvbbs.Board_Setting(60)<>"" And Dvbbs.Board_Setting(60)<>"0" Then If Dvbbs.Board_Setting(38) = "0" Then PostTime = Node.selectSingleNode("@lastpost_2").text Else PostTime = Node.selectSingleNode("@dateandtime").text End If If DateDiff("n",Posttime,Now)+Cint(Dvbbs.Forum_Setting(0)) < CLng(Dvbbs.Board_Setting(61)) Then Node.setAttribute "datedifftime",DateDiff("n",Posttime,Now)+Cint(Dvbbs.Forum_Setting(0)) End If End If Next XMLDom.documentElement.appendChild(topidlist.documentElement) End If Set Rs=Nothing End If End If If Not IsObject(Conn) Then ConnectionDatabase If IsSqlDataBase=1 And IsBuss=1 Then Set Cmd = Dvbbs.iCreateObject("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 Cmd("@tl")=0 Set Rs=Cmd.Execute If Not Rs.EoF Then SQL=Rs.GetRows(-1) Set topidlist=Dvbbs.ArrayToxml(sql,rs,"row","topic") Else Set topidlist=Nothing End If Set Rs=Nothing Else Set Rs = Dvbbs.iCreateObject ("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&" 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,hidename From Dv_Topic Where Mode="&TopicMode&" and BoardID="&Dvbbs.BoardID&" And IsTop=0 Order By LastPostTime Desc" End If Rs.Open Sql,Conn,1,1 If Page >1 Then Rs.Move (page-1) * Clng(Dvbbs.Board_Setting(26)) End If If Not Rs.EoF Then SQL=Rs.GetRows(Dvbbs.Board_Setting(26)) Set topidlist=Dvbbs.ArrayToxml(sql,rs,"row","topic") Else Set topidlist=Nothing End If Set Rs=Nothing End If SQL=Empty If Not topidlist Is Nothing Then For Each Node in topidlist.documentElement.SelectNodes("row") Node.selectSingleNode("@title").text=Dvbbs.ChkBadWords(Node.selectSingleNode("@title").text) If Not Node.selectSingleNode("@topicmode").text ="1" Then Node.selectSingleNode("@title").text=replace(Node.selectSingleNode("@title").text,"<","<") End If Node.selectSingleNode("@postusername").text=Dvbbs.ChkBadWords(Node.selectSingleNode("@postusername").text) i=0 For each lastpost in split(Node.selectSingleNode("@lastpost").text,"$") Node.setAttribute "lastpost_"& i,lastpost i=i+1 Next If Dvbbs.Board_Setting(60)<>"" And Dvbbs.Board_Setting(60)<>"0" Then If Dvbbs.Board_Setting(38) = "0" Then PostTime = Node.selectSingleNode("@lastpost_2").text Else PostTime = Node.selectSingleNode("@dateandtime").text End If If DateDiff("n",Posttime,Now)+Cint(Dvbbs.Forum_Setting(0)) < CLng(Dvbbs.Board_Setting(61)) Then Node.setAttribute "datedifftime",DateDiff("n",Posttime,Now)+Cint(Dvbbs.Forum_Setting(0)) End If End If Next XMLDom.documentElement.appendChild(topidlist.documentElement) End If Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 1 End Sub Sub transform_topicList() Dim proc,XMLStyle,node,cnode,XSLTemplate Set XSLTemplate=Dvbbs.iCreateObject("Msxml2.XSLTemplate" & MsxmlVersion ) Set XMLStyle=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion ) XMLStyle.loadxml template.html(1) '插入各种图片的设置数据 Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="picurl" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.Forum_PicUrl XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="pic_nofollow" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(10) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="pic_follow" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(11) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="ztopic" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(0) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="istopic" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(1) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="opentopic" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(2) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="hottopic" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(3) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="ilocktopic" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(4) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="besttopic" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(5) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="votetopic" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(6) XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="pic_toptopic1" Node.attributes.setNamedItem(CNode) node.text=Dvbbs.mainpic(19) XMLStyle.documentElement.appendChild(node) XSLTemplate.stylesheet=XMLStyle Set proc = XSLTemplate.createProcessor() proc.input = XMLDom proc.transform() Rem Add 转换公告和文字广告 By Dv.唧唧 2007-10-16 Dim procStr procStr = Replace(Dvbbs.ArchiveHtml(proc.output),"{$showNew}",ShowNews()) If Dvbbs.Boardid=0 Then procStr = Replace(procStr,"{$GetForumTextAd}",GetForumTextAd(0)) Else procStr = Replace(procStr,"{$GetForumTextAd}",GetForumTextAd(1)) End If Response.Write procStr Set XMLDom=Nothing Set proc=Nothing End Sub Sub LoadBoardlistData() Dim Node,Xpath,LastPost,BoardiD,Xpath1 Set XMLDom=Application(Dvbbs.CacheName&"_boardlist").cloneNode(True) XMLDom.documentElement.setAttribute "boardid",Dvbbs.BoardID If Dvbbs.Boardid=0 Then Xpath="board[@depth=1]" Xpath1="board[@depth=0]" XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName &"_grouppic").documentElement.cloneNode(True)) If Not IsObject(Application(Dvbbs.CacheName & "_link")) Then LoadlinkList() XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName & "_link").documentElement.cloneNode(True)) Rem ===============传送论坛信息和设置数据到XML=============================================================== Set Node=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"forum_info","")) Node.setAttribute "forum_type",Dvbbs.forum_info(0) Node.setAttribute "forum_maxonline",Dvbbs.CacheData(5,0) Node.setAttribute "forum_maxonlinedate",Dvbbs.CacheData(6,0) Node.setAttribute "forum_topicnum",Dvbbs.CacheData(7,0) Node.setAttribute "forum_postnum",Dvbbs.CacheData(8,0) Node.setAttribute "forum_todaynum",Dvbbs.CacheData(9,0) Node.setAttribute "forum_usernum",Dvbbs.CacheData(10,0) Node.setAttribute "forum_yesterdaynum",Dvbbs.CacheData(11,0) Node.setAttribute "forum_maxpostnum",Dvbbs.CacheData(12,0) Node.setAttribute "forum_maxpostdate",Dvbbs.CacheData(13,0) Node.setAttribute "forum_lastuser",Dvbbs.CacheData(14,0) Node.setAttribute "forum_online",MyBoardOnline.Forum_Online Node.setAttribute "forum_useronline",MyBoardOnline.Forum_UserOnline Node.setAttribute "forum_guestonline",MyBoardOnline.Forum_GuestOnline Node.setAttribute "forum_createtime",FormatDateTime(Dvbbs.Forum_Setting(74),1) Set Node=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"forum_setting","")) Node.setAttribute "logincheckcode",Dvbbs.forum_setting(79)'登录验证码设置 If Dvbbs.Forum_ChanSetting(0)=1 And Dvbbs.Forum_ChanSetting(10)=1 Then Node.setAttribute "loginmobile",""'手机会员登录 Node.setAttribute "rss",Dvbbs.Forum_ChanSetting(2)'rss订阅 ' Node.setAttribute "wap",Dvbbs.Forum_ChanSetting(1)'wap访问 Node.setAttribute "pic_0",template.pic(0) Node.setAttribute "pic_1",template.pic(1) Node.setAttribute "pic_2",template.pic(2) Node.setAttribute "pic_3",template.pic(3) Node.setAttribute "issearch_a",0 Node.setAttribute "ForumUrl",Dvbbs.Get_ScriptNameUrl() Node.setAttribute "dvgetcode",Dvbbs.GetCode() If Dvbbs.Forum_setting(29)="1" Then If Not IsObject(Application(Dvbbs.CacheName & "_biruser")) Then Forum_BirUser() ElseIf Application(Dvbbs.CacheName & "_biruser").documentElement.selectSingleNode("@date").text <> CStr(Date()) Then Forum_BirUser() End If XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName &"_biruser").documentElement.cloneNode(True)) End If If Not (XMLDOM.documentElement.firstchild is nothing) Then If Not IsObject(Application(Dvbbs.CacheName &"_information_" & XMLDOM.documentElement.firstchild.getAttribute("boardid")) ) Then Dvbbs.LoadAllBoardinformation() End If End If Rem ======================================================================================================================================== Else Xpath="board[@parentid="&Dvbbs.BoardID&" and @depth="& CLng(XMLDom.documentElement.selectSingleNode("board[@boardid="& Dvbbs.boardid &"]/@depth").text)+1&"]" Xpath1="board[@boardid="& Dvbbs.Boardid&"]" End If If Dvbbs.BoardID<>0 Then Set Node=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"forum_setting","")) Node.setAttribute "pic_0",template.pic(0) Node.setAttribute "pic_1",template.pic(1) Node.setAttribute "pic_2",template.pic(2) Node.setAttribute "pic_3",template.pic(3) Node.setAttribute "issearch_a",1 End If For Each Node In XMLDom.documentElement.selectNodes(Xpath) BoardId=Node.selectSingleNode("@boardid").text If Not IsObject(Application(Dvbbs.CacheName &"_information_" & BoardID) ) Then Dvbbs.LoadBoardinformation BoardID LastPost=Node.appendChild(Application(Dvbbs.CacheName &"_information_" & BoardID).documentElement.firstChild.cloneNode(True)).selectSingleNode("@lastpost_2").text If Not IsDate(LastPost) Then LastPost=Now() If DateDiff("h",Dvbbs.Lastlogin,LastPost)=0 Then Node.setAttribute "newpost","1" XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName &"_boardmaster").documentElement.selectSingleNode("boardmaster[@boardid='"& boardid &"']").cloneNode(True)) Next XMLDOM.documentElement.setAttribute "picurl",Dvbbs.Forum_PicUrl XMLDOM.documentElement.setAttribute "lastupdate",Now() If CachePage Then Set Application(Dvbbs.CacheName & "_Pagecache_index_" & Dvbbs.BoardID)=XMLDOM.cloneNode(True) End If End Sub Sub BoardList() Rem 公告部分已经转移 2007-10-10 By Dv.唧唧 'If Dvbbs.BoardID=0 Then ' ShowNews() 'ElseIf Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&dvbbs.boardid&"]/@nopost").text<>"1" Then ' ShowNews() 'End If Dim Node,ShowMod,Xpath1,BoardId If CachePage Then If Not IsObject(Application(Dvbbs.CacheName & "_Pagecache_index_" & Dvbbs.BoardID)) Then LoadBoardlistData() Else If DateDiff("s",Application(Dvbbs.CacheName & "_Pagecache_index_" & Dvbbs.BoardID).documentElement.selectSingleNode("@lastupdate").text,Now()) > CacheTime Then LoadBoardlistData() Else Set XmlDom=Application(Dvbbs.CacheName & "_Pagecache_index_" & Dvbbs.BoardID).cloneNode(True) End If End If Else LoadBoardlistData() End If If Dvbbs.GroupSetting(37)="0" Then For each node in XMLDOM.documentElement.selectNodes("board[@hidden=1]") XMLDom.documentElement.removeChild(node) Next End If If Dvbbs.BoardID=0 Then Xpath1="board[@depth=0]" Else Xpath1="board[@boardid="& Dvbbs.Boardid&"]" End If Set Node=XMLDom.documentElement.selectSingleNode("forum_setting") If Dvbbs.IsSearch Then Node.setAttribute "issearch",1 Else Node.setAttribute "issearch",0 End If For Each Node In XMLDom.documentElement.selectNodes(Xpath1) BoardId=Node.selectSingleNode("@boardid").text ShowMod=Request.Cookies("List")("list"&BoardId) If ShowMod<>"" And IsNumeric(ShowMod) Then Node.selectSingleNode("@mode").text=ShowMod End If Next If Dvbbs.BoardID=0 Then XMLDom.documentElement.appendChild(Dvbbs.UserSession.documentElement.firstChild.cloneNode(True)) XMLDom.documentElement.appendChild(Dvbbs.UserSession.documentElement.lastChild.cloneNode(True)) If Dvbbs.UserID <>0 Then '身份切换数据节点 If UBound(Dvbbs.UserGroupParentID) <> -1 Then For Each Node In Dvbbs.UserGroupParentID XMLDom.documentElement.appendChild(XMLDom.createNode(1,"myusergroup","")).text = Node Next ElseIf Dvbbs.IsUserPermissionOnly = 1 Then XMLDom.documentElement.appendChild(XMLDom.createNode(1,"myusergroup","")).text = Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid2").text End If End If End If If Dvbbs.Forum_ads(2)="1" or Dvbbs.Forum_ads(13)="1" Then Response.Write "" transform_BoardList() If Dvbbs.Boardid=0 Then If Dvbbs.Forum_Setting(14)="1" Or Dvbbs.Forum_Setting(15)="1" Then Response.Write "" Else Response.Write "" End If End If If Dvbbs.Forum_ads(2)="1" or Dvbbs.Forum_ads(13)="1" Then Response.Write "" End If End Sub Sub transform_BoardList() Dim proc,XMLStyle,XSLTemplate Set XSLTemplate=Dvbbs.iCreateObject("Msxml2.XSLTemplate" & MsxmlVersion) Set XMLStyle=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLStyle.loadxml template.html(0) XSLTemplate.stylesheet=XMLStyle Set proc = XSLTemplate.createProcessor() proc.input = XMLDom proc.transform() Rem Add 转换公告和文字广告 Dim procStr procStr = Replace(Dvbbs.ArchiveHtml(proc.output),"{$showNew}",ShowNews()) If Dvbbs.Boardid=0 Then procStr = Replace(procStr,"{$GetForumTextAd}",GetForumTextAd(0)) Else procStr = Replace(procStr,"{$GetForumTextAd}",GetForumTextAd(1)) End If Response.Write procStr Set XMLDom=Nothing Set proc=Nothing End Sub Function ShowNews() Dim Rs,proc,NewsDom,XMLStyle If Not IsObject(Application(Dvbbs.CacheName & "_News")) Then Set Rs=Dvbbs.Execute("Select boardid,title,addtime,bgs From Dv_bbsnews order by id desc") Set Application(Dvbbs.CacheName & "_News")=Dvbbs.RecordsetToxml(rs,"news","") End If Set NewsDom=Application(Dvbbs.CacheName & "_News").cloneNode(True) NewsDom.documentElement.setAttribute "boardid",Dvbbs.BoardID If not IsObject(Application(Dvbbs.CacheName & "_shownews_"&Dvbbs.SkinID)) Then Set Application(Dvbbs.CacheName & "_shownews_"&Dvbbs.SkinID)=Dvbbs.iCreateObject("Msxml2.XSLTemplate" & MsxmlVersion) Set XMLStyle=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLStyle.loadxml template.html(3) Application(Dvbbs.CacheName & "_shownews_"&Dvbbs.SkinID).stylesheet=XMLStyle End If Set proc = Application(Dvbbs.CacheName & "_shownews_"&Dvbbs.SkinID).createProcessor() proc.input = NewsDom proc.transform() 'Response.Write proc.output ShowNews = proc.output Set NewsDom=Nothing Set proc=Nothing End Function Sub LoadlinkList() Dim rs Set Rs=Dvbbs.Execute("select * From Dv_bbslink Order by islogo desc,id ") Set Application(Dvbbs.CacheName & "_link")=Dvbbs.RecordsetToxml(rs,"link","bbslink") Set Rs=Nothing End Sub Sub Forum_BirUser() Dim Rs,SQL,NowMonth,NowDate,todaystr0,todaystr1,node NowMonth=Month(Date()) NowDate=Day(Date()) If NowMonth< 10 Then todaystr0="0"&NowMonth Else todaystr0=CStr(NowMonth) End If If NowDate < 10 Then todaystr0=todaystr0&"-"&"0"&NowDate Else todaystr0=todaystr0&"-"&NowDate End If todaystr1=NowMonth&"-"&NowDate If todaystr0=todaystr1 Then SQL="select username,Userbirthday from [Dv_user] where Userbirthday like '%"&todaystr1&"' Order by UserID" Else SQL="select username,Userbirthday from [Dv_user] where Userbirthday like '%"&todaystr1&"' Or Userbirthday like '%"&todaystr0&"' Order by UserID" End If Set Rs=Dvbbs.Execute(SQL) Set Application(Dvbbs.CacheName & "_biruser")=Dvbbs.RecordsetToxml(rs,"user","biruser") Set Rs=Nothing For Each node In Application(Dvbbs.CacheName & "_biruser").documentElement.selectNodes("user") todaystr0=Node.selectSingleNode("@userbirthday").text If IsDate(todaystr0) Then Node.setAttribute "age",datediff("yyyy",todaystr0,Now()) Else Application(Dvbbs.CacheName & "_biruser").documentElement.removeChild(node) End If Next Application(Dvbbs.CacheName & "_biruser").documentElement.setAttribute "date",Date() 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 Sub Passport_Main() Dim UserID,ForumID,token,t,ForumMsg,toUrl,Passport UserID = Request("uid") ForumID = Request("fid") token = Request("token") Passport = Request("passport") t = Request("t") If UserID = "" Or Not IsNumeric(UserID) Then UserID = 0 UserID = cCur(UserID) If ForumID = "" Or Not IsNumeric(ForumID) Then ForumID = 0 ForumID = cCur(ForumID) If t = "" Or Not IsNumeric(t) Then t = 1 t = cCur(t) If UserID = 0 Or ForumID = 0 Or token = "" Or Passport = "" Then Response.Write "非法的参数！" Response.End End If Dim iForumUrl Select Case t Case "1" ForumMsg = "

您成功的注册了论坛通行证帐号，请牢记您填写的通行证帐号和密码。" toUrl = "reg.asp?action=redir" Case "2" ForumMsg = "

login suc。" toUrl = "login.asp?action=redir" Case Else ForumMsg = "

您成功的注册了论坛通行证帐号，请牢记您填写的通行证帐号和密码。" toUrl = "index.asp" End Select iForumUrl = toUrl & "&ErrorCode=1&ErrorMsg="&ForumMsg&"&passport="&Passport&"&token="&token %> <a href="http://www.dvbbs.net" target="_top">动网论坛_国内最大的免费论坛软件服务提供</a> 版权所有 2005 此 html 框架集显示多个 web 页。若要查看此框架集，请使用支持 html 4.0 及更高版本的 web 浏览器。 <% End Sub %>