dv_loadcache.asp

现在好了

<%
'===================================
'更新缓存函数合集
'===================================
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="<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