dv_clsmain.asp

现在好了

		Response.Cookies(Forum_sn)("password") = ""
	End Sub
	Private Sub GetGroupSetting()
		Dim tGroupSetting
		Name = "GroupSetting_" & UserGroupID
		tGroupSetting = Split(value,"§§§")
		GroupSetting = Split(tGroupSetting(0),",")
		UserGroupParent = Cint(tGroupSetting(1))
		UserGroupParentID = Split(tGroupSetting(2),"|")
		IsUserPermissionAll = MyUserInfo(Ubound(MyUserInfo)-3)
		If Cint(GroupSetting(0))=0 And Not Page_Admin Then AddErrCode "8":Showerr()
		If BoardID > 0 And Not ScriptName="showerr.asp" Then BoardInfoData=CheckBoardInfo()
		If UserID > 0 And BoardID=0 Then
			If IsUserPermissionAll="1" Then LoadUserPermission_All()
		End If
	End Sub
	'输出缓存用户组GroupSetting(58)设置 （用户名在帖子内容中显示标记） 组ID,姓名代码|||
	Public Function GroupSetting_UserName()
		Name="GroupSetting_UserName"
		GroupSetting_UserName = value
	End Function
	'用户是否存在论坛全局自定义权限
	Public Function FoundUserPermission_All()
		Dim PerRs
		FoundUserPermission_All = 0
		Set PerRs=Execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid=0 And uc_UserID="&UserID)
		If Not (PerRs.Eof And PerRs.Bof) Then FoundUserPermission_All = 1
		PerRs.Close:Set PerRs=Nothing
	End Function
	Public Sub LoadUserPermission_All()
		Dim Rs
		Set Rs=Dvbbs.execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid=0 And uc_UserID="&UserID)
		If Not(Rs.Eof And Rs.Bof) Then
			UserPermission=Split(Rs(0),",")
			GroupSetting = Split(Rs(0),",")
			FoundUserPer=True
		End If
		Set Rs=Nothing
	End Sub

	Public Sub ActiveOnline()
		Dim ReflashPageLastTime,LastVisiBoardID
		ReflashPageLastTime = Session(CacheName & "UserID")(1)
		LastVisiBoardID = Clng(Session(CacheName & "UserID")(3))
		If Not IsDate(ReflashPageLastTime) Then ReflashPageLastTime = Now()
		'当在120秒内刷新同一个页面则不更新online数据
		If DateDiff("s",ReflashPageLastTime,Now()) < 120 And LastVisiBoardID = BoardID  And Not InStr(ScriptName,"showerr")>0 Then Exit Sub
		'更新数组
		ReflashPageLastTime = Session(CacheName & "UserID")
		ReflashPageLastTime(1) = Now()
		ReflashPageLastTime(3) = Dvbbs.BoardID
		Session(CacheName & "UserID") = ReflashPageLastTime
		UserActiveOnline
	End Sub
	Private Sub UserActiveOnline()
		Dim Actcome,SQl,Rs
		Dim uip,StatsStr
			uip = UserTrueIP
        	StatsStr = Stats
        	StatsStr = Replace(StatsStr, "'", "")
        	StatsStr = Replace(StatsStr, Chr(0), "")
        	StatsStr = Replace(StatsStr, "--", "——")
        	StatsStr = Left(StatsStr, 250)
		If UserID = 0 Then
			Dim StatUserID
			StatUserID = Session(CacheName & "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
				GetBrowser()
				'不记录搜索引擎的客人 2004-8-30 Dv.Yz
				If IsSearch  Or (Browser="unknown" And Version="unknown" And Platform="unknown") Then
					Exit Sub  
				End If
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden) Values (" & StatUserID & ",'客人','客人','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & platform&"|"&Browser&version & "','" & StatsStr & "',7,'" & Actcome & "'," & Userhidden & ")"
				'更新缓存总在线数据
				MyBoardOnline.Forum_Online=MyBoardOnline.Forum_Online+1
				Name="Forum_Online"
				value=MyBoardOnline.Forum_Online 
			Else
				SQL = "Update [Dv_Online] Set Lastimebk = " & SqlNowString & ",Boardid = " & Boardid & ",Stats = '" & StatsStr & "' 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
				GetBrowser
				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 & ",'" & platform&"|"&Browser&version & "','" & StatsStr & "'," & UserGroupID & ",'" & Actcome & "'," & Userhidden & "," & UserID & ")"
				'更新缓存总在线数据
				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 = '" & StatsStr & "' 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()
		Nowstats=stats
		If BoardID > 0 And ScriptName<>"printpage.asp" Then Stats=BoardType&"-"&Stats
		Stats=Replace(Stats,Chr(34),"&quot;")
		Stats=Replace(Stats,Chr(13),"")
		Dim re,TitleStats
		Set re=new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern="<(.[^>]*)>"
			TitleStats=re.Replace(Stats, "")
			re.Pattern=""""
			TitleStats=re.Replace(TitleStats, "&quot;")
		Set Re=Nothing
		Response.Write Replace(Replace(Replace(mainhtml(1),"{$keyword}",Replace(Forum_info(8),"|",",")),"{$description}",Forum_info(10))&vbNewLine,"{$title}",Forum_Info(0)&"-"&TitleStats)
		Response.Write Forum_CSS
		Response.Write Chr(10)
		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(CacheName & "UserID")(1))) And Cint(Forum_Setting(20))>0 And DoReflashPage Then
				If DateDiff("s",Session(CacheName & "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(CacheName & "UserID")
					DoReflashPage(1)=Now()
					Session(CacheName & "UserID")=DoReflashPage
				End If
			ElseIf IsEmpty(Session(CacheName & "UserID")(1)) and Cint(Forum_Setting(20))>0 and DoReflashPage Then
				DoReflashPage=Session(CacheName & "UserID")
				DoReflashPage(1)=Now()
				Session(CacheName & "UserID")=DoReflashPage
			End If
		End If
	End Sub 
	Public Sub ShowTopTable()
		Dim TempStr,ForumMenu,Tempstr1
		Dim RayMenuInfo,RayMenu
		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 Or GroupSetting(70)="1" Then
				sysmenu = Replace(sysmenu,"{$manageinfo}",mainhtml(10))
			Else
				sysmenu = Replace(sysmenu,"{$manageinfo}","")
			End If
			If Forum_ChanSetting(0)="1" Then
				RayMenuInfo = Split(mainhtml(11),"||")
				RayMenu = Replace(Replace(RayMenuInfo(4),"{$channame}",CacheData(23,0)),"{$forumurl}",Forum_Info(1))
				If FoundIsChallenge Then
					RayMenu = RayMenu & RayMenuInfo(2)
				Else
					RayMenu = RayMenu & RayMenuInfo(3)
				End If
				RayMenu = Replace(RayMenuInfo(1),"{$raymenu}",RayMenu)
				sysmenu = Replace(sysmenu,"{$raymenuinfo}",RayMenuInfo(0))
			Else
				sysmenu = Replace(sysmenu,"{$raymenuinfo}","")
			End If
			sysmenu = Replace(sysmenu,"{$userid}",UserID)
			Response.Write RayMenu
		End If
		If Forum_Setting(90)=0 Then 
			sysmenu = Replace(sysmenu,"{$Plus_Tools}","")
		Else
			sysmenu = Replace(sysmenu,"{$Plus_Tools}",mainhtml(16))
		End If
		If GroupSetting(57) = "1" Then
			Name = "StyleList_All"
			Tempstr1=Value
			If Dvbbs.BoardID = 0 Then
				TempStr1 = Replace(TempStr1,"{$dskinid}",CacheData(17,0))
			Else
				TempStr1 = Replace(TempStr1,"{$dskinid}",Sid)
			End If
		Else
			mainhtml(9)=Replace(Replace(Replace(Replace(mainhtml(9),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
			mainhtml(9) = Split(mainhtml(9),"||")
			Tempstr1=Replace(Replace(mainhtml(9)(0),"{$dskinid}",CacheData(17,0)),"{$csslist}","")
		End If
		sysmenu = Replace(sysmenu,"{$syles}",Tempstr1)
		TempStr = TempStr & Chr(10) & mainhtml(4)
		TempStr = Replace(TempStr,"{$width}",mainsetting(0))
		TempStr = Replace(TempStr,"{$link}",Forum_Info(1))
		If Boardid>0 Then 
			If Board_Setting(51)="" Or Board_Setting(51) = "0"  Then
				TempStr = Replace(TempStr,"{$logo}",Forum_Info(6))
			Else
				TempStr = Replace(TempStr,"{$logo}",Board_Setting(51))
			End If
		Else
			TempStr = Replace(TempStr,"{$logo}",Forum_Info(6))
		End If
		If Trim(Forum_info(7))<>"0" And 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) & "-" & Replace(stats,"'","\'"))
		TempStr = Replace(TempStr,"{$top_ads}",Forum_ads(0))
		TempStr = Replace(TempStr,"{$menu}",Chr(10) & sysmenu)
		TempStr = Replace(TempStr,"{$boardid}",boardid)
		TempStr = Replace(TempStr,"{$alertcolor}",mainsetting(1))
		Name = "ForumPlusMenu"
		ForumMenu = Value
		If ForumMenu <> "" Then
			TempStr = Replace(TempStr,"{$plusmenu}"," <img src="&mainpic(18)&" align=absmiddle> " & ForumMenu)
		Else
			TempStr = Replace(TempStr,"{$plusmenu}","")
		End If
		Response.Write TempStr
		TempStr = ""
	End Sub 
	Public Sub Head_var(IsBoard,idepth,GetTitle,GetUrl)
		Dim NavStr,AllBoardList
		If Dvbbs.BoardID=0 Then BoardReadme=lanstr(2) & " <b>" & Forum_Info(0) & "</b>"
		If BoardID>0 Then
			NavStr = " <a href="&Forum_Info(11)&" onMouseOver=""showmenu(event,BoardJumpList(0),'',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
			BoardType = Replace(Replace(BoardType,Chr(39),"&#39;"),Chr(34), "&#34;")
			If BoardParentID=0 Then
				NavStr = NavStr & " <a href=""index.asp?boardid="&BoardID&""" onMouseOver=""showmenu(event,BoardJumpList("&Dvbbs.Boardid&"),'',0);"">"&BoardType&"</a>"
			Else
				If ScriptName="dispbbs.asp" Then 
					NavStr = NavStr & BoardInfoData & " → <a href=""index.asp?boardid="&BoardID&"&page="&Request("page")&""">"&BoardType&"</a>"
				Else
					NavStr = NavStr & BoardInfoData & " → <a href=""index.asp?boardid="&BoardID&""">"&BoardType&"</a>"
				End If
			End If
			NavStr = NavStr & " → " & Nowstats
		Elseif IsBoard=2 Then
			NavStr = NavStr & Nowstats
		Else
			NavStr = NavStr & "<a href="&GetUrl&">"&GetTitle&"</a> → " & Nowstats
		End If
		BoardReadme=Replace(Replace(Replace(BoardReadme&"","\n",""),"\r",""),"\","")
		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)
			Else
				BoardReadme = IsBoard(3)
			End If
			Dim i,UserGroupList,iGroupName
			IsUserPermissionOnly = MyUserInfo(Ubound(MyUserInfo)-2)
			If UserGroupParent = 4 Then
				BoardReadme = BoardReadme & IsBoard(4)
				For i = 0 To Ubound(UserGroupParentID)
					Name = "GroupSetting_" & UserGroupParentID(i)
					iGroupName = Split(value,"§§§")(3)
					If i = 0 Then
						UserGroupList = "<a href=cookies.asp?action=ReGroup&GroupID="&UserGroupParentID(i)&">"&iGroupName&"</a><BR>"
					Else
						UserGroupList = UserGroupList & "<a href=cookies.asp?action=ReGroup&GroupID="&UserGroupParentID(i)&">"&iGroupName&"</a>"
					End If
				Next
				BoardReadme = Replace(BoardReadme,"{$UserGroupList}",UserGroupList)
			ElseIf Cint(IsUserPermissionOnly) > 0 Then
				BoardReadme = BoardReadme & IsBoard(4)
				Name = "GroupSetting_" & IsUserPermissionOnly
				iGroupName = Split(value,"§§§")(3)
				UserGroupList = "<a href=cookies.asp?action=ReGroup&GroupID="&IsUserPermissionOnly&">"&iGroupName&"</a><BR>"
				BoardReadme = Replace(BoardReadme,"{$UserGroupList}",UserGroupList)
			End If
			NavStr = Replace(NavStr,"{$umsg}",BoardReadme)
		Else
			NavStr = Replace(NavStr,"{$umsg}","")
		End If
		NavStr = Replace(NavStr,"{$alertcolor}",mainsetting(1))