www.gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\login.asp

    <!--#include file="Conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/chan_const.asp"-->
<!--#include file="inc/chkinput.asp"-->
<!--#include file="inc/email.asp"-->
<!--#include file="inc/md5.asp"-->
<%
Mybbs.LoadTemplates("login")
Dim comeurl
Mybbs.stats=template.Strings(1)
Mybbs.Nav()
Mybbs.Head_var 0,0,template.Strings(0),"login.asp"
Dim TruePassWord
TruePassWord=Mybbs.Createpass
Select Case request("action")
Case "chk"
	Dvbbs_ChkLogin
	Mybbs.Showerr()
Case "redir"
	redir
	Mybbs.Showerr()
Case "save_redir_reg"
	call save_redir_reg()
	Mybbs.Showerr()
Case Else
	Main
End Select

Mybbs.ActiveOnline
Mybbs.Footer()

Function Main()
	Dim TempStr
	TempStr = template.html(0)
	If Mybbs.forum_setting(79)="0" Then
		TempStr = Replace(TempStr,"{$getcode}","")
	Else
		template.html(23)=Replace(template.html(23),"{$codestr}",Mybbs.GetCode())
		TempStr = Replace(TempStr,"{$getcode}",template.html(23))
	End If
	If Mybbs.Forum_ChanSetting(0)=1 And Mybbs.Forum_ChanSetting(10)=1 Then
		TempStr = Replace(TempStr,"{$rayuserlogin}",template.html(1))
	Else
		TempStr = Replace(TempStr,"{$rayuserlogin}","")
	End If
	Dim Comeurl,tmpstr
	If Request.ServerVariables("HTTP_REFERER")<>"" Then 
		tmpstr=split(Request.ServerVariables("HTTP_REFERER"),"/")
		Comeurl=tmpstr(UBound(tmpstr))
	Else
		Comeurl="index.asp"
	End If
	TempStr = Replace(TempStr,"{$comeurl}",Comeurl)
	Response.Write TempStr
	TempStr=""
End Function

Function Dvbbs_ChkLogin

	Dim UserIP
	Dim username
	Dim userclass
	Dim password
	Dim article
	Dim usercookies
	Dim mobile
	Dim chrs,i
	If Mybbs.forum_setting(79)="1" Then
		If Not Mybbs.CodeIsTrue() Then
			 Response.redirect "showerr.asp?ErrCodes=<li>验证码校验失败，请返回刷新页面后再输入验证码。&action=OtherErr"
		End If
	End If
	UserIP=Mybbs.UserTrueIP
	mobile=trim(Mybbs.CheckStr(request("mobile")))
	if mobile<>"" and request("username")="" then
		if len(mobile)<>11 then
			Mybbs.AddErrCode(9)
		end if
	end if
	if mobile<>"" then
		if len(mobile)<>11 then mobile=""
	end if
	If request("username")="" Then
		If request("mobile")="" Then
			Mybbs.AddErrCode(10)
		End If
	Else
		username=trim(Mybbs.CheckStr(request("username")))
	End If
	If request("password")="" and mobile="" Then
		Mybbs.AddErrCode(11)
	Else
		password=md5(trim(Mybbs.CheckStr(request("password"))),16)
	End If
	If Mybbs.ErrCodes<>"" Then Exit Function
	usercookies=request("CookieDate")
	'判断更新cookies目录
	Dim cookies_path_s,cookies_path_d,cookies_path
	cookies_path_s=split(Request.ServerVariables("PATH_INFO"),"/")
	cookies_path_d=ubound(cookies_path_s)
	cookies_path="/"
	For i=1 to cookies_path_d-1
		If not (cookies_path_s(i)="upload" or cookies_path_s(i)="admin") Then cookies_path=cookies_path&cookies_path_s(i)&"/"
	Next
	If Mybbs.cookiepath<>cookies_path Then
		cookies_path=replace(cookies_path,"'","")
		Mybbs.execute("update dv_setup set Forum_Cookiespath='"&cookies_path&"'")
		Dim setupData 
		Mybbs.CacheData(26,0)=cookies_path
		Mybbs.Name="setup"
		Mybbs.value=Mybbs.CacheData
	End If
	If ChkUserLogin(username,password,mobile,usercookies,1)=false Then
		'本地验证未通过，使用手机号登录的
		If mobile<>"" Then
			challenge_check mobile,password
			Exit Function
		'本地验证未通过，使用用户名登录的，并且是高级用户则继续主服务器验证流程
		Else
			set chrs=Mybbs.Execute("select UserMobile,IsChallenge from [Dv_User] where username='"&username&"' and IsChallenge=1")
			If chrs.eof and chrs.bof Then
				Mybbs.AddErrCode(12)
				Exit Function
			Else
				challenge_check chrs("UserMobile"),password
				Exit Function
			End If
			set chrs=nothing
		End If
	End If

	Dim comeurlname
	If instr(lcase(request("comeurl")),"reg.asp")>0 or instr(lcase(request("comeurl")),"login.asp")>0 or trim(request("comeurl"))="" Then
		comeurlname=""
		comeurl="index.asp"
	Else
		comeurl=request("comeurl")
		comeurlname="<li><a href="&request("comeurl")&">"&request("comeurl")&"</a></li>"
	End If

	Dim TempStr
	TempStr = template.html(2)
	If Mybbs.Forum_ChanSetting(0)=1 And Mybbs.Forum_ChanSetting(10)=1 And Mybbs.Forum_ChanSetting(12)=1 Then
		TempStr = Replace(TempStr,"{$ray_logininfo}",template.html(3))
	Else
		TempStr = Replace(TempStr,"{$ray_logininfo}","")
	End If
	TempStr = Replace(TempStr,"{$comeurl}",comeurl)
	TempStr = Replace(TempStr,"{$comeurlinfo}",comeurlname)
	TempStr = Replace(TempStr,"{$forumname}",Mybbs.Forum_Info(0))
	Response.Write TempStr
	TempStr=""

