📄 dv_clsmain.asp

📁 品泡女人香XI8.NET文章管理系统的源码
💻 ASP
📖 第 1 页 / 共 5 页
字号:
12 3 4 5 下一页
<%
'=========================================================
' File: Dv_ClsMain.asp
' Version:7.0 sp2
' 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: info@aspsky.net,eway@aspsky.net
'=========================================================
'========================================
' 更新说明，加强过滤，加入对Chr(0)的过滤=
' 同时解决封IP中伪造cookies信息         = 
' 和通过访问一下管理页躲过封IP的问题    =
'========================================
Dim Ad_3(100),i3
Class Cls_Forum
	Rem Const
	Public BoardID,SqlQueryNum,Forum_Info,Forum_Setting,Forum_user,Forum_Copyright,Forum_ads,Forum_ChanSetting
	Public Forum_sn,Forum_Version,Stats,StyleName,ErrCodes,NowUseBBS,Cookiepath
	Public lanstr,mainhtml,mainsetting,sysmenu,mainpic
	Public MyUserInfo,UserToday,BoardJumpList,BoardList,CacheData,Maxonline
	Public UserGroupID,Lastlogin,GroupSetting,FoundUserPer
	Public 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,ReloadCount,Nowstats,CssID
	Public Reloadtime,CacheName,savelog
	Private LocalCacheName,Cache_Data,IsTopTable,CookiesSid,BoardInfoData
	Public Board_Setting,boarduser,LastPost,Board_Ads,Board_user,BoardType,IsGroupSetting,BoardMasterList,Board_Data,Sid,Boardreadme,BoardRootID,BoardParentID
	Rem Sub 
	Private Sub Class_Initialize()
		savelog=0'设置为1的时候会记录攻击或错误错信息。
		SqlQueryNum = 0
		Reloadtime=14400
		CacheName=Replace(Replace(Replace(Server.MapPath("index.asp"),"index.asp",""),":",""),"\","")
		ReloadCount=0
		IsTopTable = 0
		Forum_sn = LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(request.ServerVariables("SCRIPT_NAME"),"/"))),""))
		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 = 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)))
		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=""	
	End Sub
	Private Sub class_terminate()
		If IsObject(Conn) Then Conn.Close:Set Conn = Nothing
	End Sub
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName = LCase(vNewValue)
	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 
			Cache_Data=Application(CacheName & "_" & LocalCacheName)	
			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	
		Cache_Data=Application(CacheName & "_" & LocalCacheName)
		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 DelCahe(MyCaheName)
		Application.Lock
		Application.Contents.Remove(CacheName&"_"&MyCaheName)
		Application.unLock
	End Sub
	'取得基本设置数据
	Public Sub GetForum_Setting()
		Name="setup"
		If ObjIsEmpty() Then ReloadSetup()
		CacheData=value
		'每日更新数据
		'DelCahe "Date"
		'第一次起用论坛或者重启IIS的时候加载缓存
		Name="Date"
		If ObjIsEmpty() Then
			value=Date()
			Call ReloadAllForumInfo
			Call ReloadAllBoardInfo
		Else
			If Cstr(value) <> Cstr(Date()) Then
				Call ReloadAllForumInfo
				Call ReloadAllBoardInfo
				Name="setup"
				Call ReloadSetup()
				CacheData=value
			End If
		End If
		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_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)
		'IP锁定
		If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
			If Not Page_Admin Then
				Response.Redirect "showerr.asp?action=iplock"
				Exit Sub
			End If
		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"
					Exit Sub
				End If
			End If
		End If
		'关闭论坛相关部分
		If Forum_Setting(21)="1" And Not Page_Admin Then Response.redirect "showerr.asp?action=stop"		
		Dim OpenTime,ischeck
		'判断BoardID的值，获取对应的设置
		If BoardID>0 Then
			If Not InStr((","&cachedata(27,0)&","),(","&BoardID&","))>0 Then
				Response.Write "错误的版面参数"
  				Response.End
			End If
			Name="BoardInfo_" & BoardID
  			If ObjIsEmpty() Then ReloadBoardInfo(BoardID)
			Board_Data = Value
			boarduser = Split(Board_Data(13,0) & "",",")
			Board_Ads = Split(Board_Data(17,0),"$")
			Board_user = Split(Board_Data(18,0),",")
			Forum_user = Board_User
			board_Setting = Split(Board_Data(16,0),",")
			LastPost = Split(Board_Data(14,0),"$")
			BoardType = Board_Data(1,0)
			IsGroupSetting = Board_Data(19,0)
			BoardMasterList = Board_Data(8,0)
			BoardRootID = Board_Data(5,0)
			BoardParentID=Board_Data(2,0)
			Sid = Board_Data(15,0)
			Boardreadme=Board_Data(7,0)
			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"
			End If
			OpenTime=Split(Board_Setting(22),"|")
			setting=Board_Setting(21)
			Forum_ads =Board_Ads
			ischeck=Clng(Board_Setting(18))
			If Board_Setting(50)<>"0" And Board_Setting(50)<>"" Then Response.Redirect Board_Setting(50)
			If IsNumeric(Board_Data(21,0)) And CLng(Board_Data(6,0)) > 0 And CInt(Board_Data(4,0))< 2 Then Call LoadBoardList(BoardID,1)
			If IsNumeric(Board_Data(26,0)) And CLng(Board_Data(6,0)) > 0 And CInt(Board_Data(4,0))< 2 Then Call LoadBoardList(BoardID,0)
			'杨铮注：Board_Data(6,0) 为子论坛个数，当为空值时便会出错，检查 Dv_Board 表 Child 字段。
		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"
			End If
			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))="0" Then
				Response.redirect "showerr.asp?action=stop&boardid="&Dvbbs.BoardID&""	 
			End If
		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
		If Forum_ChanSetting(0)="1" And Forum_ChanSetting(1)="1" Then Get_Chan_Ad
	End Sub
	Public Function IsReadonly()
		IsReadonly=False
		Dim TimeSetting
		If Forum_Setting(69)="2" Then
			TimeSetting=split(Forum_Setting(70),"|")
			If TimeSetting(Hour(Now))="0" 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))="0" Then
					IsReadonly=True
				End If
			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 ReloadSetup()
		Dim SQL,Rs,i
		SQL = "Select * from [Dv_setup] "
		Set Rs = Execute(SQL)
		value = Rs.GetRows(1)
		Set Rs = Nothing
	End Sub 
	Public Sub ReloadTemplateslist()		
		Dim Rs,SQL,tmpdata
		SQL = "select ID,StyleName from [Dv_Style]"
		Set Rs = Execute(SQL)
		tmpdata = Rs.GetString(,,"|||","@@@","")
		tmpdata = Left(tmpdata,Len(tmpdata)-3)	
		Set Rs = Nothing 
		value=tmpdata
	End Sub
	Public Sub LoadTemplates(Page_Fields)
		Dim Style_Pic,Main_Style,TempStyle
		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
		SkinID=CLng(SkinID)
		Name="StyleName"&SkinID
		If ObjIsEmpty() Then TemplatesToCache ("StyleName")
		StyleName=value
		Name="Forum_CSS"&SkinID
		If ObjIsEmpty() Then TemplatesToCache ("Forum_CSS")
		'风格换肤修改
		CssID=Request.Cookies("skin")("cssid_"&BoardID)
		If Not IsNumeric(CssID) OR CssID="" Then 
			If boardid=0 Then
				CssID=CacheData(30,0)
			Else
				CssID=Board_Data(25,0)
			End If
		End If
		If CssID="" Or Not IsNumeric(CssID) Then CssID=0
		CssID=CLng(CssID)
		TempStyle = value
		TempStyle = Split(TempStyle,"@@@")
		If CssID > UBound(Split(TempStyle(1),"|||"))-1 Then
			CssID = 0
		End If
		Forum_CSS = Split(TempStyle(1),"|||")(CssID)		'风格内容
		Forum_PicUrl = Split(TempStyle(2),"|||")(CssID)		'图片路径
		Name = "Main_Style"&SkinID
		If ObjIsEmpty() Then TemplatesToCache ("Main_Style")
		Main_Style = Replace(value,"{$PicUrl}",Forum_PicUrl)		'风格图片路径替换
		If Not (Instr(ScriptName,"index")>0 Or Instr(ScriptName,"list")>0 Or Page_Admin) Then
			Name = "Style_Pic"&SkinID
			If ObjIsEmpty() Then TemplatesToCache ("Style_Pic")
			Style_Pic = Replace(value,"{$PicUrl}",Forum_PicUrl)		'风格图片路径替换
			Style_Pic = Split(Style_Pic,"@@@")
			Dim TmpArray(10),i
			For i=0 to UBound(Style_Pic)
				TmpArray(i) = Style_Pic(i)
			Next 
			Forum_UserFace = TmpArray(0)
			Forum_PostFace = TmpArray(1)
			Forum_Emot = TmpArray(2)
		End If
		If Page_Fields<>"" Then
			Name="page_"&Page_Fields&SkinID
			If ObjIsEmpty() Then TemplatesToCache ("page_"&Page_Fields)
			Template.value = value
		End If
		Main_Style = Split(Main_Style,"@@@")
		mainhtml = Split(Main_Style(0),"|||")
		lanstr = Split(Main_Style(1),"|||")
		mainpic = Split(Main_Style(2),"|||")
		mainsetting = Split(mainhtml(0),"||")
		Forum_CSS = Replace(Forum_CSS,"{$width}",mainsetting(0))
		Forum_CSS = Replace(Forum_CSS,"{$PicUrl}",Forum_PicUrl)
	End Sub
	Public Sub TemplatesToCache(Page_Fields)
		Dim Rs,SQL
		SQL = "Select "&Page_Fields&" from [Dv_Style] where id = " & SkinID
		Set Rs = Execute(SQL)
		If Not Rs.EOF Then
			value=Rs(0)&""
		Else
			'处理错误
			If boardid<>0 Then
				If Cint(SkinID)=Cint(sid) Then Fixsid()
			Else
12 3 4 5 下一页
💿 文件大小 1632 K
👤 上传用户 c_word
📂 所属分类技术管理
🏷️ 相关标签

#NET #XI #管理系统 #源码
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -