dv_clsmain.asp

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

				If SkinID=CInt(CacheData(17,0)) Then
					Call FixSetupsid()		
				End if
			End If
			Response.redirect "cookies.asp?action=stylemod&SkinID=0&boardid="&Boardid					
		End If
		Set Rs = Nothing
	End Sub
	Private Sub Fixsid()
		Dim Rs,SQL
		SQL = "Select Count(*) from [Dv_Style] where id = " & sid
		Set Rs = Execute(SQL)
		If Rs(0)=0 Then
			'把该版的SID更新为系统缺省的值
			Execute("Update Dv_Board Set Sid="&CLng(CacheData(17,0))&" where BoardID="&BoardID&"")
			'更新该版面的缓存
			ReloadBoardCache BoardID,CacheData(17,0),15,0
		End If
		Set Rs = Nothing
	End Sub 
	Private Sub FixSetupsid()
		Dim Rs,SQL
		SQL = "Select Top 1 ID from [Dv_Style] Order by ID"
		Set Rs = Execute(SQL)
		If Rs.EOF Then
			Response.Write "论坛模板数据是空的，请添加。"
			Response.End 	
		Else
			ReloadSetupCache Rs(0),17
			Execute("Update Dv_Setup Set Forum_Sid="&Rs(0)&"")
		End If
		Set rs=Nothing 
	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 ReloadAllForumInfo()
		'数据库部分
		If value <> "1900-1-1" Then 
			value="1900-1-1"
			Dim Rs,LastPostInfo,TempStr,i
			Dim Forum_YesterdayNum,Forum_TodayNum,Forum_LastPost,Forum_MaxPostNum,Forum_MaxPostDate
			Set Rs=Execute("Select Top 1 Forum_YesterdayNum,Forum_TodayNum,Forum_LastPost,Forum_MaxPostNum From Dv_Setup")
			Forum_YesterdayNum=Rs(0)
			Forum_TodayNum=Rs(1)
			Forum_LastPost=Rs(2)
			Forum_MaxPostNum=Rs(3)
			Set Rs=Nothing
			LastPostInfo = Split(Forum_LastPost,"$")
			If Not IsDate(LastPostInfo(2)) Then LastPostInfo(2)=Now()	
			If DateDiff("d",CDate(LastPostInfo(2)),Now())<>0 Then'最后发帖时间不是今天，	
				TempStr=LastPostInfo(0)&"$"&LastPostInfo(1)&"$"&Now()&"$"&LastPostInfo(3)&"$"&LastPostInfo(4)&"$"&LastPostInfo(5)&"$"&LastPostInfo(6)&"$"&LastPostInfo(7)
				Execute("Update Dv_Setup Set Forum_YesterdayNum="&Forum_TodayNum&",Forum_LastPost='"&TempStr&"',Forum_TodayNum=0")
				ReloadSetupCache 0,9
				ReloadSetupCache Forum_TodayNum,11
				ReloadSetupCache TempStr,15
			End If
			If Forum_TodayNum >Forum_MaxPostNum Then
				Execute("Update Dv_Setup Set Forum_MaxPostNum=Forum_TodayNum,Forum_MaxPostDate="&SqlNowString)
				ReloadSetupCache Forum_TodayNum,12'日最高发帖
				ReloadSetupCache Now(),13 '最高发帖日期
			End If
			LoadBoardsInfo()
		End If
		Name="Date"
		value=Date()
	End Sub
	'使用一个查询更新所有版面的缓存
	Public Sub LoadBoardsInfo()
		Dim Rs,BoardData(26,0),i,GetData,SQL,LastPostInfo,TempStr,IsUpdate
		IsUpdate=0
		SQL="select boardid,BoardType,ParentID,ParentStr,Depth,RootID,Child,readme,BoardMaster,PostNum,TopicNum,indexIMG,todayNum,boarduser,LastPost,Sid,Board_Setting,Board_Ads,Board_user,IsGroupSetting,BoardTopStr,BoardID As TempStr,BoardID As TempStr1,BoardID As TempStr2,BoardID As TempStr3,cid from Dv_board"
		If Not IsObject(Conn) Then ConnectionDatabase
		Set Rs=Server.CreateObject("ADODB.RecordSet")
		Rs.Open SQL,Conn,1,3
		Do While Not Rs.Eof
			LastPostInfo = Split(Rs(14),"$")
			If Not IsDate(LastPostInfo(2)) Then LastPostInfo(2)=Now()
			If DateDiff("d",LastPostInfo(2),Now())<>0 Then
				Rs("LastPost")=LastPostInfo(0)&"$"&LastPostInfo(1)&"$"&LastPostInfo(2)&"$"&LastPostInfo(3)&"$"&LastPostInfo(4)&"$"&LastPostInfo(5)&"$"&LastPostInfo(6)&"$"&LastPostInfo(7)
				Rs("TodayNum")=0
				Rs.UpDate
				IsUpdate=1
			End If
			Name="BoardInfo_" & Rs(0)
			For i=0 to Rs.Fields.Count-1
				BoardData(i,0)=Rs(i)
			Next
			value = BoardData
			GetData = Value
			IsUpdate=0
		Rs.MoveNext
		Loop
		Rs.Close
		Set Rs=Nothing
	End Sub 
	'更新总设置表部分缓存数组，入口：更新内容、数组位置
	Public Function ReloadSetupCache(MyValue,N)
		CacheData(N,0) = MyValue
		Name="setup"
		value=CacheData
	End Function
	'更新用户资料缓存(缓存用户名,是否需要添加)[0=不添加,只作清理,1=需要添加]
	Public Sub NeedUpdateList(username,act)
		Dim Tmpstr,TmpUsername
		Name="NeedToUpdate"
		If ObjIsEmpty() Then 
		Value=""
		End If
		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 Session(CacheName & "UserID")(0)="Dvbbs" ) Or toupdate Then
					TrueCheckUserLogin
				End If
			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 NewPassword0()
		If UserID=0 Then Exit Sub
		If Not Response.IsClientConnected Then
			Exit Sub
		End If
		Dim TruePassWord,usercookies
		usercookies=Request.Cookies(Dvbbs.Forum_sn)("usercookies")
		TruePassWord=Createpass
		If (Isnull(usercookies) or usercookies="") And Not Isnumeric(usercookies) Then usercookies=0
		Select Case Cint(usercookies)
			Case 0
				Response.Cookies(Forum_sn)("usercookies") = usercookies
			Case 1
   				Response.Cookies(Forum_sn).Expires=Date+1
				Response.Cookies(Forum_sn)("usercookies") = usercookies
			Case 2
				Response.Cookies(Forum_sn).Expires=Date+31
				Response.Cookies(Forum_sn)("usercookies") = usercookies
			Case 3
				Response.Cookies(Forum_sn).Expires=Date+365
				Response.Cookies(Forum_sn)("usercookies") = usercookies
		End Select
		Response.Cookies(Forum_sn).path=cookiepath
		Response.Cookies(Forum_sn)("username") = MemberName
		Response.Cookies(Forum_sn)("UserID") = UserID
		Response.Cookies(Forum_sn)("userclass") = checkStr(Request.Cookies(Forum_sn)("userclass"))
		Response.Cookies(Forum_sn)("userhidden") = UserHidden
		Response.Cookies(Forum_sn)("password") = TruePassWord
		'检查写入是否成功如果成功则更新数据
		If checkStr(Trim(Request.Cookies(Forum_sn)("password")))=TruePassWord Then
			Execute("UpDate [Dv_user] Set TruePassWord='"&TruePassWord&"' where UserID="&UserID)
			MemberWord = TruePassWord
			Dim iUserInfo
			iUserInfo = Session(CacheName & "UserID")
			iUserInfo(35) = TruePassWord
			Session(CacheName & "UserID") = iUserInfo
		End If
	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用户积分+23用户魅力+24用户威望+25用户生日+26最后登陆IP+27用户被删除数+28用户精华数+29用户隐身状态+30用户短信情况+31用户阳光会员+32用户手机+33用户组图标+34用户头衔+35验证密码+36用户今日信息+37用户待发帖子数据+38Dvbbs
		Dim Rs,SQL
		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"
		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, "|||","","")
			Rs.Close:Set Rs = Nothing
			If IsArray(Session(CacheName & "UserID")) Then

				MyUserInfo = "Dvbbs|||"& Now & "|||" & Session(CacheName & "UserID")(2) &"|||"& BoardID &"|||"& MyUserInfo &"||||||Dvbbs"
			Else
				MyUserInfo = "Dvbbs|||"& Now & "|||" & DateAdd("s",-3600,Now()) &"|||"& BoardID &"|||"& MyUserInfo &"||||||Dvbbs"
			End If
			MyUserInfo = Split(MyUserInfo,"|||")
			If Trim(MyUserInfo(35)) = Memberword And Trim(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 Trim(Session(CacheName & "UserID")(5))=Trim(MyUserInfo(5)) And Trim(Session(CacheName & "UserID")(6))=Trim(MyUserInfo(6)) Then
							Call NewPassword0()
						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")
		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' Where UserID = " & UserID)
			MyUserInfo(36) = "0|0|0"
			UserToday = Split(MyUserInfo(36),"|")
		Else
			UserToday = Split(MyUserInfo(36),"|")
			If Ubound(UserToday) <> 2 Then
				Execute("Update [Dv_User] Set UserToday='0|0|0' Where UserID = " & UserID)
				MyUserInfo(36) = "0|0|0"
				UserToday = Split(MyUserInfo(36),"|")
			End If
		End If
		Select Case UserGroupID
		Case 4
			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',LastLogin = " & SqlNowString & " Where UserID = " & UserID)
			MyUserInfo(36) = "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)