End Function

'全网认证
Function challenge_check(mobile,password)
	If Not(Mybbs.Forum_ChanSetting(0)=1 And Mybbs.Forum_ChanSetting(10)=1) Then
		Mybbs.AddErrCode(13)
		exit function
	End If
	Dim rs
	Dim MyForumID
	Dim PostChanWord
	set rs=Mybbs.Execute("select top 1 * from Dv_ChallengeInfo")
	MyForumID=rs("D_ForumID")
	PostChanWord=Get_ChallengeWord

	Dim TempStr,TempArray
	TempArray = Split(template.html(19),"||")
	TempStr = TempArray(0)
	TempStr = Replace(TempStr,"{$mobile}",mobile)
	TempStr = Replace(TempStr,"{$password}",password)
	TempStr = Replace(TempStr,"{$MyForumID}",MyForumID)
	TempStr = Replace(TempStr,"{$serverurl}",Mybbs.Get_ScriptNameUrl())
	TempStr = Replace(TempStr,"{$PostChanWord}",PostChanWord)
	TempStr = Replace(TempStr,"{$remobile}",left(mobile,3)&"xxx"&right(mobile,5))
	TempStr = Replace(TempStr,"{$usermobile}",left(mobile,3)&"xxx"&right(mobile,5))
	If PassWord<>"" Then
		TempStr = Replace(TempStr,"{$ifpassnull}",TempArray(1))
	Else
		TempStr = Replace(TempStr,"{$ifpassnull}","")
	End If
	Response.Write TempStr
	TempStr = ""
	set rs=nothing
End Function

