<%
'===================================
'更新缓存函数合集
'===================================
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("Msxml2.FreeThreadedDOMDocument")
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="sg188.com"
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="<img src=Skins/Default/filetype/mid.gif border=0><bgsound src="&bgs&" border=0>"&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 & "|||&nbsp;&nbsp;<font color="&NoColor&">"&Dvbbs.HtmlEncode(TempData(1,i))&"</font>：<a href=javascript:openScript(""viewinfo.asp?id="&TempData(0,i)&"&boardid="&Node.attributes.getNamedItem("boardid").text&""",500,400)>"&Dvbbs.HtmlEncode(TempData(2,i))&"</a>&nbsp;&nbsp;"
Else
TempStr = TempStr & "&nbsp;&nbsp;<font color="&NoColor&">"&Dvbbs.HtmlEncode(TempData(1,i))&"</font>：<a href=javascript:openScript(""viewinfo.asp?id="&TempData(0,i)&"&boardid="&Node.attributes.getNamedItem("boardid").text&""",500,400)>"&Dvbbs.HtmlEncode(TempData(2,i))&"</a>&nbsp;&nbsp;"
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 & " <img src="& Dvbbs.mainpic(18)&" align=""absmiddle""> "
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 & "<a href="""&Rs("MainPage")&""" title="""&Rs("Plus_CopyRight")&""">"&Rs("Plus_Name")&"</a>"
Case 1
TempMenu = TempMenu & "<a href="""&Rs("MainPage")&""" title="""&Rs("Plus_CopyRight")&""" target=_blank>"&Rs("Plus_Name")&"</a>"
Case 2
TempMenu = TempMenu & "<a href=""JavaScript:openScript('"&Rs("MainPage")&"',"&MSetting(1)&","&MSetting(2)&")"" title="""&Rs("Plus_CopyRight")&""">"&Rs("Plus_Name")&"</a>"
Case 3
TempMenu = TempMenu & "<a href=""JavaScript:openScript('"&Rs("MainPage")&"',screen.width,screen.height)"" title="""&Rs("Plus_CopyRight")&""">"&Rs("Plus_Name")&"</a>"
End Select
Else
TempMenu1 = TempMenu1 & "<div class=menuitems>"
Do While Not tRs.Eof
MSetting=Split(Split(tRs("Plus_Setting"),"|||")(0),"|")
Select Case MSetting(0)
Case 0
TempMenu1 = TempMenu1 & "<a href="&tRs("MainPage")&" title="&tRs("Plus_CopyRight")&">"&tRs("Plus_Name")&"</a>"
Case 1
TempMenu1 = TempMenu1 & "<a href="&tRs("MainPage")&" title="&tRs("Plus_CopyRight")&" target=_blank>"&tRs("Plus_Name")&"</a>"
Case 2
TempMenu1 = TempMenu1 & "<a href=JavaScript:openScript(\'"&tRs("MainPage")&"\',"&MSetting(1)&","&MSetting(2)&") title="&tRs("Plus_CopyRight")&">"&tRs("Plus_Name")&"</a>"
Case 3
TempMenu1 = TempMenu1 & "<a href=JavaScript:openScript(\'"&tRs("MainPage")&"\',screen.width,screen.height) title="&tRs("Plus_CopyRight")&">"&tRs("Plus_Name")&"</a>"
End Select
TempMenu1 = TempMenu1 & "<br>"
tRs.MoveNext
Loop
TempMenu1 = TempMenu1 & "</div>"
MSetting=Split(Split(Rs("Plus_Setting"),"|||")(0),"|")
Select Case MSetting(0)
Case 0
TempMenu = TempMenu & "<a href="""&Rs("MainPage")&""" title="""&Rs("Plus_CopyRight")&""" onMouseOver=""showmenu(event,'"&TempMenu1&"')"">"&Rs("Plus_Name")&"</a>"
Case 1
TempMenu = TempMenu & "<a href="""&Rs("MainPage")&""" title="""&Rs("Plus_CopyRight")&""" target=_blank onMouseOver=""showmenu(event,'"&TempMenu1&"')"">"&Rs("Plus_Name")&"</a>"
Case 2
TempMenu = TempMenu & "<a href=""JavaScript:openScript('"&Rs("MainPage")&"',"&MSetting(1)&","&MSetting(2)&")"" title="""&Rs("Plus_CopyRight")&""" onMouseOver=""showmenu(event,'"&TempMenu1&"')"">"&Rs("Plus_Name")&"</a>"
Case 3
TempMenu = TempMenu & "<a href=""JavaScript:openScript('"&Rs("MainPage")&"',screen.width,screen.height)"" title="""&Rs("Plus_CopyRight")&""" onMouseOver=""showmenu(event,'"&TempMenu1&"')"">"&Rs("Plus_Name")&"</a>"
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="<img src=Skins/Default/filetype/mid.gif border=0><bgsound src="&bgs&" border=0>"&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&"<tr>"
End If
TMPDATA=TMPDATA&"<td>"&tmpstr&"</td>"
If i=5 Then
TMPDATA=TMPDATA&"</tr>"
i=0
End If
End If
End If
Rs.MoveNext
Loop
If birthNum mod 5 <> 0 Then TMPDATA=TMPDATA&"</tr>"
Else
TMPDATA = "<tr><td>"&template.Strings(9)&"</td></tr>"
End If
TMPDATA="<TABLE cellSpacing=2 cellPadding=2 width=100% border=0>"&TMPDATA&"</table>"
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="<img src="""&Dvbbs.Forum_PicUrl&""&RS.GetString (,,"""> ","    ‖ <img src="""&Dvbbs.Forum_PicUrl&"","")
SQl=Left(SQL,Len(SQL)-Len("    ‖ <img src="""&Dvbbs.Forum_PicUrl&""))
Dvbbs.Value = SQL
Set rs=Nothing
End Sub
'生成风格选择列表
Sub LoadStyleList_All()
Dvbbs.LoadTemplates("")
Dim Csslist,CssName,k,iCssID,iStyleName,Tempstr1
Dvbbs.mainhtml(9) = Replace(Replace(Replace(Replace(Dvbbs.mainhtml(9),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
Dvbbs.mainhtml(9) = Split(Dvbbs.mainhtml(9),"||")
Csslist=Dvbbs.CacheData(35,0)
Csslist=split(Csslist,"@@@")
CssName=split(Csslist(0),"|||")
iCssID=split(Csslist(3),"|||")
For k=0 to UBound(CssName)-1
Dvbbs.Name="StyleName"&iCssID(k)
iStyleName=Dvbbs.value
Tempstr1=Tempstr1&Replace(Replace(Replace(Dvbbs.mainhtml(9)(1),"{$skinid}",k),"{$cssname}",CssName(k)),"{$skinname}",iStyleName)
Next 
Tempstr1=Replace(Dvbbs.mainhtml(9)(0),"{$csslist}",Tempstr1)
Dvbbs.Name = "StyleList_All"
Dvbbs.Value=Tempstr1
End Sub
'查询一次加载或更新所有的模板数据缓存
Sub TemplatesToCache()
Dim Rs,SQL,i,Main_Style
SQL = "Select * from [Dv_Style]"
Set Rs = Dvbbs.Execute(SQL)
Do while Not Rs.EOF
For i=1 to Rs.Fields.Count-1
Dvbbs.Name=Rs(i).name & Rs(0)
Dvbbs.value=Rs(i)&""
Next
LoadXslttemplate Rs(0)
Rs.MoveNext
Loop
Rs.MoveFirst
Do while Not Rs.EOF
ReloadForumPlusMenu Rs(0)
Rs.MoveNext
Loop
Set Rs = Nothing
End Sub

'以下专为Cache那三个XSLT服务 by Dv.ADRX
Dim mainpic,html,pic,Strings
Sub LoadTemplates(Page_Fields,SkinID)
If Page_Fields<>"" 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),"|||"):Strings = Split(tmpstr(1),"|||"):pic = Split(tmpstr(2),"|||")
End Sub
Sub LoadXslttemplate(myskinid)
LoadTemplates "index",myskinid
Dim XMLStyle,Node,CNode,XSLT,i
Set XMLStyle=Server.CreateObject("Msxml2.FreeThreadedDOMDocument")
'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("Msxml2.FreeThreadedDOMDocument")
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("Msxml2.FreeThreadedDOMDocument")
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 & "<td width=""16%""><a href="""& SQL(2,i) &""" target=""_blank"" title="""&SQL(1,i)&""">"&SQL(0,i)&"</a></td>"
If i>0 And (i+1) mod 6=0 And i <> UBound(SQL,2) Then tmpstr=tmpstr & "</tr><tr>"
Next
End If
If tmpstr<>"" Then
tmpstr=tmpstr &"<tr><td colspan=""6""><hr></td></tr><tr>"
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 & "<td width=""16%""><a href="""& SQL(2,i) &""" target=""_blank"" title="""&SQL(1,i)&"""><img border=0 src="""&SQL(3,i)&"""  height=31 width=88></a></td>"
If i>0 And (i+1) mod 6=0 And i <> UBound(SQL,2) Then tmpstr=tmpstr & "</tr><tr>"
Next
End If
If tmpstr="" Then tmpstr="<td colSpan=6 align=left width=""100%"">&nbsp;</td>"
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("Msxml2.FreeThreadedDOMDocument")
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()

'------------------------------------
Set node = Dvbbs.BoardXML.selectSingleNode("//*[@boardid='"&Rs(0)&"']")
If not (node is nothing) Then
'------------------------------------
'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
End If
Rs.MoveNext
Loop
Rs.Close
Set Rs=Nothing
End Sub
%>
