dv_clsmain.asp

现在好了

<%
'=========================================================
' File: Dv_ClsMain.asp
' Version:7.0 sp3
' Date: 2004-6-30
' Script Written by dvbbs.net
'=========================================================
' Copyright (C) 2003,2004 AspSky.Net. All rights reserved.
' Web: http://www.aspsky.net,http://www.dvbbs.net
' Email: [e-mail]
'=========================================================
'是否商业版，非官方SQL版本请在此设置为0以及在Conn中设置论坛为SQL数据库，否则显示不正常
Const IsBuss=1
Const Dvbbs_Server_Url = "http://server.dvbbs.net/"
Class Cls_Forum
	Rem Const
	Public BoardID,SqlQueryNum,Forum_Info,Forum_Setting,Forum_user,Forum_Copyright,Forum_ads,Forum_ChanSetting,Forum_UploadSetting
	Public Forum_sn,Forum_Version,Stats,StyleName,ErrCodes,NowUseBBS,Cookiepath,ScriptFolder
	Public lanstr,mainhtml,mainsetting,sysmenu,mainpic
	Public MyUserInfo,UserToday,BoardJumpList,BoardList,CacheData,Maxonline
	Public UserGroupID,Lastlogin,GroupSetting,FoundUserPer,UserInfoCount,UserGroupParent,UserGroupParentID
	Public VipGroupUser,Vipuser,Boardmaster,Superboardmaster,Master,FoundIsChallenge,FoundUser
	Public ScriptName,MemberName,MemberWord,MemberClass,UserHidden,UserID,UserTrueIP,UserPermission
	Public sendmsgnum,sendmsgid,sendmsguser,Page_Admin,Forum_AdLoop3
	Public BadWords,rBadWord,Forum_emot,Forum_PostFace,Forum_UserFace,SkinID,Forum_PicUrl
	Private adcode_1,adcode_2,adcode_4,ScriptTrueUrl,Forum_CSS,Main_Sid,Nowstats,CssID
	Public Reloadtime,CacheName,savelog
	Private LocalCacheName,Cache_Data,IsTopTable,CookiesSid,BoardInfoData,ShowErrType
	Public Board_Setting,boarduser,LastPost,Board_Ads,Board_user,BoardType,IsGroupSetting,BoardMasterList,Board_Data,Sid,Boardreadme,BoardRootID,BoardParentID
	Private Is_Isapi_Rewrite,iArchiverUrl
	Public ModHtmlLinked,ArchiverUrl,ArchiverType
	Public Browser,version ,platform,IsSearch
	Public BoardXML,BoardNode,NodeUpdate
	Public IsUserPermissionOnly,IsUserPermissionAll
	Rem Sub 
	Private Sub Class_Initialize()
		If Not Response.IsClientConnected Then Response.End
		IsUserPermissionOnly = 0
		IsUserPermissionAll = 0
		ShowErrType = 0 '错误信息显示模式
		savelog=0'设置为1的时候会记录攻击或错误错信息。
		SqlQueryNum = 0
		Reloadtime=28800
		CacheName = Lcase(Replace(Replace(Replace(Server.MapPath("index.asp"),"index.asp",""),":",""),"\",""))
		IsTopTable = 0
		Forum_sn = Replace(CacheName,"_","")
		VipGroupUser = False
		Vipuser = False:Boardmaster = False
		Superboardmaster = False:Master = False:FoundIsChallenge = False:FoundUser = False
		BoardID = Request("BoardID")
		If IsNumeric(BoardID) = 0 or BoardID = "" Then BoardID = 0
		BoardID = Clng(BoardID)
		MemberName = checkStr(Trim(Request.Cookies(Forum_sn)("username")))
		MemberWord = checkStr(Trim(Request.Cookies(Forum_sn)("password")))
		UserHidden = Trim(Request.Cookies(Forum_sn)("userhidden"))
		UserID = Trim(Request.Cookies(Forum_sn)("UserID"))
		If IsNumeric(UserHidden) = 0 or Userhidden = "" Then UserHidden = 2
		If IsNumeric(UserID) = 0 Or UserID="" Then UserID=0
		UserID = Clng(UserID)
		UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR")
		UserTrueIP = CheckStr(UserTrueIP)
		Dim Tmpstr
		Tmpstr = Request.ServerVariables("PATH_INFO")
		Tmpstr = Split(Tmpstr,"/")
		ScriptName = Lcase(Tmpstr(UBound(Tmpstr)))
		ScriptFolder = Lcase(Tmpstr(UBound(Tmpstr)-1)) & "/"
		MemberClass = checkStr(Request.Cookies(Forum_sn)("userclass"))
		Page_Admin=False
		If InStr(ScriptName,"showerr")>0 Or InStr(ScriptName,"login")>0 Or InStr(ScriptName,"admin_")>0 Then Page_Admin=True
		sendmsgnum=0:sendmsgid=0:sendmsguser=""
		'模拟HTML部分开始
		Is_Isapi_Rewrite = 0
		If Is_Isapi_Rewrite = 0 Then ModHtmlLinked = "?"
		ArchiverType = 0
		If InStr(ScriptName,"indexhtml.asp") > 0 Then
			iArchiverUrl = Lcase(Request.ServerVariables("QUERY_STRING"))
			If iArchiverUrl <> "" Then
				ArchiverUrl = iArchiverUrl
				iArchiverUrl = Split(iArchiverUrl,"_")
				If iArchiverUrl(0) = "list" And Ubound(iArchiverUrl) = 5 Then
					If IsNumeric(iArchiverUrl(1)) Then
						ArchiverType = 1
						BoardID = Clng(iArchiverUrl(1))
					End If
				End If
			End If
		End If
		'模拟HTML部分结束
		'Response.Write Server.MapPath("index.asp")
		'response.end
		NodeUpdate=False
	End Sub
	
	Private Sub class_terminate()
		If NodeUpdate Then
			Application.lock
			Set Application(CacheName&"_Boradlist")=BoardXML.cloneNode(True)
			Application.unlock
		End If
		Set BoardXML = Nothing
		If IsObject(Conn) Then Conn.Close : Set Conn = Nothing
		If IsObject(Plus_Conn) Then Plus_Conn.Close : Set Plus_Conn = Nothing
	End Sub
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName = LCase(vNewValue)
		Cache_Data=Application(CacheName & "_" & LocalCacheName)
	End Property
	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName<>"" Then 
			ReDim Cache_Data(2)
			Cache_Data(0)=vNewValue
			Cache_Data(1)=Now()
			Application.Lock
			Application(CacheName & "_" & LocalCacheName) = Cache_Data
			Application.unLock
		Else
			Err.Raise vbObjectError + 1, "DvbbsCacheServer", " please change the CacheName."
		End If
	End Property
	Public Property Get Value()
		If LocalCacheName<>"" Then 	
			If IsArray(Cache_Data) Then
				Value=Cache_Data(0)
			Else		
				'Err.Raise vbObjectError + 1, "DvbbsCacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."
			End If
		Else
			Err.Raise vbObjectError + 1, "DvbbsCacheServer", " please change the CacheName."
		End If
	End Property
	Public Function ObjIsEmpty()
		ObjIsEmpty=True	
		If Not IsArray(Cache_Data) Then Exit Function
		If Not IsDate(Cache_Data(1)) Then Exit Function
		If DateDiff("s",CDate(Cache_Data(1)),Now()) < (60*Reloadtime) Then ObjIsEmpty=False		
	End Function
	Public Sub Checkcache()
		Name="Date"
		Dim iScriptName
		iScriptName = Request.ServerVariables("Script_Name")
		If InStr(Lcase(iScriptName),"admin/") > 0 Then
			iScriptName = "admin/index.asp"
		Else
			iScriptName = ""
		End If
		If ObjIsEmpty() Then
			If iScriptName <> "" Then
				Session("LoadCache")=iScriptName
				Response.Redirect "../LoadCache.asp"
			Else
				If Request.ServerVariables("QUERY_STRING")<>"" Then
					Session("LoadCache")=ScriptName&"?"&Request.ServerVariables("QUERY_STRING")
				Else
					Session("LoadCache")=ScriptName
				End If
				Response.Redirect "LoadCache.asp"
			End If
		Else
			If Cstr(value) <> Cstr(Date()) Then
				If iScriptName <> "" Then
					Session("LoadCache")=iScriptName
					Response.Redirect "../LoadCache.asp"
				Else
					If Request.ServerVariables("QUERY_STRING")<>"" Then
						Session("LoadCache")=ScriptName&"?"&Request.ServerVariables("QUERY_STRING")
					Else
						Session("LoadCache")=ScriptName
					End If
					Response.Redirect "LoadCache.asp"
				End If
			End If
		End If
	End Sub
	'取得基本设置数据
	Public Sub GetForum_Setting()
		Name="setup"
		CacheData=value
		Dim Setting
		Setting=CacheData(1,0)
		Setting = Split(Setting,"|||")
		Forum_Info = Setting(0)
		Forum_Info = Split (Forum_Info,",")
		Forum_Setting = Setting(1)
		Forum_Setting = Split (Forum_Setting,",")
		Forum_UploadSetting = Split(Forum_Setting(7),"|")
		Forum_user = Setting(2)
		Forum_user = Split (Forum_user,",")
		Forum_Copyright = Setting(3)
		Forum_ChanSetting = CacheData(24,0)
		Forum_ChanSetting = Split(Forum_ChanSetting,",")
		Forum_Version = CacheData(18,0)
		BadWords = Split(CacheData(3,0),"|")
		rBadWord = Split(CacheData(4,0),"|")
		Main_Sid=CacheData(17,0)
		Maxonline = CacheData(5,0)
		NowUseBBS = CacheData(19,0)
		Cookiepath = CacheData(26,0)
		If ScriptFolder = Lcase(CacheData(33,0)) Then Page_Admin = True
		'IP锁定
		If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
			If Not Page_Admin Then Response.Redirect "showerr.asp?action=iplock"
		ElseIf Not ( Request.Cookies(Forum_sn & "Kill")("kill") = "0" And Not IsEmpty(Session(CacheName & "UserID")) ) Then
			Call ChecKIPlock
			If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
				If Not Page_Admin Then Response.Redirect "showerr.asp?action=iplock"
			End If
		End If	
		'关闭论坛相关部分
		'判断BoardID的值，获取对应的设置
		If Forum_Setting(21)="1" And Not Page_Admin Then Response.redirect "showerr.asp?action=stop"		
		Dim OpenTime,ischeck
		Set BoardXML=Application(CacheName&"_Boradlist").cloneNode(True)
		BoardXML.validateOnParse = False
		BoardXML.resolveExternals = False
		'If (Dvbbs.Forum_ChanSetting(13)="1" And Dvbbs.Forum_ChanSetting(0)="1") Or Dvbbs.Forum_ChanSetting(3)="0" Then MyForumPay = True
		
		If BoardID>0 Then
			Dim Nodelist,node
			Set node = BoardXML.selectSingleNode("//*[@boardid='"&BoardID&"']")
			If not (node is nothing) Then
				Set BoardNode=Node
			Else
				Response.Write "错误的版面参数"
  				Response.End
			End If
			boarduser = Split(BoardNode.attributes.getNamedItem("boarduser").text,",")
			Forum_ads = Split(BoardNode.attributes.getNamedItem("board_ads").text,"$")
			Forum_user = Split(BoardNode.attributes.getNamedItem("board_user").text,",")
			'Forum_user = Board_User
			board_Setting = Split(BoardNode.attributes.getNamedItem("board_setting").text,",")
			LastPost = Split(BoardNode.attributes.getNamedItem("lastpost").text,"$")
			BoardType = BoardNode.attributes.getNamedItem("boardtype").text
			IsGroupSetting = BoardNode.attributes.getNamedItem("isgroupsetting").text
			BoardMasterList = BoardNode.attributes.getNamedItem("boardmaster").text
			BoardRootID = BoardNode.attributes.getNamedItem("rootid").text
			If BoardNode.parentNode.attributes.getNamedItem("boardid") is Nothing Then
				BoardParentID="0"
			Else
				BoardParentID=BoardNode.parentNode.attributes.getNamedItem("boardid").text
			End If
			Sid = BoardNode.attributes.getNamedItem("sid").text
			Boardreadme=BoardNode.attributes.getNamedItem("readme").text
			If Len(Board_Setting(22))< 24 Then Board_Setting(22)="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
			OpenTime=Split(Board_Setting(22),"|")
			setting=Board_Setting(21)
			ischeck=Clng(Board_Setting(18))
			If Board_Setting(50)<>"0" And Board_Setting(50)<>"" Then Response.Redirect Board_Setting(50)
		Else
			Forum_ads =  CacheData(2,0)
			Forum_ads = Split(Forum_ads,"$")
			If Len(Forum_Setting(70))< 24 Then Forum_Setting(70)="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
			OpenTime=Split(Forum_Setting(70),"|")
			setting=Forum_Setting(69)
			ischeck=Forum_Setting(26)
			If Not IsNumeric(ischeck) Then ischeck=0
			ischeck=CLng(ischeck)		
		End If
		'定时开放判断
		If Not Page_Admin And Cint(setting)=1 Then
			If OpenTime(Hour(Now))="1" Then Response.redirect "showerr.asp?action=stop&boardid="&Dvbbs.BoardID&""
		End If
		'在线人数限制
		If ischeck > 0 And Not Page_Admin Then
			If MyBoardOnline.Forum_Online > ischeck And BoardID=0 Then
				If Not IsONline(Membername,1) Then Response.Redirect "showerr.asp?action=limitedonline&lnum="&ischeck
			End If
			If BoardID > 0 Then
				If (Not IsONline(Membername,1)) And MyBoardOnline.Board_Online > ischeck Then Response.Redirect "showerr.asp?action=limitedonline&lnum="&ischeck
			End If
		End If
		CookiesSid = Request.Cookies("skin")("skinid_"&BoardID)
		If Not IsNumeric(CookiesSid) Or CookiesSid = "" Then
			If BoardID = 0 Then 
				SkinID = Main_Sid
			Else
				SkinID = Sid
			End If
		Else
			SkinID=CookiesSid
		End If
	End Sub
	Public Function IsReadonly()
		IsReadonly=False
		Dim TimeSetting
		If Forum_Setting(69)="2" Then
			TimeSetting=split(Forum_Setting(70),"|")
			If TimeSetting(Hour(Now))="1" Then
				IsReadonly=True
				Exit Function
			End If
		End If
		If BoardID>0 Then 
			If Board_Setting(21)="2" Then
				TimeSetting=split(Board_Setting(22),"|")
				If TimeSetting(Hour(Now))="1" Then IsReadonly=True
			End If
		End If 
	End Function
	Public Function IsONline(UserName,action)
		IsONline=False
		If Trim(UserName)="" Then Exit Function
		If IsArray(Session(CacheName & "UserID")) And action=1 Then
			If Session(CacheName & "UserID")(0)="Dvbbs" Then
				IsONline=True:Exit Function 
			End If
		End If
		Dim Rs
		Set Rs =Execute("Select Count(*) From Dv_Online Where Username='"&UserName&"'")
		If Rs(0)<> 0 Then IsONline=True
		Set rs=Nothing  
	End Function  
	
	Public Sub LoadTemplates(Page_Fields)
		Dim Style_Pic,Main_Style,TempStyle
		SkinID=CLng(SkinID)
		'风格换肤修改
		TempStyle = CacheData(35,0)
		TempStyle = Split(TempStyle,"@@@")
		If SkinID > UBound(Split(TempStyle(1),"|||"))-1 Then SkinID = 0
		Forum_CSS = Split(TempStyle(1),"|||")(SkinID)		'风格内容
		Forum_PicUrl = Split(TempStyle(2),"|||")(SkinID)	'图片路径
		CssID = SkinID
		SkinID = Split(TempStyle(3),"|||")(SkinID)		'采用模板ID
		Name = "Main_Style"&SkinID
		Main_Style = Replace(value,"{$PicUrl}",Forum_PicUrl)		'风格图片路径替换