<% Rem 首页页面设置 Const CachePage=false '是否做页面缓存 Const CacheTime=60 '缓存失效时间 Dim XMLDom,page,TopicMode,Cmd If Request("w") = "1" Then Passport_Main() Response.End End If If (Not Response.IsClientConnected) and Dvbbs.userid=0 Then Session(Dvbbs.CacheName & "UserID")=empty Response.Clear Response.End Else If Request("action")="xml" Then Showxml() Elseif Request("action")="frameon" Then ShowIsleft() Else Main() End If End If 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 %> <%=Dvbbs.Forum_Info(0)%>
<% 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=Replace(template.Strings(0),"动网先锋论坛",Dvbbs.Forum_Info(0)) Response.Write Dvbbs.mainhtml(18) Dvbbs.Nav() Dvbbs.ActiveOnline() GetForumTextAd(0) BoardList() 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 Response.Write Dvbbs.mainhtml(18) 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 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 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 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() If (Not Response.IsClientConnected) and Dvbbs.userid=0 Then Session(Dvbbs.CacheName & "UserID")=empty Response.Clear Response.End End If 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 = 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 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 = 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&" 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() If (Not Response.IsClientConnected) and Dvbbs.userid=0 Then Response.Clear Session(Dvbbs.CacheName & "UserID")=empty Response.End End If Dim proc,XMLStyle,node,cnode If Not IsObject(Application(Dvbbs.CacheName & "_listtemplate_"& Dvbbs.SkinID)) Then Set Application(Dvbbs.CacheName & "_listtemplate_"& Dvbbs.SkinID)=Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion ) Set XMLStyle=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion ) XMLStyle.loadxml template.html(1) ' 'XMLStyle.load Server.MapPath("list.xslt") '插入各种图片的设置数据 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) Application(Dvbbs.CacheName & "_listtemplate_"& Dvbbs.SkinID).stylesheet=XMLStyle End If Set proc = Application(Dvbbs.CacheName & "_listtemplate_"& Dvbbs.SkinID).createProcessor() proc.input = XMLDom 'test 'XMLDom.save Server.MapPath("list.asp.xml") proc.transform() Response.Write Dvbbs.ArchiveHtml(proc.output) 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() 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 "" '插入圈子信息 If Not IsObject(Application(Dvbbs.CacheName&"_indivgroup")) Then Call CreatedIndivGroup Else '两个小时更新一次 If Not Application(Dvbbs.CacheName&"_indivgroup") Is Nothing Then If DateDiff("h",Now(),Cdate(Application(Dvbbs.CacheName&"_indivgroup").documentElement.getAttribute("datecreated")))>2 Then Call CreatedIndivGroup End If Else Call CreatedIndivGroup End If End If XMLDom.documentElement.appendChild(Application(Dvbbs.CacheName&"_indivgroup").documentElement.cloneNode(True)) 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 CreatedIndivGroup Dim Rs,IndivGroupXMLDom,Node Set IndivGroupXMLDom = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) IndivGroupXMLDom.appendChild(IndivGroupXMLDom.createElement("indivgroup")) Set Rs = Dvbbs.Execute("Select Top 3 * From Dv_GroupName Where Stats>0 Order By ID Desc") Set Node = Dvbbs.RecordsetToxml(Rs,"row","newigroup") IndivGroupXMLDom.documentElement.appendChild(Node.documentElement.cloneNode(True)) Rs.Close Set Rs = Dvbbs.Execute("Select Top 3 * From Dv_GroupName Where Stats>0 Order By PostNum Desc,ID") Set Node = Dvbbs.RecordsetToxml(Rs,"row","activityigroup") IndivGroupXMLDom.documentElement.appendChild(Node.documentElement.cloneNode(True)) Rs.Close Set Rs = Dvbbs.Execute("Select Top 3 * From Dv_GroupName Where Stats>0 Order By UserNum Desc,ID") Set Node = Dvbbs.RecordsetToxml(Rs,"row","hotigroup") IndivGroupXMLDom.documentElement.appendChild(Node.documentElement.cloneNode(True)) Rs.Close:Set Rs=Nothing IndivGroupXMLDom.documentElement.setAttribute "datecreated",now() Set Application(Dvbbs.CacheName&"_indivgroup")=IndivGroupXMLDom End Sub Sub transform_BoardList() Dim proc,XMLStyle If (Not Response.IsClientConnected) and Dvbbs.userid=0 Then Response.Clear Session(Dvbbs.CacheName & "UserID")=empty Response.End Else If Not IsObject(Application(Dvbbs.CacheName & "_indextemplate_"& Dvbbs.SkinID)) Then Set Application(Dvbbs.CacheName & "_indextemplate_"& Dvbbs.SkinID)=Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion) Set XMLStyle=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLStyle.loadxml template.html(0) ' Server.MapPath("index.xslt") 'XMLStyle.load Server.MapPath("index.xslt") Application(Dvbbs.CacheName & "_indextemplate_"& Dvbbs.SkinID).stylesheet=XMLStyle End If Set proc = Application(Dvbbs.CacheName & "_indextemplate_"& Dvbbs.SkinID).createProcessor() proc.input = XMLDom proc.transform() Response.Write Dvbbs.ArchiveHtml(proc.output) 'XMLDom.save Server.MapPath("index.xml") Set XMLDom=Nothing Set proc=Nothing End If End Sub Sub 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)=Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion) Set XMLStyle=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion) If UBound(template.html)>3 Then XMLStyle.loadxml template.html(3) Else XMLStyle.load Server.MapPath(MyDbPath &"inc\Templates\Dv_News.xslt") End If 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 Set NewsDom=Nothing Set proc=Nothing End Sub 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 %> 欢迎访问<%=Dvbbs.Forum_Info(0)%> <a href="#" target="_top">曙海</a> 版权所有 2005 此 html 框架集显示多个 web 页。若要查看此框架集,请使用支持 html 4.0 及更高版本的 web 浏览器。 <% End Sub %>