Function redir()

	Dim ErrorCode,ErrorMsg
	Dim remobile,rechallengeWord,retokerWord,reuserpassword
	Dim resex,reqq,reemail,reusername
	Dim challengeWord_key,rechallengeWord_key
	Dim userclass
	Dim rs

	ErrorCode=trim(request("ErrorCode"))
	ErrorMsg=trim(request("ErrorMsg"))
	remobile=trim(Mybbs.CheckStr(request("mobile")))
	reuserpassword=trim(Mybbs.CheckStr(request("forumPwd")))
	rechallengeWord=trim(Mybbs.CheckStr(request("challengeWord")))
	retokerWord=trim(request("tokenWord"))
	resex=trim(Mybbs.CheckStr(request("sex")))
	If resex="F" Then 
		resex=1
	Else
		resex=0
	End If
	reqq=trim(Mybbs.CheckStr(request("qq")))
	reemail=trim(Mybbs.CheckStr(request("email")))
	reusername=trim(Mybbs.CheckStr(request("username")))

	Session("re_challenge_reg_temp")=checkreal(remobile) & "|||" & checkreal(reuserpassword) & "|||" & checkreal(resex) & "|||" & checkreal(reqq) & "|||" & checkreal(reemail) & "|||" & checkreal(reusername)

	select case ErrorCode
	case 100
		challengeWord_key=session("challengeWord_key")
		If challengeWord_key=retokerWord Then
			set rs=Mybbs.Execute("select UserMobile,IsChallenge,userid,userclass,username from [Dv_User] where UserMobile='"&remobile&"' and IsChallenge=1")
			If rs.eof and rs.bof Then
				'不是本论坛高级用户，引导其注册
				Call redir_reg_1()
				Exit Function
			Else
				Mybbs.Execute("update [Dv_User] set UserPassword='"&md5(reuserpassword,16)&"' where UserMobile='"&remobile&"' and IsChallenge=1")
				Mybbs.userid=rs(2)
				userclass=rs(3)
				reusername=rs(4)
			End If
		Else
			Mybbs.AddErrCode(14)
			'challengeWord_key & "," & retokerWord & "," & md5(Session("challengeWord") & ":" & "raynetwork",32) & "<br>原始随机数："&Session("challengeWord")&",返回随机数："&rechallengeWord&""
			Exit Function
		End If
	case 101
		Mybbs.AddErrCode(15)
		Exit Function
	case Else
		Mybbs.AddErrCode(14)
		Exit Function
	end select

	Dim TempStr
	TempStr = template.html(20)
	If Mybbs.Forum_ChanSetting(0)=1 And Mybbs.Forum_ChanSetting(10)=1 And Mybbs.Forum_ChanSetting(12)=1 Then
		TempStr = Replace(TempStr,"{$ray_logininfo}",template.html(3))
	Else
		TempStr = Replace(TempStr,"{$ray_logininfo}","")
	End If
	TempStr = Replace(TempStr,"{$reuserpassword}",reuserpassword)
	TempStr = Replace(TempStr,"{$forumname}",Mybbs.Forum_Info(0))
	Response.Write TempStr
	TempStr=""
	Dim StatUserID,UserSessionID
	StatUserID = Mybbs.checkStr(Trim(Request.Cookies(Mybbs.Forum_sn)("StatUserID")))
	If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
		StatUserID = Replace(Mybbs.UserTrueIP,".","")
		UserSessionID = Replace(Startime,".","")
		If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
		StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
	End If
	StatUserID = Ccur(StatUserID)
	'客人=SessionID+活动时间+发贴时间+版面ID
	Session(Mybbs.CacheName & "UserID") = Split(StatUserID & "_" & Now & "_" & Now & "_" & Mybbs.BoardID,"_")
	Response.Cookies(Mybbs.Forum_sn).Expires=DateAdd("s",3600,Now())
	Response.Cookies(Mybbs.Forum_sn).path=Mybbs.cookiepath
	Response.Cookies(Mybbs.Forum_sn)("StatUserID") = StatUserID
	Response.Cookies(Mybbs.Forum_sn)("usercookies") = "0"
	Response.Cookies(Mybbs.Forum_sn)("username") = reusername
	Response.Cookies(Mybbs.Forum_sn)("userid") = Mybbs.UserID
	Response.Cookies(Mybbs.Forum_sn)("password") = TruePassWord
	Response.Cookies(Mybbs.Forum_sn)("userclass") = userclass
	Response.Cookies(Mybbs.Forum_sn)("userhidden") = 2
	rem 清除图片上传数的限制
	response.cookies("upNum")=0
	Response.Cookies(Mybbs.Forum_sn).path=Mybbs.cookiepath
	
End Function

