<% '=================================== '更新缓存函数合集 '=================================== Dim BoardListDOM Sub ReloadSetup() 'id=0, Forum_Setting=1, Forum_ads=2, Forum_Badwords=3, Forum_rBadword=4, Forum_Maxonline=5, Forum_MaxonlineDate=6, Forum_TopicNum=7, Forum_PostNum=8, Forum_TodayNum=9, Forum_UserNum=10, Forum_YesTerdayNum=11, Forum_MaxPostNum=12, Forum_MaxPostDate=13, Forum_lastUser=14, Forum_LastPost=15, Forum_BirthUser=16, Forum_Sid=17, Forum_Version=18, Forum_NowUseBBS=19, Forum_IsInstall=20, Forum_challengePassWord=21, Forum_Ad=22, Forum_ChanName=23, Forum_ChanSetting=24, Forum_LockIP=25, Forum_Cookiespath=26, Forum_Boards=27, Forum_alltopnum=28, Forum_pack=29, Forum_Cid=30, Forum_AvaSiteID=31, Forum_AvaSign=32, Forum_AdminFolder=33, Forum_BoardXML=34, Forum_Css=35 Dim Rs Set Rs = Dvbbs.Execute("Select id, Forum_Setting, Forum_ads, Forum_Badwords, Forum_rBadword, Forum_Maxonline, Forum_MaxonlineDate, Forum_TopicNum, Forum_PostNum, Forum_TodayNum, Forum_UserNum, Forum_YesTerdayNum, Forum_MaxPostNum, Forum_MaxPostDate, Forum_lastUser, Forum_LastPost, Forum_BirthUser, Forum_Sid, Forum_Version, Forum_NowUseBBS, Forum_IsInstall, Forum_challengePassWord, Forum_Ad, Forum_ChanName, Forum_ChanSetting, Forum_LockIP, Forum_Cookiespath, Forum_Boards, Forum_alltopnum, Forum_pack, Forum_Cid, Forum_AvaSiteID, Forum_AvaSign, Forum_AdminFolder, Forum_BoardXML, Forum_Css From [Dv_Setup]") Dvbbs.Name="setup" Dvbbs.Value = Rs.GetRows(1) Set Rs = Nothing Dvbbs.CacheData=Dvbbs.Value End Sub '==========MakXMLBoardList======== '作用,生成一份简单的XML数据 '参数 uporders 0不修正排序,1修正 'upRootid 0 不修正rootid 1修正 '此过程用于后台修改版面信息数据后的更新,前台勿用 Sub MakXMLBoardList(uporders,upRootid) Dim NodeList,BoardIDlist,Node,i Set BoardListDOM=Server.CreateObject("Microsoft.FreeThreadedXMLDOM") BoardListDOM.appendChild(BoardListDOM.createProcessingInstruction("xml","version=""1.0"" encoding=""gb2312""")) BoardListDOM.appendChild(BoardListDOM.createElement("BoardList")) BoardListDOM.documentElement.attributes.setNamedItem(BoardListDOM.createNode(2,"Product","")).text="Dvbbs" BoardListDOM.documentElement.attributes.setNamedItem(BoardListDOM.createNode(2,"Version","")).text=Dvbbs.CacheData(18,0) BoardListDOM.documentElement.attributes.setNamedItem(BoardListDOM.createNode(2,"Copyright","")).text="Aspsky.net" BoardListDOM.documentElement.attributes.setNamedItem(BoardListDOM.createNode(2,"boardid","")).text=0 LoadChildBoard BoardListDOM.documentElement,0 If uporders=1 Then Set NodeList=BoardListDOM.documentElement.getElementsByTagName("board") i=1 For Each Node In nodeList Dvbbs.Execute("Update Dv_board Set Orders="&i&" Where Boardid="&Node.attributes.getNamedItem("boardid").text) i=i+1 Next End If If upRootid =1 Then UpdateRootID Dvbbs.Execute("update Dv_setup Set Forum_Boards='"& Dvbbs.Checkstr(BoardListDOM.XML) &"'") '同步缓存数据 Dvbbs.CacheData(27,0)=BoardListDOM.XML Application.Lock Set Application(Dvbbs.CacheName&"_sBoradlist")= BoardListDOM.cloneNode(True) Application.UnLock Set BoardListDOM=Nothing MakXMLBoardInfo 0 End Sub '递归过程,生成XML节点 Sub LoadChildBoard(Node,ParentID) Dim Rs,Board_setting,i,ChildNode Set Rs=Dvbbs.Execute("Select boardid,boardtype,depth,Board_setting From Dv_Board where ParentID="& ParentID &" Order By RootID,orders") Do While Not Rs.EOF Board_setting=split(Rs("Board_setting")&"",",") Set ChildNode=BoardListDOM.createNode(1,"board","") For i = 0 To Rs.Fields.Count-2 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,Rs(i).name,"")).text = Rs(i)&"" Next '属性checkout 1 认证论坛 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"checkout","")).text=Board_setting(2) '属性hidden=1 隐藏论坛 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"hidden","")).text=Board_setting(1) '属性nopost 作为分类不可以发贴和回贴 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"nopost","")).text=Board_setting(43) Node.appendChild(ChildNode) LoadChildBoard ChildNode,Rs(0) Rs.MoveNext Loop Rs.Close Set Rs = Nothing End Sub Sub UpdateRootID()'修正所有版面的RootID,Child Dim Node,Nodelist,nodelist1,Node1,i Set Nodelist=BoardListDOM.documentElement.selectNodes("board") i=1 For Each Node in nodelist Set Nodelist1=node.getElementsByTagName("board") Dvbbs.Execute("Update Dv_Board Set Rootid="&i&" Where BoardID="& Node.attributes.getNamedItem("boardid").text) For Each Node1 in nodelist1 Dvbbs.Execute("Update Dv_Board Set Rootid="&i&" Where BoardID="& Node1.attributes.getNamedItem("boardid").text) Next i=i+1 Next Set Nodelist=BoardListDOM.documentElement.getElementsByTagName("board") For Each Node in nodelist Dvbbs.Execute("update Dv_Board set parentstr='"&Getparentstr(Node.attributes.getNamedItem("boardid").text,Node)&"',Child="&Node.selectNodes("board").length&" Where BoardID="& Node.attributes.getNamedItem("boardid").text) Next End Sub Function Getparentstr(BordID,Node) Dim CNode,parentstr If Not (Node.parentNode.nodeName="board") Then Getparentstr="0" Else Set CNode=Node parentstr="" Do While CNode.parentNode.nodeName="board" Set CNode=CNode.parentNode If parentstr="" Then parentstr=CNode.attributes.getNamedItem("boardid").text Else parentstr=CNode.attributes.getNamedItem("boardid").text&","&parentstr End If Loop Getparentstr=parentstr End If End Function '重新整理含版面信息的XML数据,后台使用 Sub MakXMLBoardInfo(BoardID) Dim Node,Nodelist,Fields,SQL,Rs,i,Board_setting,j,lastpost,BoardMasterList,BoardMaster,BoardNode,ChildNode Fields=LCase("boardid,BoardType,ParentID,ParentStr,Depth,RootID,Child,readme,BoardMaster,PostNum,TopicNum,indexIMG,todayNum,boarduser,LastPost,Sid,Board_Setting,Board_Ads,Board_user,IsGroupSetting,BoardTopStr,cid,Rules") If BoardID=0 Then Set BoardListDOM=Application(Dvbbs.CacheName&"_sBoradlist").cloneNode(True) SQL="Select "&Fields&" From Dv_Board Order By Rootid,orders" Else Set BoardListDOM=Application(Dvbbs.CacheName&"_Boradlist").cloneNode(True) SQL="Select "&Fields&" From Dv_Board where BoardID="& BoardID &"" End If Set Rs=Dvbbs.Execute(SQL) Fields=Split(Fields,",") Set Nodelist=BoardListDOM.documentElement.getElementsByTagName("board") If Not Rs.EOF Then SQL=Rs.GetRows(-1) i=0 For Each ChildNode in Nodelist If CStr(SQL(0,i))=ChildNode.attributes.getNamedItem("boardid").text Then Board_setting=split(SQL(16,i)&"",",") lastpost=Split(SQL(14,i)&"","$") BoardMasterList=Split(SQL(8,i)&"","|") For j=0 to UBound(sql,1) ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,Fields(j),"")).text = SQL(j,i)&"" Next '属性checklock 1 认证论坛 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"checklock","")).text=Board_setting(0) '属性checkout 1 认证论坛 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"checkout","")).text=Board_setting(2) '属性hidden=1 隐藏论坛 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"hidden","")).text=Board_setting(1) '属性 mode下属论坛显示模式 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"mode","")).text=Board_setting(39) '属性simplenessCount简洁模式每行显示数 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"simplenessCount","")).text=Board_setting(41) '属性nopost 作为分类不可以发贴和回贴 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"nopost","")).text=Board_setting(43) '该版固顶帖数 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"toptopiccount","")).text = "" '属性hasnew 有无新贴 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"hasnew","")).text=0 '公告,小字报 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"boardnews","")).text="当前没有公告|||"&Now()&"|||" 'TextAd文字广告 ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"textad","")) 'master节点集,每个版主一个节点,每个节点含序号order,版主的urlencode两个属性 j=0 For Each BoardMaster in BoardMasterlist Set BoardNode=ChildNode.appendChild(BoardListDOM.createNode(1,"boardmasterlist","")) BoardNode.attributes.setNamedItem(BoardListDOM.createNode(2,"master","")).text=BoardMaster BoardNode.attributes.setNamedItem(BoardListDOM.createNode(2,"urlencode","")).text=Server.urlencode(BoardMaster) BoardNode.attributes.setNamedItem(BoardListDOM.createNode(2,"order","")).text=j j=j+1 Next If UBound(lastpost)<6 Then ReDim lastpost(7) lastpost(2)=Now() End If For j=0 to UBound(LastPost) ChildNode.attributes.setNamedItem(BoardListDOM.createNode(2,"lastpost"&j,"")).text=LastPost(j) Next i= i+1 If BoardID>0 Then Exit For End If If i >UBound(SQL,2) Then Exit For Next Set Rs=Nothing Else Set Rs=Nothing End If '同步数据 Dvbbs.Execute("update Dv_setup Set Forum_BoardXML='"& Dvbbs.Checkstr(BoardListDOM.XML) &"'") Dvbbs.CacheData(34,0)=BoardListDOM.XML Application.Lock Set Application(Dvbbs.CacheName&"_Boradlist")= BoardListDOM.cloneNode(True) Application.UnLock Set BoardListDOM=Nothing End Sub '更新模版列表缓存 Sub ReloadTemplateslist() Dvbbs.Name="Templateslist" Dim Rs,SQL,tmpdata SQL = "select ID,StyleName from [Dv_Style]" Set Rs = Dvbbs.Execute(SQL) tmpdata = Rs.GetString(,,"|||","@@@","") tmpdata = Left(tmpdata,Len(tmpdata)-3) Set Rs = Nothing Dvbbs.value=tmpdata End Sub Sub LoadBoardNews_Paper() Dvbbs.LoadTemplates("") Dim tRs,bgs,MyGetData,TempStr,NoAnn,NoColor NoAnn = Dvbbs.lanstr(9) NoColor = Dvbbs.mainsetting(10) Dim Node,Nodelist,BoardNode Set Dvbbs.BoardXML=Application(Dvbbs.CacheName&"_Boradlist").cloneNode(True) Set Nodelist=Dvbbs.BoardXML.documentElement.getElementsByTagName("board") For Each Node in nodelist Set tRs=Dvbbs.Execute("Select Top 1 title,addtime,bgs From [Dv_bbsnews] Where boardid="&Node.attributes.getNamedItem("boardid").text&" Order By ID Desc") If tRs.BOF And tRs.EOF Then TempStr = NoAnn & "|||" Else bgs=tRs(2) If bgs="" or IsNull(bgs) Then TempStr=tRs(0) & "|||" & tRs(1) Else TempStr=""&tRs(0)&"|||"&tRs(1) End if End If '小字报部分 If IsSqlDataBase=1 Then Set tRs=Dvbbs.Execute("Select Top 5 S_id as id,S_username as postuser,S_title as topic From Dv_Smallpaper Where Datediff(D,S_addtime,"&SqlNowString&")<=1 And S_boardid="&Node.attributes.getNamedItem("boardid").text&" Order By S_addtime Desc") Else Set tRs=Dvbbs.Execute("Select Top 5 S_id as id,S_username as postuser,S_title as topic From Dv_Smallpaper Where Datediff('D',S_addtime,"&SqlNowString&")<=1 And S_boardid="&Node.attributes.getNamedItem("boardid").text&" Order By S_addtime Desc") End If If tRs.Eof And tRs.Bof Then TempStr=TempStr & "|||" Else Dim TempData,i TempData=tRs.GetRows(-1) For i=0 To Ubound(TempData,2) If i=0 Then TempStr = TempStr & "|||  "&Dvbbs.HtmlEncode(TempData(1,i))&"："&Dvbbs.HtmlEncode(TempData(2,i))&"  " Else TempStr = TempStr & "  "&Dvbbs.HtmlEncode(TempData(1,i))&"："&Dvbbs.HtmlEncode(TempData(2,i))&"  " End If Next End If Node.attributes.getNamedItem("boardnews").text = TempStr Set tRs=Nothing Next Application.Lock Set Application(Dvbbs.CacheName&"_Boradlist")=Dvbbs.BoardXML Application.unLock End Sub '输出缓存用户组GroupSetting(58)设置 （用户名在帖子内容中显示标记） 组ID,姓名代码||| Sub iGroupSetting_UserName() Dvbbs.Name="GroupSetting_UserName" Dim i,Str,OutputStr,Outputvalue Dim Rs,SQL SQL = "Select UserGroupID,GroupSetting From [Dv_UserGroups] order by UserGroupID" Set Rs = Dvbbs.Execute(SQL) Do while not Rs.Eof Str = Str & Rs(0) &","& Split(Rs(1),",")(58) Str = Str & "|||" Rs.MoveNext Loop Rs.Close : Set Rs = Nothing Dvbbs.value = Left(str,Len(str)-3) Str = Split(Dvbbs.value,"|||") For i=0 to Ubound(Str) OutputStr = Split(Str(i),",") Outputvalue = Outputvalue & "GroupUserName["&OutputStr(0)&"]='"&Replace(Replace(Replace(Replace(OutputStr(1),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")&"';" Next Dvbbs.value = "var GroupUserName = new Array(); " & Outputvalue End Sub Sub ReloadForumPlusMenu(MyskinID) Dvbbs.skinid=myskinid Dvbbs.LoadTemplates("") Dim Rs,tRs,TempMenu,TempMenu1,MSetting,i Dvbbs.Name = "ForumPlusMenu" Set Rs=Dvbbs.Execute("Select * From Dv_Plus Where Plus_Type='0' and Isuse=1 Order By ID") If Rs.Eof And Rs.Bof Then Dvbbs.Value="" Exit Sub End If i=0 Do While Not Rs.Eof If i >0 Then TempMenu=TempMenu & " " MSetting=Split(Split(Rs("Plus_Setting"),"|||")(0),"|") Set tRs=Dvbbs.Execute("Select * From Dv_Plus Where Plus_Type='"&Rs("ID")&"' and Isuse=1 Order By ID") If tRs.Eof Then Select Case MSetting(0) Case 0 TempMenu = TempMenu & ""&Rs("Plus_Name")&"" Case 1 TempMenu = TempMenu & ""&Rs("Plus_Name")&"" Case 2 TempMenu = TempMenu & ""&Rs("Plus_Name")&"" Case 3 TempMenu = TempMenu & ""&Rs("Plus_Name")&"" End Select Else TempMenu1 = TempMenu1 & "
" Do While Not tRs.Eof MSetting=Split(Split(tRs("Plus_Setting"),"|||")(0),"|") Select Case MSetting(0) Case 0 TempMenu1 = TempMenu1 & ""&tRs("Plus_Name")&"" Case 1 TempMenu1 = TempMenu1 & ""&tRs("Plus_Name")&"" Case 2 TempMenu1 = TempMenu1 & ""&tRs("Plus_Name")&"" Case 3 TempMenu1 = TempMenu1 & ""&tRs("Plus_Name")&"" End Select TempMenu1 = TempMenu1 & "
" tRs.MoveNext Loop TempMenu1 = TempMenu1 & "
" MSetting=Split(Split(Rs("Plus_Setting"),"|||")(0),"|") Select Case MSetting(0) Case 0 TempMenu = TempMenu & ""&Rs("Plus_Name")&"" Case 1 TempMenu = TempMenu & ""&Rs("Plus_Name")&"" Case 2 TempMenu = TempMenu & ""&Rs("Plus_Name")&"" Case 3 TempMenu = TempMenu & ""&Rs("Plus_Name")&"" End Select TempMenu1="" End If Rs.MoveNext i=i+1 Loop Dvbbs.Value=TempMenu Set tRs=Nothing Set Rs=Nothing End Sub Sub Index_news() Dvbbs.Name="news0" Dim tmpstr,bgs Dim Rs,SQL SQL="select top 1 title,addtime,bgs from Dv_bbsnews where boardid=0 order by id desc" Set Rs=DVbbs.Execute(sql) If Rs.BOF And Rs.EOF Then tmpstr=Dvbbs.lanstr(9)&"|||" Else bgs=Rs(2) If bgs="" or isnull(bgs) then tmpstr=Rs(0)&"|||"&Rs(1) Else tmpstr=""&Rs(0)&"|||"&Rs(1) End if End If Set Rs=Nothing Dvbbs.Value=tmpstr End Sub '生日用户 Sub Forum_BirUser() Dvbbs.LoadTemplates("index") Dim Rs,SQL,NowMonth,NowDate,TMPDATA,birthNum,tmpstr,i,todaystr0,todaystr1 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 birthNum=0 Set Rs=Dvbbs.Execute(SQL) i=0 If Not Rs.EOF Then Do while Not Rs.EOF If IsDate(Rs(1)) Then If Month(Rs(1))=NowMonth And Day(Rs(1)) Then i=i+1 tmpstr=template.Strings(10) birthNum=birthNum+1 tmpstr=Replace(tmpstr,"{$username}",rs(0)) tmpstr=Replace(tmpstr,"{$age}",datediff("yyyy",rs(1),Now())) If i=1 Then TMPDATA=TMPDATA&"" End If TMPDATA=TMPDATA&""&tmpstr&"" If i=5 Then TMPDATA=TMPDATA&"" i=0 End If End If End If Rs.MoveNext Loop If birthNum mod 5 <> 0 Then TMPDATA=TMPDATA&"" Else TMPDATA = ""&template.Strings(9)&"" End If TMPDATA=""&TMPDATA&"
" Set Rs=Nothing template.html(7)=Replace(template.html(7),"{$birthNum}",birthNum) template.html(7)=Replace(template.html(7),"{$birthday}",TMPDATA) TMPDATA=Date()&"$$"&template.html(7) Dvbbs.Execute("Update Dv_setup Set Forum_BirthUser='"&Dvbbs.Checkstr(TMPDATA)&"'") Dvbbs.ReloadSetupCache TMPDATA,16 'Response.Write TMPDATA End Sub '首页用，生成在线图例缓存 Sub Show_Index_GetGroupTitle() Dvbbs.Name="GroupTitle" Dim Rs,SQl SQL="select TitlePic,UserTitle from [Dv_UserGroups] where Orders>0 Order by Orders " Set Rs=Dvbbs.Execute(SQL) SQL=" "," ‖ "" Then Dvbbs.Name="page_"&Page_Fields&SkinID GetTemplates(Dvbbs.value) Else Exit Sub End If Dim Main_Style Dvbbs.Name = "Main_Style"&SkinID Main_Style = Replace(Dvbbs.value,"{$PicUrl}","") Main_Style = Split(Main_Style,"@@@") mainpic = Split(Main_Style(2),"|||") End Sub Sub GetTemplates(Value) Dim TemplateStr,tmpstr:TemplateStr = Value TemplateStr = Replace(TemplateStr,"{$PicUrl}","") tmpstr = Split(TemplateStr,"@@@") html = Split(tmpstr(0),"|||"):pic = Split(tmpstr(2),"|||") End Sub Sub LoadXslttemplate(myskinid) LoadTemplates "index",myskinid Dim XMLStyle,Node,CNode,XSLT,i Set XMLStyle=Server.CreateObject("Microsoft.FreeThreadedXMLDOM") 'XMLStyle.load Server.MapPath("list.xslt") XMLStyle.loadxml HTML(13) 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=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=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=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=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=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=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=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=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=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=mainpic(19) XMLStyle.documentElement.appendChild(node) Set XSLT=Server.CreateObject("Msxml2.XSLTemplate") XSLT.stylesheet=XMLStyle Application.Lock Set Application(Dvbbs.CacheName&"_listtemplate_"&myskinid)=XSLT Application.unLock Set XSLT=Nothing Set XMLStyle=Nothing Set XMLStyle=Server.CreateObject("Microsoft.FreeThreadedXMLDOM") XMLStyle.loadxml HTML(4) 'XMLStyle.load server.mappath("index_Class.xslt") For i=0 to UBound(pic)-1 Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="pic_"&i Node.attributes.setNamedItem(CNode) node.text=pic(i) XMLStyle.documentElement.appendChild(node) Next Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="links" Node.attributes.setNamedItem(CNode) node.text=Replace(html(5),"{$Getlink}",Getlink()) XMLStyle.documentElement.appendChild(node) Set XSLT=Server.CreateObject("Msxml2.XSLTemplate") XSLT.stylesheet=XMLStyle Application.Lock Set Application(Dvbbs.CacheName&"_indextemplate_"&myskinid)=XSLT Application.unLock LoadTemplates "dispbbs",myskinid Set XMLStyle=Server.CreateObject("Microsoft.FreeThreadedXMLDOM") XMLStyle.loadxml HTML(15) 'XMLStyle.load Server.mappath("dispbbs.xslt") Set XSLT=Server.CreateObject("Msxml2.XSLTemplate") XSLT.stylesheet=XMLStyle Application.Lock Set Application(Dvbbs.CacheName&"_dispbbsemplate_"&myskinid)=XSLT Application.unLock Set XSLT=Nothing Set XMLStyle=Nothing End Sub Function Getlink() Dim Rs,SQl,i,tmpstr SQL="select boardname,readme,url,logo,islogo from [Dv_bbslink] where islogo=0 Order by id" Set Rs=Dvbbs.Execute(SQL) If Not Rs.EOF Then SQL=RS.GetRows(-1) For i=0 to UBound(SQL,2) tmpstr=tmpstr & ""&SQL(0,i)&"" If i>0 And (i+1) mod 6=0 And i <> UBound(SQL,2) Then tmpstr=tmpstr & "" Next End If If tmpstr<>"" Then tmpstr=tmpstr &"
" End If SQL="select boardname,readme,url,logo,islogo from [Dv_bbslink] where islogo=1 Order by id" Set Rs=Dvbbs.Execute(SQL) If Not Rs.EOF Then SQL=RS.GetRows(-1) For i=0 to UBound(SQL,2) tmpstr=tmpstr & "" If i>0 And (i+1) mod 6=0 And i <> UBound(SQL,2) Then tmpstr=tmpstr & "" Next End If If tmpstr="" Then tmpstr=""&template.Strings(5)&"" Getlink=tmpstr Set Rs=Nothing End Function '更新所有用户组设置缓存 Sub LoadGroupSetting() Dim Rs Set Rs=Dvbbs.Execute("Select GroupSetting,UserGroupID,ParentGID,IsSetting,UserTitle From Dv_UserGroups") Do While Not Rs.Eof Dvbbs.Name="GroupSetting_" & Rs(1) Dvbbs.value=Rs(0) & "§§§" & Rs(2) & "§§§" & Rs(3) & "§§§" & Rs(4) Rs.MoveNext Loop Rs.Close Set Rs=Nothing End Sub '用户组图标缓存函数,在线状态列表可调用（用户组ID|||用户组图标） Sub GetGroupTitlePic() Dvbbs.Name="GetGroupTitlePic" Dim Rs,SQl SQL="select UserGroupID,TitlePic from [Dv_UserGroups] Order by UserGroupID " Set Rs=Dvbbs.Execute(SQL) '空数据默认为客人 SQL=Rs.GetString(,, "|||", "@@@", "messages2.gif") Rs.close:Set Rs=Nothing Dvbbs.Value = SQL End Sub '创建贴子列表使用的XML文档 Sub Maktopiclist() Dim XMLDOM,documentElement,ListNodeObject,Node Set XMLDOM=Server.CreateObject("Microsoft.FreeThreadedXMLDOM") Set documentElement=XMLDOM.createElement("topiclist") XMLDOM.appendChild(documentElement) Set ListNodeObject = XMLDOM.createNode(1,"list","") ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"title","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"istop","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"isvote","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"isbest","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"locktopic","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"child","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"hits","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"postusername","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"postuserid","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"boardid","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"TopicID","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"IsSmsTopic","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"dateandtime","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"Expression","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"topicmagicface","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"Mode","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"votetotal","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"DateDiffTime","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"TopicMode","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"LastPostUser","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"LastPostID","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"LastPostTime","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"LastPostBody","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"LastPostPic","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"LastPostUserID","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"GetMoney","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"GetMoneyType","")) ListNodeObject.attributes.setNamedItem(XMLDOM.createNode(2,"UseTools","")) Set Node = XMLDOM.createNode(1,"DvCopy","") Node.appendChild(ListNodeObject) documentElement.appendChild(node) '===============settings设置节点============== Set Node = XMLDOM.createNode(1,"settings","") Node.attributes.setNamedItem(XMLDOM.createNode(2,"alertcolor","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"timestr","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"Forum_name","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"ShowNewPic","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"titleshowlen","")) documentElement.appendChild(node) '===============info版面信息节点============== Set Node = XMLDOM.createNode(1,"info","") Node.attributes.setNamedItem(XMLDOM.createNode(2,"page","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"dispsize","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"PageSize","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"boardid","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"tablewidth","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"action","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"actionstr","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"HotTopicChild","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"topicmode","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"topiccount","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"Forum_AllTopNum","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"SelectBoardTopic","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"BoardJumpList","")) Node.attributes.setNamedItem(XMLDOM.createNode(2,"IcoLimMinute","")) documentElement.appendChild(node) Application.Lock Set Application(Dvbbs.CacheName&"_topiclist")=XMLDOM.cloneNode(True) Application.unLock Set XMLDOM=Nothing End Sub '更新单个或多个版面的信息 Sub LoadBoardsInfo(lBoardID) Dim Rs,i,SQL,LastPostInfo,TempStr,Node If Not Isnumeric(lBoardID) Then Exit Sub If lBoardID > 0 Then lBoardID = " Where BoardID = " & lBoardID Else lBoardID = "" End If 'TempStr=21=导航菜单,TempStr1=22=某类下版主版面信息,TempStr2=23=小字报和公告,TempStr3=24,cid=25 'boardid=0,BoardType=1,ParentID=2,ParentStr=3,Depth=4,RootID=5,Child=6,readme=7,BoardMaster=8,PostNum=9,TopicNum=10,indexIMG=11,todayNum=12,boarduser=13,LastPost=14,Sid=15,Board_Setting=16,Board_Ads=17,Board_user=18,IsGroupSetting=19,BoardTopStr=20,BoardID As TempStr=21,BoardID As TempStr1=22,BoardID As TempStr2=23,BoardID As TempStr3=24,cid=25,Rules=26分版规则 SQL="select boardid,BoardType,ParentID,ParentStr,Depth,RootID,Child,readme,BoardMaster,PostNum,TopicNum,indexIMG,todayNum,boarduser,LastPost,Sid,Board_Setting,Board_Ads,Board_user,IsGroupSetting,BoardTopStr,cid,Rules From Dv_board" & lBoardID If Not IsObject(Conn) Then ConnectionDatabase Set Rs=Server.CreateObject("ADODB.RecordSet") Rs.Open SQL,Conn,1,3 Do While Not Rs.Eof LastPostInfo = Split(Rs(14),"$") '修正最后回复下标越界 2005-4-18 Dv.Yz If Ubound(LastPostInfo) = 6 Then LastPostInfo = Split(Rs(14)&"$","$") If Not IsDate(LastPostInfo(2)) Then LastPostInfo(2)=Now() If DateDiff("d",LastPostInfo(2),Now())<>0 Then Rs("LastPost")=LastPostInfo(0)&"$"&LastPostInfo(1)&"$"&LastPostInfo(2)&"$"&LastPostInfo(3)&"$"&LastPostInfo(4)&"$"&LastPostInfo(5)&"$"&LastPostInfo(6)&"$"&LastPostInfo(7) Rs("TodayNum")=0 Rs.Update() For Each Node in Dvbbs.BoardXML.documentElement.getElementsByTagName("board") If Cstr(Rs(0))=Node.attributes.getNamedItem("boardid").text Then Node.attributes.getNamedItem("lastpost").text=Rs("LastPost") Node.attributes.getNamedItem("todaynum").text=0 Exit For End If Next End If Rs.MoveNext Loop Rs.Close Set Rs=Nothing End Sub %>