index.asp

现在好了

	Dim tmpdata,nexhour
	If Dvbbs.Forum_Setting(69)="1" Then
		tmpdata=Split(Dvbbs.Forum_Setting(70),"|")
		nexhour=Hour(Now())+1
		nexhour=nexhour mod 24
		If tmpdata(nexhour)="0" And Minute(now())>40 Then newsstr(1)=newsstr(1)&Replace(template.Strings(11),"{$LeaveTime}",(60-Minute(now())))
	End If
	TempStr=Replace(TempStr,"{$news}",newsstr(0))
	TempStr=Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
	TempStr=Replace(TempStr,"{$lastUser}",Dvbbs.CacheData(14,0))
<!--#建站天数显示代码调用开始-->
 TempStr = Replace(TempStr,"{$BuildDayNum}",datediff("d",Dvbbs.Forum_Setting(74),date()))
<!--#建站天数显示代码调用结束-->
	If Dvbbs.UserID=0 Then
		TempStr=Replace(TempStr,"{$myinfo}",Replace(TopArray(0),"{$forumname}",Dvbbs.Forum_Info(0)))
		If Dvbbs.Forum_ChanSetting(0)="1" Then TempStr=Replace(TempStr,"{$isray}",TopArray(1))
		TempStr=Replace(TempStr,"{$isray}","")
		If Dvbbs.forum_setting(79)="0" Then
			TempStr=Replace(TempStr,"{$getcode}","")
		Else
			TempStr=Replace(TempStr,"{$getcode}",template.Strings(12)&Dvbbs.GetCode())
		End If
	Else
		TopArray = Split(Dvbbs.mainhtml(12),"||")
		Dim UserMsg
		If Clng(Dvbbs.SendMsgNum)>0 Then
			UserMsg = TopArray(0)
			If Dvbbs.Forum_Setting(10)="1" Then
				UserMsg = UserMsg & TopArray(1) & TopArray(2)
			Else
				UserMsg = UserMsg & TopArray(2)
			End If
			UserMsg = Replace(UserMsg,"{$smsid}",Dvbbs.sendmsgid)
			UserMsg = Replace(UserMsg,"{$sender}",Dvbbs.sendmsguser)
			UserMsg = Replace(UserMsg,"{$newmsgnum}",Dvbbs.sendmsgnum)
		Else
			UserMsg = TopArray(3)
		End If
		Dim i,UserGroupList,iGroupName
		If Dvbbs.UserGroupParent = 4 Then
			UserMsg = UserMsg & TopArray(4)
			For i = 0 To Ubound(Dvbbs.UserGroupParentID)
				Dvbbs.Name = "GroupSetting_" & Dvbbs.UserGroupParentID(i)
				iGroupName = Split(Dvbbs.value,"§§§")(3)
				If i = 0 Then
					UserGroupList = "<a href=cookies.asp?action=ReGroup&GroupID="&Dvbbs.UserGroupParentID(i)&">"&iGroupName&"</a><BR>"
				Else
					UserGroupList = UserGroupList & "<a href=cookies.asp?action=ReGroup&GroupID="&Dvbbs.UserGroupParentID(i)&">"&iGroupName&"</a>"
				End If
			Next
			UserMsg = Replace(UserMsg,"{$UserGroupList}",UserGroupList)
		ElseIf Cint(Dvbbs.MyUserInfo(42)) > 0 Then
			UserMsg = UserMsg & TopArray(4)
			Dvbbs.Name = "GroupSetting_" & Dvbbs.MyUserInfo(42)
			iGroupName = Split(Dvbbs.value,"§§§")(3)
			UserGroupList = "<a href=cookies.asp?action=ReGroup&GroupID="&Dvbbs.MyUserInfo(43)&">"&iGroupName&"</a><BR>"
			UserMsg = Replace(UserMsg,"{$UserGroupList}",UserGroupList)
		End If
		If Dvbbs.Forum_Setting(43)="1" Then
			UserMsg = Dvbbs.lanstr(10) & UserMsg
		End If
		template.html(1) = Replace(template.html(1),"{$umsg}",UserMsg)
		TempStr=Replace(TempStr,"{$myinfo}",template.html(1))
		TempStr=Replace(TempStr,"{$UserID}",Dvbbs.Userid)
		If IsNumeric(Dvbbs.MyUserInfo(12)) And IsNumeric(Dvbbs.MyUserInfo(13)) And Dvbbs.MyUserInfo(13)<>"" And Dvbbs.MyUserInfo(12)<>"" Then
			If Clng(Dvbbs.MyUserInfo(13))=Clng(Dvbbs.Forum_Setting(39)) And Clng(Dvbbs.MyUserInfo(12))=Clng(Dvbbs.Forum_Setting(38)) Then
			TempStr=Replace(TempStr,"{$userlogo}","<img src="&Dvbbs.MyUserInfo(11)&">")
			Else
			TempStr=Replace(TempStr,"{$userlogo}","<img src="&Dvbbs.MyUserInfo(11)&" width=60 height=60>")
			End If
		Else
			TempStr=Replace(TempStr,"{$userlogo}","<img src=images/logo_2.gif>")
		End If
	End If
	If Dvbbs.Forum_ChanSetting(2)="0" Or Dvbbs.Forum_ChanSetting(1)="1" Then
		TempStr=Replace(TempStr,"{$xmlandwap}",Split(Dvbbs.mainhtml(19),"||")(0))
		If Dvbbs.Forum_ChanSetting(2)="0" Then
			TempStr=Replace(TempStr,"{$isxml}",Split(Dvbbs.mainhtml(19),"||")(1))
			TempStr=Replace(TempStr,"{$isboard}","")
		Else
			TempStr=Replace(TempStr,"{$isxml}","")
		End If
		If Dvbbs.Forum_ChanSetting(1)="1" Then
			TempStr=Replace(TempStr,"{$iswap}",Split(Dvbbs.mainhtml(19),"||")(2))
		Else
			TempStr=Replace(TempStr,"{$iswap}","")
		End If
	Else
		TempStr=Replace(TempStr,"{$xmlandwap}","")
	End If
	Response.Write Chr(10) & Replace(TempStr,"{$boardid}",Dvbbs.Boardid)
	Response.Write Chr(10) & "<SCRIPT LANGUAGE=""JavaScript"">" & Chr(10)
	Response.Write "<!--" & Chr(10)
	Response.Write Chr(9) & "var config = new Object();" & Chr(10)
	Response.Write Chr(9) & "config.Index_Top_Value = ["""&newsstr(1)&""","""&Dvbbs.CacheData(10,0)&""","""&Dvbbs.CacheData(7,0)&""","""&Dvbbs.CacheData(8,0)&""","""&Dvbbs.CacheData(9,0)&""","""&Dvbbs.CacheData(11,0)&""","""&Dvbbs.CacheData(12,0)&""","""&Dvbbs.CacheData(13,0)&"""];" & Chr(10)
	Response.Write Chr(9) & "var sa = [""Index_Top""]" & Chr(10)
	Response.Write Chr(9) & "BoardData(sa,config)" & Chr(10)
	Response.Write "//-->" & Chr(10)
	Response.Write "</SCRIPT>" & Chr(10)
End Sub
Sub Show_Index_BoardList()
	Dim Node,Nodelist,Newnode,Board_Data,LastPost,i,HaveNew,Forum_Boards,CNode,Setings,ShowMod
	If Dvbbs.BoardID=0 Then
		Set XMLDOM=Application(Dvbbs.CacheName&"_Boradlist").cloneNode(True)
		XMLDOM.validateOnParse = False
		XMLDOM.resolveExternals = False
		'XMLDOM.preserveWhiteSpace = False
		XMLDOM.documentElement.attributes.getNamedItem("boardid").text=Dvbbs.BoardID
	Else
		Set XMLDOM=Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
		XMLDOM.validateOnParse = False
		XMLDOM.resolveExternals = False
		'XMLDOM.preserveWhiteSpace = False
		XMLDOM.appendChild(XMLDOM.createElement("BoardList"))
		XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"boardid","")).text=Dvbbs.BoardID
		Set Node=Dvbbs.BoardNode.cloneNode(True)
		XMLDOM.documentElement.appendChild(Node)
		'计算下级论坛发贴总数
		Set Nodelist=Dvbbs.BoardNode.selectnodes("board")
		For Each Node in nodelist
			If node.attributes.getNamedItem("boardid").text<>CStr(Dvbbs.BoardID) Then
				ChildTopicNum = ChildTopicNum + Clng(node.attributes.getNamedItem("topicnum").text)
			End If
		Next
	End If
	'插入对应风格的图片路径 by Dv.ADRX
	XMLDOM.documentElement.attributes.setNamedItem(XMLDOM.createNode(2,"picurl","")).text=Dvbbs.Forum_PicUrl
	If Dvbbs.GroupSetting(37)="0" Then'去掉隐藏论坛
		For each node in XMLDOM.documentElement.getElementsByTagName("board")
			If node.attributes.getNamedItem("hidden").text="1" Then
				node.parentNode.removeChild(node)
			End If
		Next
	End If
	Set Nodelist=XMLDOM.documentElement.selectnodes("board")
	For Each Node in nodelist
		ShowMod=Request.Cookies("List")("list"&node.attributes.getNamedItem("boardid").text)
		If ShowMod<>"" And IsNumeric(ShowMod)Then
			node.attributes.getNamedItem("mode").text=ShowMod
		End If		
	Next
	Set Nodelist=XMLDOM.documentElement.selectnodes("board/board")
	For Each Node in nodelist
		LastPost=node.attributes.getNamedItem("lastpost2").text
		If Not IsDate(LastPost) Then LastPost=Now()
		If DateDiff("h",Dvbbs.Lastlogin,LastPost)=0 Then
			node.attributes.getNamedItem("hasnew").text=1
		End If
	Next

	Set XSLT =Application(Dvbbs.CacheName&"_indextemplate_"&Dvbbs.SkinID)
	Dim proc
	Set proc = XSLT.createProcessor()
	proc.input = XMLDOM
    	proc.transform()
    	Response.Write  proc.output
	Set XmlDom=Nothing
	Set XMLStyle=Nothing
	Set XSLT=Nothing
End Sub
Sub Show_Index_Footer()
	Dim TempStr,GetGroupTitle
	Dvbbs.GetBrowser
	Dvbbs.Name = "GroupTitle"
	GetGroupTitle = Dvbbs.Value
	TempStr = template.html(6)
	TempStr = Replace(TempStr,"{$piclist}",GetGroupTitle)
	TempStr = Replace(TempStr,"{$nonewpic}",template.pic(0))
	TempStr = Replace(TempStr,"{$isnewpic}",template.pic(1))
	TempStr = Replace(TempStr,"{$islockpic}",template.pic(2))
	Response.Write TempStr
	'进入JS赋值：用户IP、系统、浏览器、显示详细列表字样、总在线、用户在线、客人在线、最大在线、最大在线时间、论坛建立时间
	Response.Write Chr(10) & "<SCRIPT LANGUAGE=""JavaScript"">" & Chr(10)
	Response.Write "<!--" & Chr(10)
	Response.Write Chr(9) & "config.Index_Footer_Value = ["""&Dvbbs.UserTrueIP&""","""&Dvbbs.platform&""","""&Dvbbs.Browser & dvbbs.version&""","""&template.Strings(6)&""","""&MyBoardOnline.Forum_Online&""","""&MyBoardOnline.Forum_UserOnline&""","""&MyBoardOnline.Forum_GuestOnline&""","""&Dvbbs.Maxonline&""","""&Dvbbs.CacheData(6,0)&""","""&FormatDateTime(Dvbbs.Forum_Setting(74),1)&"""];" & Chr(10)
	Response.Write Chr(9) & "sa = [""Index_Footer""]" & Chr(10)
	Response.Write Chr(9) & "BoardData(sa,config)" & Chr(10)
	If Dvbbs.Forum_ads(2)="1" Then Response.Write Chr(9) & "move_ad('"&Dvbbs.Forum_ads(3)&"','"&Dvbbs.Forum_ads(4)&"','"&Dvbbs.Forum_ads(5)&"','"&Dvbbs.Forum_ads(6)&"');" & Chr(10)
	If Dvbbs.Forum_ads(13)="1" Then Response.Write Chr(9) & "fix_up_ad('"& Dvbbs.Forum_ads(8) & "','" & Dvbbs.Forum_ads(10) & "','" & Dvbbs.Forum_ads(11) & "','" & Dvbbs.Forum_ads(9) & "');" & Chr(10)
	Response.Write "//-->" & Chr(10)
	Response.Write "</SCRIPT>" & Chr(10)
	If Dvbbs.Forum_Setting(14)="1" Or Dvbbs.Forum_Setting(15)="1" Then 
		Response.Write "<iframe width=""0"" height=""0"" src=""Online.asp?action=1&Boardid=0"" name=""hiddenframe""></iframe>"
	Else
		Response.Write "<iframe width=""0"" height=""0"" src="""" name=""hiddenframe""></iframe>"
	End If
	TempStr = Null
