dv_clsmain.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

        	StatsStr = Replace(StatsStr, "'", "")
        	StatsStr = Replace(StatsStr, Chr(0), "")
        	StatsStr = Replace(StatsStr, "--", "——")
        	StatsStr = Left(StatsStr, 250)
		If UserID = 0 Then
			Dim StatUserID
			StatUserID = UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text
			SQL = "Select ID,Boardid From [Dv_Online] Where ID = " & Ccur(StatUserID)
			Set Rs = Execute(SQL)
			If Rs.EOF  Then
				If IP_MAX>0 Then
					If Onlineip(UserTrueIP) > IP_MAX Then
						Session(CacheName & "UserID")=empty
						Set Dvbbs=Nothing
						Response.Status = "302 Object Moved" 
						Response.End  	
	  			End If
  			End if
				If CInt(Forum_Setting(36)) = 0 Then
					Actcome = ""
				Else
					Actcome = address(uip)
				End If
				If Cls_IsSearch Then Exit Sub  '不记录搜索引擎的客人 2004-8-30 Dv.Yz
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden,actforip) Values (" & StatUserID & ",'客人','客人','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & platform&"|"&Browser&version & "','" & StatsStr & "',7,'" & Actcome & "'," & Userhidden & ",'"& checkstr(actforip)&"')"
				'更新缓存总在线数据
				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
				SQL = "Insert Into [Dv_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,Boardid,Browser,Stats,Usergroupid,Actcome,Userhidden,UserID,actforip) Values (" & Session.SessionID & ",'" & Membername & "','" & Memberclass & "','" & UserTrueIP & "'," & SqlNowString & "," & SqlNowString & "," & Boardid & ",'" & platform&"|"&Browser&version & "','" & StatsStr & "'," & UserGroupID & ",'" & Actcome & "'," & Userhidden & "," & UserID & ",'"& checkstr(actforip)&"')"
				'更新缓存总在线数据
				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

	Function Onlineip(ip)
		Dim SQl
		SQL="Select Count(*) From Dv_online where ip='"&ip&"'"
		Onlineip=Execute(SQL)(0)
		If IsNull(Onlineip) Then Onlineip=0
	End Function
	Public Sub Nav()
		Head()
		ShowTopTable()
		IsTopTable = 1
	End Sub
	Public Sub head()
		Nowstats=stats
		If ScriptName="index.asp" Then
			If BoardType<>"" Then Stats=BoardType & Left(Replacehtml(boardreadme),20)&"...."
		ElseIf ScriptName <> "dispbbs.asp" Then
			If BoardType<>"" Then Stats=BoardType&"-"&Stats
		End If
		Stats=Replace(Stats,Chr(13),"")
		stats=Replacehtml(stats)
		'搜索引擎优化部分
		If Request("IsSearch_a") <> "" Then stats = stats & "-网站地图"
		Nowstats=Replacehtml(Nowstats)
		If IsSearch Then
			Response.Write Replace(Replace(Replace(mainhtml(1),"{$keyword}",Replace(Forum_info(8),"|",",")),"{$description}",Forum_info(10))&vbNewLine,"{$title}",stats &"["& Forum_Info(0) &"] -- Powered By Dvbbs.net," & Now())
		Else
			Response.Write Replace(Replace(Replace(mainhtml(1),"{$keyword}",Replace(Forum_info(8),"|",",")),"{$description}",Forum_info(10))&vbNewLine,"{$title}",stats &"["& Forum_Info(0) &"]")
		End If
		'搜索引擎优化结束
		Response.Write Forum_CSS
		Response.Write Chr(10)
		If Boardid=0 Then
			Response.Write "<link title="""& Forum_Info(0) &"-频道列表"" type=""application/rss+xml"" rel=""alternate"" href=""rssfeed.asp"" />"
			Response.Write Chr(10)
			Response.Write "<link title="""& Forum_Info(0) &"-最新20篇论坛主题"" type=""application/rss+xml"" rel=""alternate"" href=""rssfeed.asp?rssid=4"" />"
		Else
			Response.Write "<link title="""& Replacehtml(BoardType) &"-最新20篇论坛主题"" type=""application/rss+xml"" rel=""alternate"" href=""rssfeed.asp?boardid="&boardid&"&amp;rssid=4"" />"
		End If
		Response.Write Chr(10)
		Response.Write mainhtml(2)
		Dim node,XMLDOM
		If Not Cls_IsSearch Then
			Set XMLDOM=Application(CacheName&"_boardlist").cloneNode(True)

			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
			Response.Write "<script language=""javascript"" type=""text/javascript"">"
			'Response.Write "var boardxml='<?xml version=""1.0"" encoding=""gb2312""?>"& replace(XMLDom.documentElement.XML ,"'","\'")&"';"
			Response.Write "var boardxml='',ISAPI_ReWrite = "&isUrlreWrite&",forum_picurl='"&Forum_PicUrl&"';"
			Response.Write "</script>"
		End If
		If Cls_IsSearch Then Exit Sub
		If Forum_Setting(19)="1" And Not Page_Admin Then
			If ( Trim(Forum_Setting(64))<>"" And InStr(LCase(Forum_Setting(64)),ScriptName) >0 And Cint(Forum_Setting(20))>0) Then
				If DateDiff("s",UserSession.documentElement.selectSingleNode("userinfo/@activetime").text,Now())< Cint(Forum_Setting(20)) and boardid=CLng(UserSession.documentElement.selectSingleNode("userinfo/@boardid").text) and InStr(LCase(Cstr(Request.ServerVariables("HTTP_REFERER"))),ScriptName) > 0 Then
					Response.Write "<div style=""margin-top:24px;text-align:left;text-indent :24px;"">本页面启用了防刷新设置,请不要在"& Forum_Setting(20) &"秒内连续刷新本页面.</div>"
					Response.Write "<div style=""text-align:left;text-indent :24px;"">"&(Forum_Setting(20)-DateDiff("s",UserSession.documentElement.selectSingleNode("userinfo/@activetime").text,Now()))&"秒后将重新加载页面请稍等....</div>"
					Response.Write "<script language=""javascript"" type=""text/javascript"">"
					Response.Write "setTimeout('location.reload();',"&(Forum_Setting(20)-DateDiff("s",UserSession.documentElement.selectSingleNode("userinfo/@activetime").text,Now()))*1000&");"
					Response.Write "</script>"
					Response.Write "</body></html>"
					Set Dvbbs=Nothing
					Response.End
				Else
						UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=Now()
						UserSession.documentElement.selectSingleNode("userinfo/@boardid").text=Boardid
				End If
			End If 
		End If
	End Sub 

	Public Sub ShowTopTable()
		Dim TempStr,ForumMenu,Tempstr1
		Dim RayMenuInfo,RayMenu
		If IsSearch Then
			'搜索引擎优化部分
			'加入针对搜索引擎的导航栏,同时增加官方链接(可增加自身网站PageRank以及给官方增加搜索引擎友好度),请勿擅自取消
			sysmenu = mainhtml(20)
			Dim node,XMLDom,iTempStr
			Set XMLDOM=Application(Dvbbs.CacheName&"_boardlist").cloneNode(True)
			iTempStr = "&nbsp;&nbsp;"
			For each node in XMLDOM.documentElement.selectNodes("board[@parentid=0]")
				iTempStr = iTempStr & "<a href=""index.asp?IsSearch_a=2&BoardID="&Node.selectSingleNode("@boardid").text&""">" & Node.selectSingleNode("@boardtype").text & "</a>&nbsp;&nbsp;"
			Next
			sysmenu = Replace(sysmenu,"{$catlist}",iTempStr & "<a href=""http://www.cndw.com"" title=""论坛,bbs,免费论坛,国内最大的论坛软件服务提供商,blog,boke,博客,防火墙,插件"">动网论坛</a>&nbsp;&nbsp;<a href=""http://bbs.cndw.com"" title=""论坛,bbs,免费论坛,国内最大的论坛软件服务提供商官方讨论区,blog,boke,博客,asp,asp.net,电脑,软件,灌水,防火墙,开发,插件"">官方论坛</a>&nbsp;&nbsp;<a href=http://tool.cndw.com>站长工具</a>")
			'搜索引擎优化结束
		ElseIf 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))
			ElseIf Superboardmaster Then
				sysmenu = Replace(sysmenu,"{$manageinfo}",mainhtml(19))
			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 Dvbbs.Forum_setting(99) = "1" Then
			sysmenu = Replace(sysmenu,"{$isboke}",mainhtml(21))
		Else
			sysmenu = Replace(sysmenu,"{$isboke}","")
		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 = "style_list"
			Tempstr1=replace(Value,"$boardid",boardid)
			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"
		If ObjIsEmpty Then LoadPlusMenu()
		ForumMenu = Value
		If ForumMenu <> "" Then
			TempStr = Replace(TempStr,"{$plusmenu}",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
			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.