dv_clsmain.asp

现在好了

		Name="StyleName"&SkinID
		StyleName=value
		If Not (Instr(ScriptName,"index")>0 Or Page_Admin) Then
			Name = "Style_Pic"&SkinID
			Style_Pic = Replace(value,"{$PicUrl}",Forum_PicUrl)		'风格图片路径替换
			Style_Pic = Split(Style_Pic,"@@@")
			Forum_UserFace = Style_Pic(0)
			Forum_PostFace = Style_Pic(1)
			Forum_Emot = Style_Pic(2)
		End If
		If Page_Fields<>"" Then
			Name="page_"&Page_Fields&SkinID
			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
	Rem 判断发言是否来自外部
	Public Function ChkPost()
		Dim server_v1,server_v2
		Chkpost=False 
		server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
		server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1,8,len(server_v2))=server_v2 Then Chkpost=True 
	End Function
	
	'更新总设置表部分缓存数组，入口：更新内容、数组位置
	Public Sub ReloadSetupCache(MyValue,N)
		CacheData(N,0) = MyValue
		Name="setup"
		value=CacheData
	End Sub
	'更新用户资料缓存(缓存用户名,是否需要添加)[0=不添加,只作清理,1=需要添加]
	Public Sub NeedUpdateList(username,act)
		Dim Tmpstr,TmpUsername
		Name="NeedToUpdate"
		If ObjIsEmpty() Then Value=""
		Tmpstr=Value
		TmpUsername=","&username&","
		Tmpstr=Replace(Tmpstr,TmpUsername,",")
		Tmpstr=Replace(Tmpstr,",,",",")
		IF act=1 Then 
			If IsONline(username,0) Then
				If Tmpstr="" Then
					Tmpstr=TmpUsername
				Else
					Tmpstr=Tmpstr&TmpUsername
				End If
			End If
		End If
		Tmpstr=Replace(Tmpstr,",,",",")
		Value=Tmpstr
	End Sub
	'写入客人session
	Public Sub LetGuestSession()
		Dim StatUserID,UserSessionID
		StatUserID = checkStr(Trim(Request.Cookies(Forum_sn)("StatUserID")))
		If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
			StatUserID = Replace(UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
		StatUserID = Ccur(StatUserID)
		Response.Cookies(Forum_sn).Expires=DateAdd("s",3600,Now())
		Response.Cookies(Forum_sn).path=cookiepath
		Response.Cookies(Forum_sn)("StatUserID") = StatUserID
		'客人=SessionID+活动时间+发帖时间+版面ID
		StatUserID = StatUserID & "_" & Now & "_" & Now & "_" & BoardID
		Session(CacheName & "UserID") = Split(StatUserID,"_")
	End Sub 
	'根据页面来判断是否需要执行TrueCheckUserLogin
	Public Function NeedChecklongin()
		NeedChecklongin=True
		If UserID>0 Then
			If InStr(ScriptName,"admin_")>0 Then Exit Function
			Dim pagelist
			pagelist=",post.asp,usermanager.asp,mymodify.asp,modifypsw.asp,modifyadd.asp,usersms.asp,"
			pagelist=pagelist & "friendlist.asp,favlist.asp,myfile.asp,friendlist.asp,recycle.asp,"
			pagelist=pagelist & "fileshow.asp,bbseven.asp,dispuser.asp,savepost.asp,"
			If InStr(pagelist,","&ScriptName&",")>0 Then Exit Function
		End If
		NeedChecklongin=False
	End Function 
	'验证用户登陆
	Public Sub CheckUserLogin()
		If Not IsArray(Session(CacheName & "UserID")) Then
			If UserID > 0 Then 
				TrueCheckUserLogin
			Else
				Call LetGuestSession()
			End If	
		Else
			If UserID >0  Then
				Dim NeedToUpdate,toupdate
				toupdate=False
				Name="NeedToUpdate"
				If Not ObjIsEmpty() Then 
					NeedToUpdate=","&Value&","
					If InStr(NeedToUpdate,","&MemberName&",")>0 Then
						Call NeedUpdateList(MemberName,0)
						toupdate=True
					End If
				End If
				
				If NeedChecklongin Or (UserID >0 And Not Ubound(Session(CacheName & "UserID"))=45) Or toupdate Then TrueCheckUserLogin
			End If
		End If
		If Session(CacheName & "UserID")(0) = "Dvbbs" Then
			GetCacheUserInfo
		Else
			MyUserInfo = Session(CacheName & "UserID")
			UserGroupID = 7
			Lastlogin = Now()
		End If	
		GetGroupSetting
	End Sub
	'系统分配随机密码
	Public Function Createpass()
		Dim Ran,i,LengthNum
		LengthNum=16
		Createpass=""
		For i=1 To LengthNum
			Randomize
			Ran = CInt(Rnd * 2)
			Randomize
			If Ran = 0 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& UCase(Chr(Ran))
			ElseIf Ran = 1 Then
				Ran = CInt(Rnd * 9)
				Createpass = Createpass & Ran
			ElseIf Ran = 2 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& Chr(Ran)
			End If
		Next
	End Function
	'更新用户验证密码
	Public Sub NewPassword()
		If UserID=0 Then Exit Sub	
		Response.Write "<iframe width=""0"" height=""0"" src=""newpass.asp"" name=""Dvnewpass""></iframe>"
	End Sub
	Public Sub TrueCheckUserLogin()
	'Session(CacheName & "UserID")用户资料=0dvbbs+1刷新时间+2发帖时间+3所在版面ID+4用户ID+5用户名+6用户密码+7用户邮箱+8用户文章数+9用户主题数+10用户性别+11用户头像+12用户头像宽+13用户头像高+14用户注册时间+15用户最后登陆时间+16用户登陆次数+17用户状态+18用户等级+19用户组ID+20用户组名+21用户金钱+22用户积分UserEp+23用户魅力UserCp+24用户威望+25用户生日+26最后登陆IP+27用户被删除数+28用户精华数+29用户隐身状态+30用户短信情况+31用户阳光会员+32用户手机+33用户组图标+34用户头衔+35验证密码+36用户今日信息+37用户金币+38用户点券+	39跟踪用户ID+40VIP登记时间+41VIP截止时间+42是否存在全局自定义权限IsUserPermissionAll+43是否有多属性用户组IsUserPermissionOnly+44临时数据+45Dvbbs
		Dim Rs,SQL,FoundMyGroupID
		FoundMyGroupID = 0
		Sql="Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,UserHidden,UserMsg,IsChallenge,UserMobile,TitlePic,UserTitle,TruePassWord,UserToday,UserMoney,UserTicket,FollowMsgID,Vip_StarTime,Vip_EndTime"
		Sql=Sql+" From [Dv_User] Where UserID = " & UserID
		Set Rs = Execute(Sql)
		If Rs.Eof And Rs.Bof Then
			Rs.Close:Set Rs = Nothing
			UserID = 0
			EmptyCookies
			LetGuestSession()
		Else
			MyUserInfo=Rs.GetString(,1, "|||","","")
			If IsArray(Session(CacheName & "UserID")) Then
				If Session(CacheName & "UserID")(0)="Dvbbs" Then	'修正防刷新的问题,轻飘飘
					If Cint(Session(CacheName & "UserID")(19)) <> Cint(Split(MyUserInfo,"|||")(15)) Then FoundMyGroupID = Cint(Session(CacheName & "UserID")(19))
					If FoundMyGroupID > 0 Then
					MyUserInfo = "Dvbbs|||"& Session(CacheName & "UserID")(1) & "|||"& Session(CacheName & "UserID")(2) &"|||"& BoardID &"|||"& MyUserInfo &"|||"&FoundUserPermission_All()&"|||"&Split(MyUserInfo,"|||")(15)&"|||"& Session(CacheName & "UserID")(Ubound(Session(CacheName & "UserID"))-1) &"|||Dvbbs"
					Else
					MyUserInfo = "Dvbbs|||"& Session(CacheName & "UserID")(1) & "|||"& Session(CacheName & "UserID")(2) &"|||"& BoardID &"|||"& MyUserInfo &"|||"&FoundUserPermission_All()&"|||0|||"& Session(CacheName & "UserID")(Ubound(Session(CacheName & "UserID"))-1) &"|||Dvbbs"
					End If
				Else
					MyUserInfo = "Dvbbs|||"& Now & "|||" & DateAdd("s",-3600,Now()) &"|||"& BoardID &"|||"& MyUserInfo &"|||"&FoundUserPermission_All()&"|||0||||||Dvbbs"
				End If
			Else
				MyUserInfo = "Dvbbs|||"& Now & "|||" & DateAdd("s",-3600,Now()) &"|||"& BoardID &"|||"& MyUserInfo &"|||"&FoundUserPermission_All()&"|||0||||||Dvbbs"
			End If
			Rs.Close:Set Rs = Nothing
			MyUserInfo = Split(MyUserInfo,"|||")
			If FoundMyGroupID > 0 Then MyUserInfo(19) = FoundMyGroupID
			If Trim(MyUserInfo(35)) = Memberword And MyUserInfo(5) =Membername Then
				Session(CacheName & "UserID") = MyUserInfo
				Memberword = MyUserInfo(35)
				GetCacheUserInfo()
			Else
				If IsArray(Session(CacheName & "UserID"))  Then
					If Session(CacheName & "UserID")(0)="Dvbbs" Then
						If Trim(Session(CacheName & "UserID")(4))=Trim(MyUserInfo(4)) And Session(CacheName & "UserID")(5)=MyUserInfo(5) And Trim(Session(CacheName & "UserID")(6))=Trim(MyUserInfo(6)) Then
							If Request.ServerVariables("QUERY_STRING")<>"" Then
								Session("LoadCache")=ScriptName&"?"&Request.ServerVariables("QUERY_STRING")
							Else
								Session("LoadCache")=ScriptName
							End If
							If Session("flag")<>"" Then
								Response.Redirect "../newpass.asp"
							Else
								Response.Redirect "newpass.asp"
							End If
						End If 
					Else
						UserID = 0
						EmptyCookies
						LetGuestSession()
					End If
				Else
					UserID = 0
					EmptyCookies
					LetGuestSession()
				End If 
			End If
		End If
	End Sub
	'用户登录成功后，采用本函数读取用户数组并判断一些常用信息
	Public Sub GetCacheUserInfo()
		MyUserInfo = Session(CacheName & "UserID")
		UserInfoCount = Ubound(Session(CacheName & "UserID"))
		UserID = Clng(MyUserInfo(4))
		MemberName = MyUserInfo(5)
		Lastlogin = MyUserInfo(15)
		If Not IsDate(LastLogin) Then LastLogin = Now()
		UserGroupID = Cint(MyUserInfo(19))
		If Trim(MyUserInfo(36))="" Then
			Execute("Update [Dv_User] Set UserToday='0|0|0|0|0' Where UserID = " & UserID)
			MyUserInfo(36) = "0|0|0|0|0"
			UserToday = Split(MyUserInfo(36),"|")
		Else
			UserToday = Split(MyUserInfo(36),"|")
			If Ubound(UserToday) <> 4 Then
				Execute("Update [Dv_User] Set UserToday='0|0|0|0|0' Where UserID = " & UserID)
				MyUserInfo(36) = "0|0|0|0|0"
				UserToday = Split(MyUserInfo(36),"|")
			End If
		End If
		'判断是否VIP组成员
		If Not IsNull(MyUserInfo(41)) or MyUserInfo(41)<>"" Then
			If IsDate(MyUserInfo(41)) Then
				If DateDiff("d",Now(),MyUserInfo(41))>0 Then
					VipGroupUser = True
				Else
					Dim tRs
					'将已过期的VIP用户移回注册组并清空有效时间
					If UserGroupID>8 Then
						Set tRs=Execute("Select Top 1 * From Dv_UserGroups Where ParentGID=3 And MinArticle<="&MyUserInfo(8)&" Order By MinArticle Desc")
							If not tRs.Eof Then
								Execute("Update Dv_User Set UserClass='"&tRs("UserTitle")&"',TitlePic='"&tRs("GroupPic")&"',UserGroupID="&tRs("UserGroupID")&",Vip_StarTime=null,Vip_EndTime=null Where UserID="&UserID)
							End If
						Set tRs=Nothing
					Else
						Execute("Update Dv_User Set Vip_StarTime=null,Vip_EndTime=null Where UserID="&UserID)
					End If
					MyUserInfo(40) = ""
					MyUserInfo(41) = ""
					Session(CacheName & "UserID") = MyUserInfo
				End If
			End If
		End If
		Select Case UserGroupID
		Case 8
			Vipuser = True
		Case 3
			Boardmaster = True
		Case 2
			Superboardmaster = True
		Case 1
			Master = True
		End Select
		If MyUserInfo(31) = "1" Then FoundIsChallenge = True
		If DateDiff("d",LastLogin,Now())<>0 Then
			Execute("Update [Dv_User] Set UserToday='0|0|0|0|0',LastLogin = " & SqlNowString & " Where UserID = " & UserID)
			MyUserInfo(36) = "0|0|0|0|0"
			LastLogin = Now()
		End If
		If Userhidden = 2 and DateDiff("s",Lastlogin,Now())>Clng(Forum_Setting(8))*60 Then
			Execute("Update [Dv_User] Set UserLastIP = '" & UserTrueIP & "',LastLogin = " & SqlNowString & " Where UserID = " & UserID)
			Lastlogin = Now()
		End If
		sendmsgnum=0:sendmsgid=0:sendmsguser=""
		If MyUserInfo(30)<>"" Then
			Dim Usermsg
			Usermsg=Split(MyUserInfo(30),"||")
			If Ubound(Usermsg)=2 Then
				sendmsgnum=Usermsg(0)
				sendmsgid=Usermsg(1)
				sendmsguser=Usermsg(2)
			End If
		End If
		If IsNull(MyUserInfo(39)) Then
			MyUserInfo(39)=""
		Else
			MyUserInfo(39) = Replace(Trim(MyUserInfo(39))&"",Chr(13),"")
		End If
		'跟踪用户处理
		If MyUserInfo(39)<>"" Then
			Dim ToolsFollowUserID,i,Rs,Tools_inceptid,Tools_newincept,Tools_msginfo
			ToolsFollowUserID = Split(MyUserInfo(39),",")
			For i=0 To Ubound(ToolsFollowUserID)
				If Len(ToolsFollowUserID(i))>0 and Len(ToolsFollowUserID(i))<50 and ToolsFollowUserID(i)<>"" Then
					ToolsFollowUserID(i) = CheckStr(ToolsFollowUserID(i))
						Execute("Insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"& ToolsFollowUserID(i)&"','系统消息','您跟踪的用户"&Dvbbs.MemberName&"已登录','您使用了论坛道具“狗仔队”，您所跟踪的用户 "&Dvbbs.Membername&" 于 "&Now()&" 登录了论坛，请您及时和该用户取得联系，感谢您采用我们的服务。',"&SqlNowString&",0,1)")
						Set Rs=Execute("Select top 1 id,sender From Dv_Message Where incept ='"& ToolsFollowUserID(i) &"'")
						Tools_inceptid=Rs(0) &"||"& Rs(1)
						Set Rs=Execute("Select Count(id) From Dv_Message Where Flag=0 and issend=1 and delR=0 And incept='"& ToolsFollowUserID(i) &"'")
						Tools_newincept = Rs(0)
						Set Rs=Nothing
						If IsNull(Tools_newincept) Then Tools_newincept=0
						Tools_msginfo=Tools_newincept & "||" & Tools_inceptid
						Execute("update [dv_user] set UserMsg='"&CheckStr(Tools_msginfo)&"' where username='"&ToolsFollowUserID(i)&"'")
				End If
			Next
			MyUserInfo(39) = ""
			Execute("UpDate Dv_User Set FollowMsgID='' Where UserID="&UserID)
		End If
		FoundUser=True
		MyUserInfo(15)=Lastlogin
		'用户头像处理
		Dim iUserMagicFace
		iUserMagicFace = Split(MyUserInfo(11),"|")
		If Ubound(iUserMagicFace) = 1 Then MyUserInfo(11) = iUserMagicFace(1)
		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