End Sub

Sub Show_Index_BirthUser()
	Dim Strings
	Strings = Dvbbs.CacheData(16,0)
	Strings = Split(Strings,"$$")
	If Not IsDate(Strings(0)) Then Strings(0) = Now() - 1
	If CDate(Strings(0)) <> Date() Then Exit Sub
	Strings = Split(Dvbbs.CacheData(16,0),"$$")
	Strings(1) = Replace(Strings(1),"{$bpic}",template.pic(3))
	Response.Write Strings(1)
End Sub

Sub Board_Rules()
	Dim TempStr
	TempStr=Dvbbs.BoardNode.attributes.getNamedItem("rules").text
	If TempStr<>"" Then
		Response.Write Replace(template.html(14),"{$GetRules}",TempStr)
	End If
End Sub

Sub news()
	Dim TempStr,SQL
	'TempStr=Dvbbs.Board_Data(23,0)
	TempStr = Dvbbs.BoardNode.attributes.getNamedItem("boardnews").text
	SQL=Split(TempStr,"|||")
	If Ubound(SQL)<1 Then
		Exit Sub
	End If
	Dim tmpdata,nexhour
	TempStr=template.html(8)
	If Dvbbs.Board_Setting(21)="1" Then
		tmpdata=split(Dvbbs.Board_Setting(22),"|")
		nexhour=Hour(Now())+1
		nexhour=nexhour mod 24
		If tmpdata(nexhour)="0" And Minute(now())>40 Then
			sql(1)=sql(1)&"--本版将于"&(60-Minute(now()))&"分钟后暂停开放,敬请留意"
		End If
	End If
	TempStr=Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
	TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
	TempStr=Replace(TempStr,"{$news}",SQL(0)&"")
	TempStr=Replace(TempStr,"{$newstime}",SQL(1))
	Response.Write vbNewLine & TempStr
	TempStr="":SQL=Null
