dv_clsmain.asp

一个很好的论坛程序.论坛数据和程序使用最新更新29号动网7.1论坛程序美化优化设置：1.帖子中改变字体大小2.论坛信息变量3.双击下滚

		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 Function ReloadAllForumInfo()
		'数据库部分
		Dim IsUpdate
		IsUpdate=0
		value=Date()
		Dim Rs,LastPostInfo,TempStr,i
		Set Rs=Execute("Select Top 1 Forum_YesterdayNum,Forum_TodayNum,Forum_LastPost,Forum_MaxPostNum From Dv_Setup")
		LastPostInfo = Split(Rs(2),"$")
		If Not IsDate(LastPostInfo(2)) Then LastPostInfo(2)=Now()
		If DateDiff("d",LastPostInfo(2),Now())<>0 Then
			TempStr=LastPostInfo(0)&"$"&LastPostInfo(1)&"$"&Now()&"$"&LastPostInfo(3)&"$"&LastPostInfo(4)&"$"&LastPostInfo(5)&"$"&LastPostInfo(6)&"$"&LastPostInfo(7)
			IsUpdate=1
		Else
			TempStr=Rs(2)
		End If
		If IsUpdate=1 Then Execute("Update Dv_Setup Set Forum_YesterdayNum=Forum_TodayNum,Forum_LastPost='"&TempStr&"'")
		if Rs(1)>Rs(3) then Execute("Update Dv_Setup Set Forum_MaxPostNum=Forum_TodayNum,Forum_MaxPostDate="&SqlNowString)
		If IsUpdate=1 Then Execute("Update Dv_Setup Set Forum_TodayNum=0")
		'Execute("Update Dv_Board Set TodayNum=0")
		'缓存部分
		ReloadSetupCache 0,9
		ReloadSetupCache Rs(1),11
		ReloadSetupCache TempStr,15
		LoadBoardsInfo()
		Set Rs=Nothing
	End Function
	'使用一个查询更新所有版面的缓存
	Public Sub LoadBoardsInfo()
		Dim Rs,BoardData(23,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 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)&"$"&Now()&"$"&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
				'If i=12 And IsUpdate=1 Then
				'	BoardData(12,0)=0
				'ElseIf i=14 And IsUpDate=1 Then
				'	BoardData(14,0)=LastPostInfo(0)&"$"&LastPostInfo(1)&"$"&Now()&"$"&LastPostInfo(3)&"$"&LastPostInfo(4)&"$"&LastPostInfo(5)&"$"&LastPostInfo(6)&"$"&LastPostInfo(7)
				'Else
					BoardData(i,0)=Rs(i)
				'End If
				'RS.UPDATE之后数据可以直接输出了，不需要再干预
			Next
			value = BoardData
			GetData = Value
			'If GetData(2,0)>0 Then LoadBoardParentStr Rs(0),GetData(3,0)
			'LoadBoardNews_Paper(Rs(0))
			LoadBoardList(Rs(0))
			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("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=",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,"
			If InStr(pagelist,","&ScriptName&",")>0 Then Exit Function
		End If
		NeedChecklongin=False
	End Function 
	'验证用户登陆
	Public Sub CheckUserLogin()
		If Not IsArray(Session("UserID")) Then
			If UserID>0 Then 
				TrueCheckUserLogin
			ElseIf  NeedChecklongin  Then
				TrueCheckUserLogin
			Else
				Call LetGuestSession()
			End If			
		Else
			If NeedChecklongin Then
				TrueCheckUserLogin
			ElseIf UserID >0 And Not Session("UserID")(0)="Dvbbs" Then
				TrueCheckUserLogin
			Else
				Dim NeedToUpdate
				Name="NeedToUpdate"
				If ObjIsEmpty() Then 
					NeedToUpdate=""
				Else
					NeedToUpdate=","&Value&","
				End If
				If UserID>0 And Instr(NeedToUpdate,","&MemberName&",")>0 Then
					Call NeedUpdateList(MemberName,0)
					Call TrueCheckUserLogin()
				End If
			End If
		End If
		If Session("UserID")(0) = "Dvbbs" Then
			GetCacheUserInfo
		Else
			MyUserInfo = Session("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
		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
		Execute("UpDate [Dv_user] Set TruePassWord='"&TruePassWord&"' where UserID="&UserID)
		MemberWord = TruePassWord
		Dim iUserInfo
		iUserInfo = Session("UserID")
		iUserInfo(35) = TruePassWord
		Session("UserID") = iUserInfo
	End Sub
	
	Public Sub TrueCheckUserLogin()
	'Session("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用户今日信息+37Dvbbs
		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
			MyUserInfo = "Dvbbs|||"& Now & "|||" & Now &"|||"& BoardID &"|||"& MyUserInfo &"|||Dvbbs"
			MyUserInfo = Split(MyUserInfo,"|||")
			If Trim(MyUserInfo(35)) = Memberword And Trim(MyUserInfo(5)) =Membername Then
				Session("UserID") = MyUserInfo
				Memberword = MyUserInfo(35)
				GetCacheUserInfo()
			Else
				UserID = 0
				EmptyCookies
				LetGuestSession()
			End If
		End If
	End Sub
	'用户登录成功后，采用本函数读取用户数组并判断一些常用信息
	Public Sub GetCacheUserInfo()
		MyUserInfo = Session("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)
			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
		FoundUser=True
		MyUserInfo(15)=Lastlogin
		Session("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