sub redir_reg_1()

	If Session("re_challenge_reg_temp")="" Then
		Mybbs.AddErrCode(14)
		exit sub
	End If

	Dim re_challenge_reg_temp
	re_challenge_reg_temp=split(Session("re_challenge_reg_temp"),"|||")

	Dim TempStr
	TempStr = template.html(21)
	TempStr = Replace(TempStr,"{$maxuserlength}",Mybbs.Forum_Setting(41))
	TempStr = Replace(TempStr,"{$minuserlength}",Mybbs.Forum_Setting(40))
	TempStr = Replace(TempStr,"{$reusername}",re_challenge_reg_temp(5))
	TempStr = Replace(TempStr,"{$width}",Mybbs.mainsetting(0))
	Response.Write TempStr
end sub

sub save_redir_reg()
	If Session("re_challenge_reg_temp")="" Then
		Mybbs.AddErrCode(14)
		exit sub
	End If

	Dim username,sex,pass1,pass2,password
	Dim useremail,face,width,height
	Dim oicq,sign,showRe,birthday
	Dim mailbody,sendmsg,rndnum,num1
	Dim quesion,answer,topic
	Dim userinfo,usersetting
	Dim userclass,UserIM
	Dim re_challenge_reg_temp
	Dim rs,sql,i,namebadword,SplitWords
	re_challenge_reg_temp=split(Session("re_challenge_reg_temp"),"|||")

	If request("name")="" or Mybbs.strLength(request("name"))>Cint(Mybbs.Forum_setting(41)) or Mybbs.strLength(request("name"))<Cint(Mybbs.Forum_setting(40)) Then
		Mybbs.AddErrCode(17)
	Else
		username=trim(request("name"))
	End If

	namebadword="=^%^?^&^;^,^'^^$^|^@@@^###"
	namebadword=split(namebadword,"^")
	For i=0 To Ubound(namebadword)
		If Instr(username,namebadword(i))>0 Then
			Mybbs.AddErrCode(18)
			Exit For
		End If
	Next
	If Instr(request("name"),chr(32))>0 Or Instr(request("name"),chr(34))>0 or Instr(request("name"),chr(9))>0 Then
		Mybbs.AddErrCode(18)
	End If

	SplitWords=split(Mybbs.RegSplitWords,",")
	For i = 0 To ubound(splitwords)
		If instr(username,splitwords(i))>0 Then
			Mybbs.AddErrCode(19)
			Exit For
		End If
	Next
	sex=re_challenge_reg_temp(2)
	password=md5(re_challenge_reg_temp(1),16)
	useremail=re_challenge_reg_temp(4)
	showRe=1
	face="images/userface/image1.gif"
	width=32
	height=32

	If request.Form("birthyear")="" or request.form("birthmonth")="" or request.form("birthday")="" Then
		birthday=""
	Else
		birthday=trim(Request.Form("birthyear"))&"-"&trim(Request.Form("birthmonth"))&"-"&trim(Request.Form("birthday"))
		If not isdate(birthday) Then birthday=""
	End If

	userinfo=checkreal(request.Form("realname")) & "|||" & checkreal(request.Form("character")) & "|||" & checkreal(request.Form("personal")) & "|||" & checkreal(request.Form("country")) & "|||" & checkreal(request.Form("province")) & "|||" & checkreal(request.Form("city")) & "|||" & request.Form("shengxiao") & "|||" & request.Form("blood") & "|||" & request.Form("belief") & "|||" & request.Form("occupation") & "|||" & request.Form("marital") & "|||" & request.Form("education") & "|||" & checkreal(request.Form("college")) & "|||" & checkreal(request.Form("userphone")) & "|||" & checkreal(request.Form("address"))
	usersetting=request.Form("setuserinfo") & "|||" & request.Form("setusertrue") & "|||" & showRe

	If Mybbs.ErrCodes<>"" Then exit sub
	Dim titlepic
	set rs=Mybbs.Execute("select usertitle,grouppic from Dv_UserGroups where not minarticle=-1 And ParentGID=4 order by minarticle")
	userclass=rs(0)
	titlepic=rs(1)
	UserIM = "|||"&re_challenge_reg_temp(3)&"|||||||||||||||"
	set rs=server.createobject("adodb.recordset")
	sql="select * from [Dv_User] where username='"&username&"' or usermobile='"&re_challenge_reg_temp(0)&"'"
	rs.open sql,conn,1,3
	If not rs.eof and not rs.bof Then
		Mybbs.AddErrCode(21)
		Exit Sub
	Else
		rs.addnew
		rs("IsChallenge")=1
		rs("username")=username
		rs("userpassword")=password
		rs("TruePassWord")=TruePassWord
		rs("useremail")=useremail
		rs("userclass")=userclass
		rs("titlepic")=titlepic
		rs("UserMobile")=re_challenge_reg_temp(0)
		Rs("UserIM")=UserIM
		Rs("UserPost")=0
		Rs("usergroupid")=4
		rs("lockuser")=0
		Rs("Usersex")=sex
		rs("JoinDate")=NOW()
		rs("Userface")=replace(face,"'","")
		rs("UserWidth")=width
		rs("UserHeight")=height
		rs("UserLogins")=1
		Rs("lastlogin")=NOW()
		rs("userWealth")=Mybbs.Forum_user(0)
		rs("userEP")=Mybbs.Forum_user(5)
		rs("usercP")=Mybbs.Forum_user(10)
		rs("userinfo")=userinfo
		rs("usersetting")=usersetting
		rs("UserFav")="陌生人,我的好友,黑名单"
		rs.update
		Mybbs.Execute("update Dv_Setup set Forum_usernum=Forum_usernum+1,Forum_lastuser='"&username&"'")
	End If
	rs.close
	set rs=Mybbs.Execute("select top 1 userid from [Dv_User] order by userid desc")
	Mybbs.userid=rs(0)
	set rs=nothing
	Mybbs.Name="setup"
	Mybbs.ReloadSetup

	If Mybbs.Forum_Setting(47)=1 Then
		'on error resume next
		'发送注册邮件
		Dim getpass
		topic=Replace(template.Strings(35),"{$Forumname}",Mybbs.Forum_Info(0))

		mailbody = template.html(17)
		mailbody = Replace(mailbody,"{$username}",Mybbs.HtmlEncode(username))
		mailbody = Replace(mailbody,"{$password}",password)
		mailbody = Replace(mailbody,"{$copyright}",Mybbs.Forum_Copyright)
		mailbody = Replace(mailbody,"{$version}",Mybbs.Forum_Version)
		select case Cint(Mybbs.Forum_Setting(2))
		case 0
			sendmsg=template.Strings(36)
		case 1
			call jmail(useremail,topic,mailbody)
		case 2
			call Cdonts(useremail,topic,mailbody)
		case 3
			call aspemail(useremail,topic,mailbody)
		case Else
			sendmsg=template.Strings(36)
		end select
		If SendMail="OK" Then
			If cint(Mybbs.Forum_Setting(23))=1 Then
				sendmsg=template.Strings(38)
			Else
				sendmsg=template.Strings(39)
			End If
		Else
			sendmsg=template.Strings(37)
		End If
		Mybbs.ErrCodes=""
	End If

	If Mybbs.Forum_Setting(46)=1 Then
		'发送注册短信
		Dim sender,title,body,UserMsg,MsgID
		sender=Mybbs.Forum_info(0)
		title=Mybbs.Forum_info(0)&"欢迎您的到来"

		body = template.html(18)
		body = Replace(body,"{$Forumname}",Mybbs.Forum_Info(0))
		'response.write body
		sql="insert into dv_message(incept,sender,title,content,sendtime,flag,issend) values('"&username&"','"&sender&"','"&title&"','"&body&"',"&SqlNowString&",0,1)"
		Mybbs.Execute(sql)
		Set rs=Mybbs.execute("select top 1 ID from [Dv_message] order by ID desc")
		MsgID=rs(0)
		Rs.close:Set Rs=Nothing
		UserMsg="1||"& MsgID &"||"& sender
		Mybbs.execute("UPDATE [Dv_User] Set UserMsg='"&Mybbs.CheckStr(UserMsg)&"' WHERE UserID="&Mybbs.userid)
	End If

	If cint(Mybbs.Forum_Setting(25))=1 Then

	Else
		Response.Cookies(Mybbs.Forum_sn).path=Mybbs.cookiepath
		Response.Cookies(Mybbs.Forum_sn)("username")=""
		Response.Cookies(Mybbs.Forum_sn)("password")=""
		Response.Cookies(Mybbs.Forum_sn)("userclass")=""
		Response.Cookies(Mybbs.Forum_sn)("userid")=""
		Response.Cookies(Mybbs.Forum_sn)("userhidden")=""
		Response.Cookies(Mybbs.Forum_sn)("usercookies")=""
		

		Dim StatUserID,UserSessionID
		StatUserID = Mybbs.checkStr(Trim(Request.Cookies(Mybbs.Forum_sn)("StatUserID")))
		If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
			StatUserID = Replace(Mybbs.UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
		StatUserID = Ccur(StatUserID)
		'客人=SessionID+活动时间+发贴时间+版面ID
		Session(Mybbs.CacheName & "UserID") = Split(StatUserID & "_" & Now & "_" & Now & "_" & Mybbs.BoardID,"_")
		Response.Cookies(Mybbs.Forum_sn).Expires=DateAdd("s",3600,Now())
		Response.Cookies(Mybbs.Forum_sn).path=Mybbs.cookiepath
		Response.Cookies(Mybbs.Forum_sn)("StatUserID") = StatUserID
 		Response.Cookies(Mybbs.Forum_sn)("usercookies") = 0
		Response.Cookies(Mybbs.Forum_sn)("username") = username
		Response.Cookies(Mybbs.Forum_sn)("password") = TruePassWord
		Response.Cookies(Mybbs.Forum_sn)("userclass") = userclass
		Response.Cookies(Mybbs.Forum_sn)("userid") = Mybbs.userid
		Response.Cookies(Mybbs.Forum_sn)("userhidden") = 2
		Mybbs.Execute("delete from dv_online where username='"&Mybbs.membername&"' Or id="&StatUserID&"")
	End If

	Dim TempStr
	TempStr = template.html(22)
	If Mybbs.Forum_ChanSetting(0)=1 And Mybbs.Forum_ChanSetting(10)=1 And Mybbs.Forum_ChanSetting(12)=1 Then
		TempStr = Replace(TempStr,"{$ray_logininfo}",template.html(3))
	Else
		TempStr = Replace(TempStr,"{$ray_logininfo}","")
	End If
	TempStr = Replace(TempStr,"{$reuserpassword}",re_challenge_reg_temp(1))
	TempStr = Replace(TempStr,"{$sendmsg}",sendmsg)
	TempStr = Replace(TempStr,"{$forumname}",Mybbs.Forum_Info(0))
	Response.Write TempStr
	TempStr=""
	Session("re_challenge_reg_temp")=""

end sub

Function checkreal(v)
Dim w
If not isnull(v) Then
	w=replace(v,"|||","§§§")
	checkreal=w
End If
End Function


Rem ==========论坛登录函数=========
Rem 判断用户登录
Function ChkUserLogin(username,password,mobile,usercookies,ctype)

	Dim rsUser,article,userclass,titlepic
	Dim userhidden,lastip,UserLastLogin
	Dim UserGrade,GroupID,ClassSql,FoundGrade
	Dim regname,iMyUserInfo
	Dim sql,sqlstr,GroupID_Q

	FoundGrade=False
	lastip=Mybbs.UserTrueIP
	userhidden=request.form("userhidden")
	If not isnumeric(userhidden) and userhidden="" Then userhidden=2
	ChkUserLogin=false
	If mobile<>"" Then
		sqlstr=" UserMobile='"&mobile&"'"
	Else
		sqlstr=" UserName='"&username&"'"
	End If
	'Session(Mybbs.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
	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 "&sqlstr&""
	set rsUser=Mybbs.Execute(sql)
	If rsUser.eof and rsUser.bof Then
		ChkUserLogin=false
		Exit Function
	Else
		iMyUserInfo=rsUser.GetString(,1, "|||", "", "")
		rsUser.Close:Set rsUser = Nothing
	End If
	iMyUserInfo = "Mybbs|||"& Now & "|||" & Now &"|||"& Mybbs.BoardID &"|||"& iMyUserInfo &"||||||Mybbs"
	iMyUserInfo = Split(iMyUserInfo,"|||")
	If trim(password)<>trim(iMyUserInfo(6)) Then
			ChkUserLogin=false
	ElseIf iMyUserInfo(17)=1 Then
			ChkUserLogin=false
	ElseIf iMyUserInfo(19)=5 Then
			ChkUserLogin=false
	Else
			ChkUserLogin=True
			Session(Mybbs.CacheName & "UserID") = iMyUserInfo
			Mybbs.UserID = iMyUserInfo(4)
			RegName = iMyUserInfo(5)
			Article = iMyUserInfo(8)
			UserLastLogin = iMyUserInfo(15)
			UserClass = iMyUserInfo(18)			
			GroupID = iMyUserInfo(19)
			TitlePic = iMyUserInfo(34)
			If Article<0 Then Article=0
	End If

	If ChkUserLogin Then
	REM 判断用户等级资料，当用户级别为跟随文章数增长则自动更新等级
	REM 自动更新用户数据
	set rsUser=Mybbs.Execute("select MinArticle,IsSetting,ParentGID from Dv_UserGroups where usertitle='"&userclass&"'")
	If rsUser.eof and rsUser.bof Then
		'如果没有找到用户等级
		'先判断该组是否有按照文章升级的，也就是MinArticle不是-1的
		set UserGrade=Mybbs.Execute("select top 1 usertitle,GroupPic,UserGroupID,IsSetting,ParentGID from Dv_UserGroups where (ParentGID="&GroupID&" Or UserGroupID="&GroupID&") and Minarticle<="&article&" and not Minarticle=-1 order by MinArticle desc")
		If not (UserGrade.eof and UserGrade.bof) Then
			userclass=UserGrade(0)
			titlepic=UserGrade(1)
			If UserGrade(3)=1 Then
				GroupID=UserGrade(2)
			Else
				GroupID=UserGrade(4)
			End If
			FoundGrade=True
		End If
		If not FoundGrade Then
			'该组在等级表中不按照文章升级
			set UserGrade=Mybbs.Execute("select top 1 usertitle,GroupPic,UserGroupID,IsSetting,ParentGID from Dv_UserGroups where UserGroupID="&GroupID&" and Minarticle=-1 order by UserGroupID")
			If not (UserGrade.eof and UserGrade.bof) Then
				userclass=UserGrade(0)
				titlepic=UserGrade(1)
				If UserGrade(3)=1 Then
					GroupID=UserGrade(2)
				Else
					GroupID=UserGrade(4)
				End If
				FoundGrade=True
			End If
			If not FoundGrade Then
			'如果在等级表中未找到相关记录，则使用组名定义等级，采用最低等级用户的图片
			set UserGrade=Mybbs.Execute("select top 1 GroupPic from Dv_UserGroups where ParentGID>0 And not Minarticle=-1 order by MinArticle")
			titlepic=UserGrade(0)
			set UserGrade=Mybbs.Execute("select usertitle from Dv_UserGroups where UserGroupID="&GroupID)
			userclass=UserGrade(0)
			End If
		End If
	Else
		'找到用户等级
		'用户等级按照发布文章升级
		If rsUser(0)>-1 Then
			'如果为自定义等级，则取其父类GroupID做升级依据
			GroupID_Q=GroupID
			If RsUser(1)=1 And RsUser(2)>0 Then GroupID_Q=RsUser(2)
			set UserGrade=Mybbs.Execute("select top 1 usertitle,GroupPic,UserGroupID,IsSetting,ParentGID from Dv_UserGroups where ParentGID="&GroupID_Q&" and Minarticle<="&article&" and not MinArticle=-1 order by MinArticle desc,UserGroupID")
			If not (UserGrade.eof and UserGrade.bof) Then
				userclass=UserGrade(0)
				titlepic=UserGrade(1)
				If UserGrade(3)=1 Then
					GroupID=UserGrade(2)
				Else
					GroupID=UserGrade(4)
				End If
				FoundGrade=True
			End If
			'如果没有相关用户组的等级记录，则采用用户组名称定义等级，采用最低等级用户的图片
			'该情况出现于认证用户组或者添加了用户组没有添加相关等级的用户组
			If not FoundGrade Then
			set UserGrade=Mybbs.Execute("select top 1 GroupPic from Dv_UserGroups where ParentGID>0 And not Minarticle=-1 order by MinArticle")
			titlepic=UserGrade(0)
			set UserGrade=Mybbs.Execute("select usertitle from Dv_UserGroups where UserGroupID="&GroupID)
			userclass=UserGrade(0)
			End If
		Else
		'用户等级不按照文章升级
			set UserGrade=Mybbs.Execute("select usertitle,GroupPic,UserGroupID,IsSetting,ParentGID from Dv_UserGroups where usertitle='"&userclass&"'")
			If not (UserGrade.eof and UserGrade.bof) Then
				userclass=UserGrade(0)
				titlepic=UserGrade(1)
				If UserGrade(3)=1 Then
					GroupID=UserGrade(2)
				Else
					GroupID=UserGrade(4)
				End If
			End If
		End If
	End If
	set rsUser=nothing
	set UserGrade=nothing
	select case ctype
	case 1
		If datediff("d",UserLastLogin,Now())=0 Then
			sql="update [Dv_User] set LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&Mybbs.UserID
		Else
			sql="update [Dv_User] set userWealth=userWealth+"&Mybbs.Forum_user(4)&",userEP=userEP+"&Mybbs.Forum_user(9)&",userCP=userCP+"&Mybbs.Forum_user(14)&",LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&Mybbs.UserID
		End If
	case 2
		sql="update [Dv_User] set UserPost=UserPost+1,UserTopic=UserTopic+1,userWealth=userWealth+"&Mybbs.Forum_user(1)&",userEP=userEP+"&Mybbs.Forum_user(6)&",userCP=userCP+"&Mybbs.Forum_user(11)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&Mybbs.UserID
	case 3
		sql="update [Dv_User] set UserPost=UserPost+1,userWealth=userWealth+"&Mybbs.Forum_user(2)&",userEP=userEP+"&Mybbs.Forum_user(7)&",userCP=userCP+"&Mybbs.Forum_user(12)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&Mybbs.UserID
	end select
	Mybbs.Execute(sql)
	Dim StatUserID,UserSessionID
		StatUserID = Mybbs.checkStr(Trim(Request.Cookies(Mybbs.Forum_sn)("StatUserID")))
		If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
			StatUserID = Replace(Mybbs.UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
	StatUserID = Ccur(StatUserID)
	Mybbs.Execute("delete from dv_online where  id="&StatUserID&"")
	If trim(username)<>trim(Mybbs.membername) Then
		Response.Cookies(Mybbs.Forum_sn)("username")=""
		Response.Cookies(Mybbs.Forum_sn)("password")=""
		Response.Cookies(Mybbs.Forum_sn)("userclass")=""
		Response.Cookies(Mybbs.Forum_sn)("userid")=""
		Response.Cookies(Mybbs.Forum_sn)("userhidden")=""
		Response.Cookies(Mybbs.Forum_sn)("usercookies")=""
		Mybbs.Execute("delete from dv_online where username='"&Mybbs.membername&"'")
	End If
	If isnull(usercookies) or usercookies="" Then usercookies="0"
	select case usercookies
	case "0"
		Response.Cookies(Mybbs.Forum_sn)("usercookies") = usercookies
	case 1
   		Response.Cookies(Mybbs.Forum_sn).Expires=Date+1
		Response.Cookies(Mybbs.Forum_sn)("usercookies") = usercookies
	case 2
		Response.Cookies(Mybbs.Forum_sn).Expires=Date+31
		Response.Cookies(Mybbs.Forum_sn)("usercookies") = usercookies
	case 3
		Response.Cookies(Mybbs.Forum_sn).Expires=Date+365
		Response.Cookies(Mybbs.Forum_sn)("usercookies") = usercookies
	end select
	Response.Cookies(Mybbs.Forum_sn).path = Mybbs.cookiepath
	Response.Cookies(Mybbs.Forum_sn)("username") = regname
	Response.Cookies(Mybbs.Forum_sn)("userid") = Mybbs.UserID
	Response.Cookies(Mybbs.Forum_sn)("password") = TruePassWord
	Response.Cookies(Mybbs.Forum_sn)("userclass") = userclass
	Response.Cookies(Mybbs.Forum_sn)("userhidden") = userhidden
	rem 清除图片上传数的限制
	Response.Cookies("upNum")=0
	Dim iUserInfo
	iUserInfo = Session(Mybbs.CacheName & "UserID")
	iUserInfo(35) = TruePassWord
	Session(Mybbs.CacheName & "UserID") = iUserInfo
	End If
End Function

%>