End Sub
Sub Board_online()
	Dim TempStr
	TempStr=template.html(9)
	TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
	TempStr=Replace(TempStr,"{$allonline}",MyBoardOnline.Forum_Online)
	TempStr=Replace(TempStr,"{$boardtype}",Dvbbs.Boardtype)
	TempStr=Replace(TempStr,"{$boardonline}",MyBoardOnline.Board_UserOnline)
	TempStr=Replace(TempStr,"{$boardguest}",MyBoardOnline.Board_GuestOnline)
	TempStr=Replace(TempStr,"{$todaynum}",Dvbbs.BoardNode.attributes.getNamedItem("todaynum").text)
	TempStr=Replace(TempStr,"{$alertcolor}",Dvbbs.mainsetting(1))
	Response.Write vbNewLine & TempStr
	TempStr=""
	If Dvbbs.forum_setting(14)="1" Or Dvbbs.forum_setting(15)="1" Then 
		Response.Write vbNewLine & "<iframe width=""0"" height=""0"" src=""Online.asp?action=1&Boardid="&Dvbbs.Boardid&""" name=""hiddenframe""></iframe>"
	Else
		Response.Write vbNewLine & "<iframe width=""0"" height=""0"" src="""" name=""hiddenframe""></iframe>"
	End If
	Response.Write vbNewLine & "<Script Language=""JavaScript"">" & vbNewLine
	Response.Write LoadToolsInfo & vbNewLine
	Response.Write "</Script>" & vbNewLine
