dv_loadcache.asp

现在好了

	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("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","")