dv_clsmain.asp

一个很好的论坛程序.论坛数据和程序使用最新更新29号动网7.1论坛程序美化优化设置：1.帖子中改变字体大小2.论坛信息变量3.双击下滚

		Response.Cookies(Forum_sn)("password") = ""
	End Sub
	Private Sub GetGroupSetting()
		Name="GroupSetting_"& UserGroupID
		If ObjIsEmpty() Then 
			Dim Rs,SQL
			SQL = "Select GroupSetting From [Dv_UserGroups] where UserGroupID = " & UserGroupID & ""
			Set Rs = Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				Set Rs=Nothing
				SQL = "Select GroupSetting From [Dv_UserGroups] where UserGroupID = 4"
				Set Rs = Execute(SQL)
				value=Rs(0)
			Else
				value=Rs(0)
			End If
		End If
		GroupSetting = Split(value,",")
		If Cint(GroupSetting(0))=0 And Not Page_Admin Then 
			AddErrCode "8":Showerr()
		End If
	End Sub 
	Public Sub ActiveOnline()
		Dim ReflashPageLastTime,LastVisiBoardID
		ReflashPageLastTime = Session("UserID")(1)
		LastVisiBoardID = Clng(Session("UserID")(3))
		If Not IsDate(ReflashPageLastTime) Then ReflashPageLastTime = Now()
		'当在120秒内刷新同一个页面则不更新online数据
		If DateDiff("s",ReflashPageLastTime,Now()) < 120 And LastVisiBoardID = BoardID Then Exit Sub
		'更新数组
		ReflashPageLastTime = Session("UserID")
		ReflashPageLastTime(1) = Now()
		ReflashPageLastTime(3) = Dvbbs.BoardID
		Session("UserID") = ReflashPageLastTime
		UserActiveOnline
	End Sub
	Private Sub UserActiveOnline()
		Dim Actcome,SQl,Rs
		Dim MyGroupID,uip,BrowserType
		uip = UserTrueIP
		If FoundIsChallenge and Cint(Forum_ChanSetting(0))=1 Then
			MyGroupID = 9999
		Else
			MyGroupID = UserGroupID
		End If
		If UserID = 0 Then
			Dim StatUserID
			StatUserID = Session("UserID")(0)
			SQL = "Select ID,Boardid From [Dv_Online] Where ID = " & Ccur(StatUserID)
			Set Rs = Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				If CInt(Forum_Setting(36)) = 0 Then
					Actcome = ""
				Else
					Actcome = address(uip)
				End If
				Set BrowserType=new Cls_Browser
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden) Values (" & StatUserID & ",'客人','客人','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & BrowserType.platform&"|"&BrowserType.Browser&BrowserType.version & "','" & Replace(Left(Stats,250),"'","") & "',7,'" & Actcome & "'," & Userhidden & ")"
				'更新缓存总在线数据
				MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
				Name="Forum_Online"
				value=MyBoardOnline.Forum_Online
				Set BrowserType=Nothing 
			Else
				SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = '" & Replace(Stats,"'","") & "' Where ID = " & Ccur(StatUserID)
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		Else
			SQL = "Select ID,Boardid From [DV_Online] Where UserID = " & UserID
			Set Rs = Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				If CInt(forum_setting(36)) = 0 Then
					Actcome = ""
				Else
					Actcome = address(uip)
				End If
				Set BrowserType=new Cls_Browser
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden,UserID) Values (" & Session.SessionID & ",'" & Membername & "','" & Memberclass & "','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & BrowserType.platform&"|"&BrowserType.Browser&BrowserType.version & "','" & Replace(Left(Stats,250),"'","") & "'," & MyGroupID & ",'" & Actcome & "'," & Userhidden & "," & UserID & ")"
				Set BrowserType=Nothing
				'更新缓存总在线数据
				MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
				Name="Forum_Online"
				Dvbbs.value=MyBoardOnline.Forum_Online
				'更新缓存总用户在线数据
				MyBoardOnline.Forum_UserOnline=MyBoardOnline.Forum_UserOnline+1
				Name="Forum_UserOnline"
				value=MyBoardOnline.Forum_UserOnline
			Else
				SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = '" & Replace(Stats,"'","") & "' Where UserID = " & UserID
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		End If
		'更新在线峰值
		If CLng(MyBoardOnline.Forum_Online) > CLng(Maxonline) Then
			Execute("update [Dv_setup] set Forum_Maxonline="&CLng(MyBoardOnline.Forum_Online)&",Forum_MaxonlineDate="& SqlNowString &"") 
			CacheData(5,0)=MyBoardOnline.Forum_Online
			CacheData(6,0)=Now()
			Name="setup"
			value=CacheData
		End If 
		Rem 删除超时用户
		MyBoardOnline.OnlineQuery
	End Sub
	Public Sub Nav()
		Head()
		ShowTopTable()
		IsTopTable = 1
	End Sub
	Public Sub head()
		'建立缓存
		Name="head_"&SkinID
		If ObjIsEmpty() Then
			value= Replace(Replace(mainhtml(1),"{$keyword}",Replace(Forum_info(8),"|",",")),"{$description}",Forum_info(10))&vbNewLine
		End If
		Response.Write Value
		Nowstats=stats
		Dim re
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		re.Pattern="<(.*)(.*)>(.*)<\/\1>"
		If BoardID>0 Then Stats=BoardType&"-"&Stats
		Stats=re.replace(Stats, "$3")
		Set Re=Nothing
		Stats=Server.HTMLEncode(Stats)		
		Response.Write "<title>"
		Response.Write Forum_Info(0)
		Response.Write "-"	
		Response.Write stats						
		Response.Write "</title>"
		Response.Write vbNewLine
		Response.Write Forum_CSS
		Response.Write mainhtml(2)
		'论坛防刷新设置
		If Cint(Forum_Setting(19))=1 And Not Page_Admin Then
			Dim DoReflashPage
			DoReflashPage=false
			If Trim(Forum_Setting(64))<>"" And InStr(LCase(Forum_Setting(64)),ScriptName) >0 Then DoReflashPage=True
			If (Not IsEmpty(Session("UserID")(1))) and Cint(Forum_Setting(20))>0 and DoReflashPage Then
				If DateDiff("s",Session("UserID")(1),Now())<Cint(Forum_Setting(20)) Then
					Response.Write "<META http-equiv=Content-Type content=text/html; charset=gb2312><meta HTTP-EQUIV=REFRESH CONTENT="&Forum_Setting(20)&"><br>本页面起用了防刷新机制，请不要在"&Forum_Setting(20)&"秒内连续刷新本页面<BR>正在打开页面，请稍后……"
					Response.End
				Else
					DoReflashPage=Session("UserID")
					DoReflashPage(1)=Now()
					Session("UserID")=DoReflashPage
				End If
			ElseIf IsEmpty(Session("UserID")(1)) and Cint(Forum_Setting(20))>0 and DoReflashPage Then
				DoReflashPage=Session("UserID")
				DoReflashPage(1)=Now()
				Session("UserID")=DoReflashPage
			End If
		End If
	End Sub 
	Public Sub ShowTopTable()
		Dim TempStr,ForumMenu
		If Forum_ChanSetting(0)="1" And Forum_ChanSetting(1)="1"  Then 
			If Forum_ChanSetting(2)="1" Then
				TempStr = mainhtml(3)
				TempStr = Replace(TempStr,"{$top}",adcode_4)
			End If 
			If Forum_ChanSetting(3)="1" Then Forum_ads(0)=adcode_1
		End If
		Name="Templateslist"
		If ObjIsEmpty() Then ReloadTemplateslist()
		If UserID = 0 Then 
			sysmenu = mainhtml(7)
		Else
			sysmenu = Replace(mainhtml(6),"{$username}",Membername)
			If UserHidden=2 Then
				sysmenu = Replace(sysmenu,"{$hiddeninfo}",lanstr(3))
			Else
				sysmenu = Replace(sysmenu,"{$hiddeninfo}",lanstr(4))
			End If
			If Master Then
				sysmenu = Replace(sysmenu,"{$manageinfo}",mainhtml(10))
			Else
				sysmenu = Replace(sysmenu,"{$manageinfo}","")
			End If
			If Forum_ChanSetting(0)="1" Then
				Dim RayMenuInfo,RayMenu
				RayMenuInfo = Split(mainhtml(11),"||")
				If Forum_ChanSetting(2)=2 Then RayMenu = Replace(Replace(RayMenuInfo(3),"{$channame}",CacheData(23,0)),"{$forumurl}",Forum_Info(1))
				If FoundIsChallenge Then
					RayMenu = RayMenu & RayMenuInfo(1)
				Else
					RayMenu = RayMenu & RayMenuInfo(2)
				End If
				RayMenu = Replace(RayMenuInfo(0),"{$raymenu}",RayMenu)
				sysmenu = Replace(sysmenu,"{$raymenuinfo}",RayMenu)
			Else
				sysmenu = Replace(sysmenu,"{$raymenuinfo}","")
			End If
			sysmenu = Replace(sysmenu,"{$userid}",UserID)
		End If
		Dim tmpstr,i,outstr,ioutstr,SkinID1,Csslist,CssName,k,Tempstr1,Tempstr2
'if mainhtml(9)="" then
'mainhtml(9)="<!--论坛模板和CSS风格选择部分(含7个部分) --><div class='menuitems'><a href=cookies.asp?action=stylemod&skinid=0&boardid={$boardid}>恢复默认设置</a></div>||<a  title='您当前正在使用的模板'><font color='{$alertcolor}'>{$skinname}</font></a>||<table width='160' border='0' cellspacing='0' cellpadding='0'><tr><td>{$sylelist}</td></tr></table>||<table width='95%' border='0' cellspacing='0' cellpadding='0' align='center'><tr><td>{$csslist}</td></tr></table>||&nbsp;&nbsp;&nbsp;<img id='{$skinid}' style='cursor:hand' onMouseOver='doClick();' src='Skins/Default/plus.gif' width='15' height='15'><span id='{$skinid}_' style='cursor: hand'  class='menuitems' >{$skinname}</span><span id='{$skinid}_content' style='DISPLAY: none'>{$cssinfo}</span>||<div class='menuitems'>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<img src='Skins/Default/minus.gif'><a href='cookies.asp?action=stylemod&skinid={$skinid}&boardid={$boardid}&cssid={$cssid}'>{$cssname}</a></div>||<div class='menuitems'>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<img src='Skins/Default/minus.gif'><a title='您正在使用的Css风格'><font color='{$alertcolor}'>{$cssname}</font></a></div>"
'end if
'Response.Write "错误测试："&mainhtml(0)&"<br><br>"&mainhtml(1)&"<br><br>"&mainhtml(2)&"<br><br>"&mainhtml(3)&"<br><br>"&mainhtml(4)&"<br><br>"&mainhtml(5)&"<br><br>"&mainhtml(6)&"<br><br>"&mainhtml(7)&"<br><br>"&mainhtml(8)&"<br><br>"&mainhtml(9)&"<br><br>"&mainhtml(10)&"<br><br>"
'Response.End
		mainhtml(9)=Replace(Replace(Replace(Replace(mainhtml(9),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
		tmpstr=Split(value,"@@@")
		mainhtml(9) = Split(mainhtml(9),"||")
		outstr =mainhtml(9)(2)
		ioutstr=mainhtml(9)(0)
		mainhtml(9)(5)=Replace(mainhtml(9)(5),"{$boardid}",BoardID)
		SkinID1=SkinID
		For i = 0 to UBound(tmpstr)
			tmpstr(i) = Split(tmpstr(i),"|||")
			SkinID=tmpstr(i)(0)
			Name="Forum_CSS"&SkinID
			If ObjIsEmpty() Then
				TemplatesToCache ("Forum_CSS")
			End If
			Csslist=Value
			Csslist=split(Csslist,"@@@")
			CssName=split(Csslist(0),"|||")
			Tempstr2=Replace(mainhtml(9)(4),"{$skinid}",SkinID)
			If SkinID1<>Cint(tmpstr(i)(0)) Then 
				Tempstr2=Replace(Tempstr2,"{$skinname}",tmpstr(i)(1))
			Else
				mainhtml(9)(1)=Replace(mainhtml(9)(1),"{$skinname}",tmpstr(i)(1))
				mainhtml(9)(1)=Replace(mainhtml(9)(1),"{$alertcolor}",mainsetting(1))
				Tempstr2=Replace(Tempstr2,"{$skinname}",mainhtml(9)(1))
			End If
			Tempstr1=""
			For k=0 to UBound(CssName)-1
				If k=CssID And SkinID1=Cint(tmpstr(i)(0)) Then 
					mainhtml(9)(6)=Replace(mainhtml(9)(6),"{$alertcolor}",mainsetting(1))
					Tempstr1=Tempstr1&Replace(Replace(Replace(mainhtml(9)(6),"{$skinid}",SkinID),"{$cssid}",k),"{$cssname}",CssName(k))
				Else
					Tempstr1=Tempstr1&Replace(Replace(Replace(mainhtml(9)(5),"{$skinid}",SkinID),"{$cssid}",k),"{$cssname}",CssName(k))
				End If	
			Next 
			Tempstr1=Replace(Tempstr2,"{$cssinfo}",Tempstr1)			
			ioutstr=ioutstr&Replace(mainhtml(9)(3),"{$csslist}",Tempstr1)
		Next	
		SkinID=SkinID1	
		outstr=Replace(outstr,"{$sylelist}",ioutstr)
		sysmenu = Replace(sysmenu,"{$syles}",outstr)
		TempStr = TempStr & mainhtml(4)
		TempStr = Replace(TempStr,"{$width}",mainsetting(0))
		TempStr = Replace(TempStr,"{$link}",Forum_Info(1))
		TempStr = Replace(TempStr,"{$logo}",Forum_Info(6))
		If Trim(Forum_info(7))<>"" Then
			TempStr = Replace(TempStr,"{$mailto}",Forum_Info(7))
		Else
			TempStr = Replace(TempStr,"{$mailto}","mailto:" & Forum_Info(5))
		End If
		TempStr = Replace(TempStr,"{$title}",Forum_Info(0) & "-" & stats)
		TempStr = Replace(TempStr,"{$top_ads}",Forum_ads(0))
		TempStr = Replace(TempStr,"{$menu}",sysmenu)
		TempStr = Replace(TempStr,"{$boardid}",boardid)
		TempStr = Replace(TempStr,"{$alertcolor}",mainsetting(1))
		Name = "ForumPlusMenu"&SkinID
		If ObjIsEmpty() Then ReloadForumPlusMenu()
		ForumMenu = Value
		TempStr = Replace(TempStr,"{$plusmenu}",ForumMenu)
		Response.Write TempStr		
		TempStr = ""				
	End Sub 

	Public Sub Head_var(IsBoard,idepth,GetTitle,GetUrl)
		Dim NavStr,AllBoardList
		If Dvbbs.BoardID=0 Then
			If Dvbbs.UserID>0 Then
				BoardReadme=lanstr(2) & " <b>" & Forum_Info(0) & "</b>"
			Else
				BoardReadme=lanstr(2) & " <b>" & Forum_Info(0) & "</b>"
			End If
		End if
	
		Name = "BoardJumpList"
		If ObjIsEmpty() Then LoadBoardJumpList
		BoardJumpList = Value
		BoardJumpList = Replace(BoardJumpList,"{BoardID="&BoardID&"}","selected")
		Name = "MyAllBoardList"
		If ObjIsEmpty() Then LoadAllBoardList
		'LoadAllBoardList
		AllBoardList = Value

		If BoardID>0 Then
			NavStr = " <a href="&Forum_Info(11)&" onMouseOver=""showmenu(event,'"&AllBoardList&"',0)"" style=""CURSOR:hand"">"&Forum_info(0)&"</a> → "
		Else
			NavStr = " <a href="&Forum_Info(11)&">"&Forum_info(0)&"</a> → "
		End If
		If IsBoard=1 Then
			BoardList = Board_Data(21,0)
			If BoardParentID=0 Then
				NavStr = NavStr & " <a href=""list.asp?boardid="&BoardID&""" onMouseOver=""showmenu(event,'"&BoardList&"')"">"&BoardType&"</a>"
			Else
				If ScriptName="dispbbs.asp" Then 
					NavStr = NavStr & CheckBoardInfo & " → <a href=""list.asp?boardid="&BoardID&"&page="&Request("page")&""">"&BoardType&"</a>"
				Else
					NavStr = NavStr & CheckBoardInfo & " → <a href=""list.asp?boardid="&BoardID&""">"&BoardType&"</a>"
				End If
			End If
			NavStr = NavStr & " → " & Nowstats
			If request("CatLog")="NN" Then Response.Cookies("BoardList")(BoardID & "BoardID")= "NNotShow"
			If request.cookies("BoardList")(boardid & "BoardID")="NNotShow" Then NavStr = NavStr & "&nbsp;<a href=""?BoardID="&boardid&"&cBoardid="&boardid&"&Catlog=Y"" title=""展开论坛列表"">[展开]</a>"
		Elseif IsBoard=2 Then
			NavStr = NavStr & Nowstats
		Else
			NavStr = NavStr & "<a href="&GetUrl&">"&GetTitle&"</a> → " & Nowstats
		End If
		NavStr = Replace(mainhtml(5),"{$nav}",NavStr)
		NavStr = Replace(NavStr,"{$width}",mainsetting(0))
		NavStr = Replace(NavStr,"{$boardreadme}",BoardReadme)
		If UserID>0 Then
			'sendmsgnum,sendmsgid,sendmsguser
			IsBoard = Split(mainhtml(12),"||")
			If Clng(SendMsgNum)>0 Then
				BoardReadme = IsBoard(0)
				If Forum_Setting(10)=1 Then
					BoardReadme = BoardReadme & IsBoard(1) & IsBoard(2)
				Else
					BoardReadme = BoardReadme & IsBoard(2)
				End If
				BoardReadme = Replace(BoardReadme,"{$smsid}",sendmsgid)
				BoardReadme = Replace(BoardReadme,"{$sender}",sendmsguser)
				BoardReadme = Replace(BoardReadme,"{$newmsgnum}",sendmsgnum)
				NavStr = Replace(NavStr,"{$umsg}",BoardReadme)
			Else
				NavStr = Replace(NavStr,"{$umsg}",IsBoard(3))
			End If
		Else
			NavStr = Replace(NavStr,"{$umsg}","")
		End If
		NavStr = Replace(NavStr,"{$alertcolor}",mainsetting(1))
		NavStr = Replace(NavStr,"{$showstr}","")
		Response.Write NavStr
	End Sub
	Private Function LoadBoardJumpList()
		Dim Forum_Boards,i,ii,Depth,Board_Datas
		Forum_Boards=Split(CacheData(27,0),",")
		For i=0 To Ubound(Forum_Boards)