End Sub
Sub Show_List_Top()
	Dim TempStr,TempBoardMaster,BoardMaster,i
	If Dvbbs.BoardMaster="" Then
		BoardMaster="暂无版主"
	Else
		TempBoardMaster=Split(Dvbbs.BoardMasterList & "","|")
		For i=0 To Ubound(TempBoardMaster)
			BoardMaster = BoardMaster & "<a href=dispuser.asp?name="&TempBoardMaster(i)&">"&TempBoardMaster(i)&"</a>&nbsp;"
		Next
	End If
	If (Dvbbs.Board_Setting(43)="0" And Dvbbs.Board_Setting(0)="0") Or (Dvbbs.Board_Setting(43)="0" And Dvbbs.Board_Setting(0)="1" And (Dvbbs.Master Or Dvbbs.SuperBoardMaster Or Dvbbs.BoardMaster)) Then
		TempStr=template.html(11)
		TempStr=Replace(TempStr,"{$pic_postnew}",Dvbbs.mainpic(7))
		TempStr=Replace(TempStr,"{$pic_postvote}",Dvbbs.mainpic(8))
		TempStr=Replace(TempStr,"{$pic_postxzb}",Dvbbs.mainpic(9))
	Else
		If Dvbbs.Board_Setting(0)="1" Then TempStr=template.Strings(13)
	End If
	TempStr=Replace(template.html(10),"{$showpostinfo}",TempStr)
	TempStr=Replace(TempStr,"{$page}",page)
	TempStr=Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
	TempStr=Replace(TempStr,"{$alertcolor}",Dvbbs.mainsetting(1))
	TempStr=Replace(TempStr,"{$boardmasterlist}",BoardMaster)
	TempStr=Replace(TempStr,"{$smallpaper}",Split(Dvbbs.BoardNode.attributes.getNamedItem("boardnews").text,"|||")(2))
	If Dvbbs.Forum_ChanSetting(2)="0" Or Dvbbs.Forum_ChanSetting(1)="1" Then
		TempStr=Replace(TempStr,"{$xmlandwap}",Split(Dvbbs.mainhtml(19),"||")(0))
		If Dvbbs.Forum_ChanSetting(2)="0" Then
			TempStr=Replace(TempStr,"{$isxml}",Split(Dvbbs.mainhtml(19),"||")(1))
			TempStr=Replace(TempStr,"{$isboard}",Split(Dvbbs.mainhtml(19),"||")(3))
		Else
			TempStr=Replace(TempStr,"{$isxml}","")
		End If
		If Dvbbs.Forum_ChanSetting(1)="1" Then
			TempStr=Replace(TempStr,"{$iswap}",Split(Dvbbs.mainhtml(19),"||")(2))
		Else
			TempStr=Replace(TempStr,"{$iswap}","")
		End If
	Else
		TempStr=Replace(TempStr,"{$xmlandwap}","")
	End If
	TempStr=Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
	If Dvbbs.Board_Setting(3)="1" Or Dvbbs.Board_Setting(57)="1" Then
		Dim allaudit,rs
		Set rs=dvbbs.execute("select count(*) from "&Dvbbs.Nowusebbs&" where boardid=777 and locktopic="&Dvbbs.BoardID)
		allaudit=rs(0)
		If IsNull(allaudit) Then allaudit=0
		Set Rs=Nothing
		TempStr=Replace(TempStr,"{$isaudit}","| <a href=AccessTopic.asp?boardid="&Dvbbs.BoardID&" title="&Replace(template.Strings(15),"{$auditnum}",allaudit)&">"&template.Strings(14)&"</a>(<font color="&Dvbbs.mainsetting(1)&">"&allaudit&"</font>)")
	Else
		TempStr=Replace(TempStr,"{$isaudit}","")
	End If
	If BoardTopicMode="" Then
		TempStr=Replace(TempStr,"{$topictype}","")
	Else
		TempStr=Replace(TempStr,"{$topictype}",template.html(12))
		TempStr=Replace(TempStr,"{$TopicMode}",BoardTopicMode)
	End If
	Response.Write TempStr & vbNewLine
	TempStr=Null
End Sub
Sub Chk_List_Err
	If Cint(Dvbbs.Board_Setting(2))=1 Then
		If Dvbbs.UserID=0 Then
			Dvbbs.AddErrCode(24)
		End If
	End If
	If Cint(Dvbbs.Board_Setting(1))=1 and Cint(Dvbbs.GroupSetting(37))=0 Then Dvbbs.AddErrCode(26)
	
	If Cint(Dvbbs.GroupSetting(0))=0  Then Dvbbs.AddErrCode(27)
	
	If action="batch" Then
		If CInt(Dvbbs.GroupSetting(45))<>1 Then Dvbbs.AddErrCode(28)
	End If
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
%>