dv_clsmain.asp

品泡女人香XI8.NET文章管理系统的源码

				sendmsguser=Usermsg(2)
			End If
		End If
		FoundUser=True
		MyUserInfo(15)=Lastlogin
		Session(CacheName & "UserID")=MyUserInfo
	End Sub
	Public Sub EmptyCookies()
		Response.Cookies(Forum_sn)("usercookies") = 0
		Response.Cookies(Forum_sn).path=cookiepath
		Response.Cookies(Forum_sn)("username") = ""
		Response.Cookies(Forum_sn)("UserID") = 0
		Response.Cookies(Forum_sn)("userclass") = ""
		Response.Cookies(Forum_sn)("userhidden") = 2
		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 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()
		If BoardID <> 0 And Not ScriptName="showerr.asp" Then BoardInfoData=CheckBoardInfo()
	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 MyGroupID,uip,BrowserType,StatsStr
			uip = UserTrueIP
        	StatsStr = Stats
        	StatsStr = Replace(StatsStr, "'", "")
        	StatsStr = Replace(StatsStr, Chr(0), "")
        	StatsStr = Replace(StatsStr, "--", "——")
        	StatsStr = Left(StatsStr, 250)
		If FoundIsChallenge and Cint(Forum_ChanSetting(0))=1 Then
			MyGroupID = 9999
		Else
			MyGroupID = UserGroupID
		End If
		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
				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 & "','" & StatsStr & "',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 = '" & 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
				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 & "','" & StatsStr & "'," & 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 = '" & 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()
		'建立缓存
		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="<(.[^>]*)>"
			If BoardID > 0 And ScriptName<>"printpage.asp" Then Stats=BoardType&"-"&Stats
			Stats=re.Replace(Stats, "")
			re.Pattern=""""
			Stats=re.Replace(Stats, "&quot;")
		Set Re=Nothing
		Stats=Replace(Stats,chr(13),"")
		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(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
		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
		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))
		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}",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
			BoardReadme=lanstr(2) & " <b>" & Forum_Info(0) & "</b>"
		End if
		If GroupSetting(37)="0" Then
			Name = "BoardJumpList_g"
			If ObjIsEmpty() Then LoadBoardJumpList(0)
		Else
			Name = "BoardJumpList"
			If ObjIsEmpty() Then LoadBoardJumpList(1)
		End If
		BoardJumpList = Value
		BoardJumpList = Replace(BoardJumpList,"{BoardID="&BoardID&"}","selected")
		If GroupSetting(37)="0" Then
			Name = "MyAllBoardList_g"
			If ObjIsEmpty() Then LoadAllBoardList(0)
		Else
			Name = "MyAllBoardList"
			If ObjIsEmpty() Then LoadAllBoardList(1)
		End If
		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
			If GroupSetting(37)="0" Then
				BoardList = Board_Data(26,0)
			Else
				BoardList = Board_Data(21,0)
			End If
			BoardType = Replace(Replace(BoardType,Chr(39),"&#39;"),Chr(34), "&#34;")
			If BoardParentID=0 Then
				NavStr = NavStr & " <a href=""list.asp?boardid="&BoardID&""" onMouseOver=""showmenu(event,'"&BoardList&"',0)"">"&BoardType&"</a>"
			Else
				If ScriptName="dispbbs.asp" Then 
					NavStr = NavStr & BoardInfoData & " → <a href=""list.asp?boardid="&BoardID&"&page="&Request("page")&""">"&BoardType&"</a>"
				Else
					NavStr = NavStr & BoardInfoData & " → <a href=""list.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