<!--#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_Cls.asp"-->
<!--#include file="inc/md5.asp"-->
<!--#include file="dv_dpo/Api_Config.asp"-->
<%
Dim XMLDom,XmlDoc,Node,Status,Messenge
Dim UserName,Act,appid
Status = 1
Messenge = ""
If Not DvApi_Enable Then Response.end
If Request.QueryString<>"" Then
	SaveUserCookie()
Else
	Set XmlDoc = Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument" & MsxmlVersion)
	XmlDoc.ASYNC = False
	If Not XmlDoc.LOAD(Request) Then
		Status = 1
		Messenge = "数据非法，操作中止！"
		appid = "未知"
	Else
		If Not (XmlDoc.documentElement.selectSingleNode("userip") is nothing) Then
			Dvbbs.UserTrueIP = Dvbbs.CheckStr(XmlDoc.documentElement.selectSingleNode("userip").text)
		End If
		If CheckPost() Then
			Select Case Act
				Case "checkname"
					Checkname()
				Case "reguser"
					Reguser()
				Case "login"
					UesrLogin()
				Case "logout"
					LogoutUser()
				Case "update"
					UpdateUser()
				Case "delete"
					Deleteuser()
				Case "lock"
					Lockuser()
				Case "getinfo"
					GetUserinfo()
			End Select
		End If
	End If
	ReponseData()
	Set XmlDoc = Nothing
End If
Dvbbs.PageEnd()

Sub ReponseData()
	'XmlDoc.loadxml "<root><appid>powereasy</appid><status>0</status><body><message/><email/><question/><answer/><savecookie/><truename/><gender/><birthday/><qq/><msn/><mobile/><telephone/><address/><zipcode/><homepage/><userip/><jointime/><experience/><ticket/><valuation/><balance/><posts/><userstatus/></body></root>"
	If Act <> "getinfo" Then
		XmlDoc.loadxml "<root><appid>powereasy</appid><status>0</status><body><message/></body></root>"
	End If
	XmlDoc.documentElement.selectSingleNode("appid").text = "Dvbbs"
	XmlDoc.documentElement.selectSingleNode("status").text = status
	XmlDoc.documentElement.selectSingleNode("body/message").text = ""
	Set Node = XmlDoc.createCDATASection(Replace(Messenge,"]]>","]]&gt;"))
	XmlDoc.documentElement.selectSingleNode("body/message").appendChild(Node)
	Response.Clear
	Response.ContentType="text/xml"
	Response.CharSet="gb2312"
	Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
	Response.Write XmlDoc.documentElement.XML
End Sub


Function CheckPost()
	CheckPost = False
	Dim Syskey
	If XmlDoc.documentElement.selectSingleNode("action") is Nothing or XmlDoc.documentElement.selectSingleNode("syskey") is Nothing or XmlDoc.documentElement.selectSingleNode("username")  is Nothing Then
		Status = 1
		Messenge = Messenge & "<li>非法请求。"
		Exit Function
	End If

	UserName = Dvbbs.checkstr(Trim(XmlDoc.documentElement.selectSingleNode("username").text))
	Syskey = XmlDoc.documentElement.selectSingleNode("syskey").text
	Act = XmlDoc.documentElement.selectSingleNode("action").text
	Appid = Dvbbs.CheckStr(XmlDoc.documentElement.selectSingleNode("appid").text)
	
	Dim NewMd5,OldMd5
	NewMd5 = Md5(UserName&DvApi_SysKey,16)
	Md5OLD = 1
	OldMd5 = Md5(UserName&DvApi_SysKey,16)
	Md5OLD = 0
	If DvApi_SysKey = "API_TEST" or Syskey = "Syskey" Then
		Status = 1
		Messenge = Messenge & "<li>默认非法请求。"
		Exit Function
	End If
	If Syskey=NewMd5 or Syskey=OldMd5 Then
		CheckPost = True
	Else
		Status = 1
		Messenge = Messenge & "<li>请求数据验证不通过，请与管理员联系。"
	End If
End Function


Sub GetUserinfo()
	Dim Rs,Sql
	Dim Userinfo,UserIM
	
	XmlDoc.loadxml "<root><appid>powereasy</appid><status>0</status><body><message/><email/><question/><answer/><savecookie/><truename/><gender/><birthday/><qq/><msn/><mobile/><telephone/><address/><zipcode/><homepage/><userip/><jointime/><experience/><ticket/><valuation/><balance/><posts/><userstatus/></body></root>"
	
	Sql = "Select Top 1 * From Dv_User Where UserName='"&Dvbbs.Checkstr(UserName)&"'"
	Set Rs = Dvbbs.Execute(Sql)
	If Not Rs.Eof And Not Rs.Bof Then
		Userinfo = Split(Rs("UserInfo"),"|||")
		UserIM = Split(Rs("UserIM"),"|||")
		XmlDoc.documentElement.selectSingleNode("body/email").text = Rs("UserEmail")&""
		XmlDoc.documentElement.selectSingleNode("body/question").text = Rs("UserQuesion")&""
		XmlDoc.documentElement.selectSingleNode("body/answer").text = Rs("UserAnswer")&""
		'XmlDoc.documentElement.selectSingleNode("body/savecookie").text = ""
		XmlDoc.documentElement.selectSingleNode("body/gender").text = Rs("Usersex")&""
		XmlDoc.documentElement.selectSingleNode("body/birthday").text = Rs("UserBirthday")&""
		XmlDoc.documentElement.selectSingleNode("body/mobile").text = Rs("UserMobile")&""
		'XmlDoc.documentElement.selectSingleNode("body/zipcode").text = ""
		XmlDoc.documentElement.selectSingleNode("body/userip").text = Rs("UserLastIP")&""
		XmlDoc.documentElement.selectSingleNode("body/jointime").text = Rs("JoinDate")&""
		XmlDoc.documentElement.selectSingleNode("body/experience").text = Rs("userEP")&""
		XmlDoc.documentElement.selectSingleNode("body/ticket").text = Rs("UserTicket")&""
		XmlDoc.documentElement.selectSingleNode("body/valuation").text = Rs("userCP")&""
		XmlDoc.documentElement.selectSingleNode("body/balance").text = Rs("UserMoney")&""
		XmlDoc.documentElement.selectSingleNode("body/posts").text = Rs("UserPost")&""
		XmlDoc.documentElement.selectSingleNode("body/userstatus").text = Rs("Lockuser")&""
		XmlDoc.documentElement.selectSingleNode("body/homepage").text = UserIM(0)
		XmlDoc.documentElement.selectSingleNode("body/qq").text = UserIM(1)
		XmlDoc.documentElement.selectSingleNode("body/msn").text = UserIM(3)
		XmlDoc.documentElement.selectSingleNode("body/truename").text = Userinfo(0)
		XmlDoc.documentElement.selectSingleNode("body/telephone").text = Userinfo(13)
		XmlDoc.documentElement.selectSingleNode("body/address").text = Userinfo(14)
		Status = 0
		Messenge = Messenge & "<li>读取用户资料成功。"
	Else
		Status = 1
		Messenge = Messenge & "<li>该用户不存在。"
	End If
	Rs.Close
	Set Rs = Nothing
End Sub


Sub Deleteuser()
	Dim D_Users,i,UserID,AllUserID
	Dim Rs
	D_Users = Split(UserName,",")
	AllUserID = ""
	For i=0 To UBound(D_Users)
		Set Rs=Dvbbs.Execute("Select UserName,UserID from [dv_User] where UserName='"&Dvbbs.Checkstr(D_Users(i))&"'")
		If not (rs.eof and rs.bof) then
			AllUserID = AllUserID & Rs(1) & ","
			Dvbbs.Execute("update dv_message set delR=1 where incept='"&Dvbbs.Checkstr(rs(0))&"' and delR=0")
			Dvbbs.Execute("update dv_message set delS=1 where sender='"&Dvbbs.Checkstr(rs(0))&"' and delS=0 and issend=0")
			Dvbbs.Execute("update dv_message set delS=1 where sender='"&Dvbbs.Checkstr(rs(0))&"' and delS=0 and issend=1")
			Dvbbs.Execute("delete from dv_message where incept='"&Dvbbs.Checkstr(rs(0))&"' and delR=1") 
			Dvbbs.Execute("update dv_message set delS=2 where sender='"&Dvbbs.Checkstr(rs(0))&"' and delS=1")
			Dvbbs.Execute("delete from dv_friend where F_username='"&Dvbbs.Checkstr(rs(0))&"'") 
			Dvbbs.Execute("delete from dv_bookmark where username='"&Dvbbs.Checkstr(rs(0))&"'")
			Messenge = Messenge & "<li>用户（"&D_Users(i)&"）删除成功。"
		End If
	Next
	If AllUserID<>"" Then
		If Right(AllUserID,1) = "," Then AllUserID = Left(AllUserID,Len(AllUserID)-1)
		'删除用户的帖子和精华
		Dvbbs.Execute("Delete From dv_topic where PostUserID in ("&AllUserID&")")
		Dim PostTable
		PostTable = AllPostTable
		For i=0 to ubound(PostTable,2)
			Dvbbs.Execute("Delete From "&PostTable(0,i)&" where PostUserID in ("&AllUserID&")")
		Next
		Dvbbs.Execute("Delete From dv_besttopic where PostUserID in ("&AllUserID&")")
		'删除用户上传表
		Dvbbs.Execute("Delete From dv_upfile where F_UserID in ("&AllUserID&")")
		Dvbbs.Execute("Delete From [dv_user] where userid in ("&AllUserID&")")
	End If
	Status = 0
End Sub

Function AllPostTable()
	Dim Trs
	Set Trs = Dvbbs.Execute("select TableName from [Dv_TableList]")
	AllPostTable = TRs.GetRows(-1)
	Trs.Close 
	Set Trs = Nothing
End Function

Sub SaveUserCookie()
	Dim S_syskey,Password,SaveCookie,TruePassWord,userclass,Userhidden
	S_syskey = Request.QueryString("syskey")
	UserName = Request.QueryString("UserName")
	Password = Request.QueryString("Password")
	SaveCookie = Request.QueryString("savecookie")
	If UserName="" or S_syskey="" Then Exit Sub
	Dim NewMd5,OldMd5
	NewMd5 = Md5(UserName&DvApi_SysKey,16)
	Md5OLD = 1
	OldMd5 = Md5(UserName&DvApi_SysKey,16)
	Md5OLD = 0
	If Not (S_syskey=NewMd5 or S_syskey=OldMd5) Then
		Exit Sub
	End If
	If EnabledSession Then
		Session(Dvbbs.CacheName & "UserID")=Empty
		Set Dvbbs.UserSession=Nothing
	End If
	If SaveCookie="" or Not IsNumeric(SaveCookie) Then SaveCookie = 0
	'用户退出
	If Password = "" Then
		Response.Cookies(Dvbbs.Forum_sn).path=Dvbbs.cookiepath
		Response.Cookies(Dvbbs.Forum_sn)("username")=""
		Response.Cookies(Dvbbs.Forum_sn)("password")=""
		Response.Cookies(Dvbbs.Forum_sn)("userclass")=""
		Response.Cookies(Dvbbs.Forum_sn)("userid")=""
		Response.Cookies(Dvbbs.Forum_sn)("userhidden")=""
		Response.Cookies(Dvbbs.Forum_sn)("usercookies")=""
		Session("flag")=Empty
		Exit Sub
	End If

	'用户登陆
	'Password = Md5(Password,16)
	TruePassWord = Dvbbs.Createpass
	Dim Rs,Sql
	If Not IsObject(Conn) Then ConnectionDatabase
	Set Rs = Dvbbs.iCreateObject("Adodb.RecordSet")
	Sql = "Select Top 1 UserID,UserName,UserPassword,Userclass,Userhidden,TruePassWord From Dv_User Where UserName='"&Dvbbs.Checkstr(UserName)&"'"
	Rs.Open Sql,Conn,1,3
	If Not Rs.Eof And Not Rs.Bof Then
		If Rs(2)<>Password Then
			Exit Sub
		End If
		Dvbbs.UserID = Rs(0)
		UserName = Rs(1)
		UserClass = Rs(3)
		Userhidden = Rs(4)
		Rs(5) = TruePassword
		Rs.Update
	Else
		Exit Sub
	End If
	Rs.Close
	Set Rs = Nothing
	'Response.Write "document.write("""&Dvbbs.cookiepath&""");"
	Select case SaveCookie
		case 0
			Response.Cookies(Dvbbs.Forum_sn)("usercookies") = SaveCookie
		case 1
			Response.Cookies(Dvbbs.Forum_sn).Expires=Date+1
			Response.Cookies(Dvbbs.Forum_sn)("usercookies") = SaveCookie
		case 2
			Response.Cookies(Dvbbs.Forum_sn).Expires=Date+31
			Response.Cookies(Dvbbs.Forum_sn)("usercookies") = SaveCookie
		case 3
			Response.Cookies(Dvbbs.Forum_sn).Expires=Date+365
			Response.Cookies(Dvbbs.Forum_sn)("usercookies") = SaveCookie
	End Select
	Response.Cookies(Dvbbs.Forum_sn).path = Dvbbs.cookiepath
	Response.Cookies(Dvbbs.Forum_sn)("username") = UserName
	Response.Cookies(Dvbbs.Forum_sn)("userid") = Dvbbs.UserID
	Response.Cookies(Dvbbs.Forum_sn)("password") = TruePassWord
	Response.Cookies(Dvbbs.Forum_sn)("userclass") = UserClass
	Response.Cookies(Dvbbs.Forum_sn)("userhidden") = Userhidden
	rem 清除图片上传数的限制
	Response.Cookies("upNum")=0
	'Response.Write "document.write(""OK"");"
End Sub


Sub Checkname()
	Dim UserEmail
	Dim Temp_tr,i,Rs,Sql
	UserEmail = Dvbbs.checkstr(Trim(XmlDoc.documentElement.selectSingleNode("email").text))
	Dvbbs.LoadTemplates("login")
	LoadRegSetting()
	'信息验证
	If strLength(UserName)>Cint(Dvbbs.Forum_Setting(41)) or strLength(UserName)<Cint(Dvbbs.Forum_Setting(40)) Then
		Temp_tr = Template.Strings(28)
		Temp_tr = Replace(Temp_tr,"{$RegMaxLength}",Dvbbs.Forum_Setting(41))
		Temp_tr = Replace(Temp_tr,"{$RegLimLength}",Dvbbs.Forum_Setting(40))
		Messenge = Messenge & "<li>"+Temp_tr
		Temp_tr = ""
	Else
		If XMLDom.documentElement.selectSingleNode("@checknumeric").text = "1" Then
			If IsNumeric(UserName) Then
				Messenge = Messenge & "<li>论坛不接受全数字的用户名注册."
			End If
		End If
		If Instr(UserName,"=")>0 or Instr(UserName,"%")>0 or Instr(UserName,chr(32))>0 or Instr(UserName,"?")>0 or Instr(UserName,"&")>0 or Instr(UserName,";")>0 or Instr(UserName,",")>0 or Instr(UserName,"'")>0 or Instr(UserName,",")>0 or Instr(UserName,chr(34))>0 or Instr(UserName,chr(9))>0 or Instr(UserName,"")>0 or Instr(UserName,"$")>0 Then
			Messenge = Messenge & "<li>"+template.Strings(46)
		End If
		Dim RegSplitWords
		RegSplitWords = Split(Dvbbs.Forum_setting(4),",")
		For i = 0 to Ubound(RegSplitWords)
			If Instr(UserName,RegSplitWords(i))>0 Then
				Messenge = Messenge & "<li>"+template.Strings(46)
			End If
		Next
	End If
	If UserEmail<>"" Then
		If IsValidEmail(UserEmail)=false then
			Messenge = Messenge & "<li>"+template.Strings(30)
		End If
	End If
	If Messenge<>"" Then
		'输出错误信息
		Status = 1
		Exit Sub
	End If
	If Cint(Dvbbs.Forum_Setting(24))=1 Then
		Sql="Select * From [Dv_user] Where Username='"&UserName&"' or useremail='"&UserEmail&"'"
	Else
		Sql="Select * From [Dv_user] Where Username='"&UserName&"'"
	End If
	Set Rs = Dvbbs.Execute(Sql)
	If Not Rs.Eof And Not Rs.Bof Then
		If Cint(Dvbbs.Forum_Setting(24))=1 Then
			Messenge = "您填写的用户名已经被注册或者已经有用户使用了您填写的电子邮件地址。"
		Else
			Messenge = "您填写的用户名已经被注册。"
		End If
		Status = 1
		Exit Sub
	Else
		Status = 0
		Messenge = "验证通过。"
	End If
	Rs.Close
	Set Rs = Nothing
End Sub

'用户注册
Sub Reguser()
	Dim UserPass,UserEmail,Question,Answer,usercookies
	Dim Temp_tr,i
	UserPass = Dvbbs.checkstr(XmlDoc.documentElement.selectSingleNode("password").text)
	UserEmail = Dvbbs.checkstr(Trim(XmlDoc.documentElement.selectSingleNode("email").text))
	Question = Dvbbs.checkstr(XmlDoc.documentElement.selectSingleNode("question").text)
	Answer = Dvbbs.checkstr(XmlDoc.documentElement.selectSingleNode("answer").text)
	usercookies = 1
	If UserName="" or UserPass="" or Question="" or Answer = "" Then
		Status = 1
		Messenge = Messenge & "<li>请填写用户名或密码。"
		Exit Sub
	End If
	UserPass = Md5(UserPass,16)
	Answer = Md5(Answer,16)
	Dvbbs.LoadTemplates("login")
	LoadRegSetting()
	'信息验证
	If strLength(UserName)>Cint(Dvbbs.Forum_Setting(41)) or strLength(UserName)<Cint(Dvbbs.Forum_Setting(40)) Then
		Temp_tr = Template.Strings(28)
		Temp_tr = Replace(Temp_tr,"{$RegMaxLength}",Dvbbs.Forum_Setting(41))
		Temp_tr = Replace(Temp_tr,"{$RegLimLength}",Dvbbs.Forum_Setting(40))
		Messenge = Messenge & "<li>"+Temp_tr
		Temp_tr = ""
	Else
		If XMLDom.documentElement.selectSingleNode("@checknumeric").text = "1" Then
			If IsNumeric(UserName) Then
				Messenge = Messenge & "<li>论坛不接受全数字的用户名注册."
			End If
		End If
		If Instr(UserName,"=")>0 or Instr(UserName,"%")>0 or Instr(UserName,chr(32))>0 or Instr(UserName,"?")>0 or Instr(UserName,"&")>0 or Instr(UserName,";")>0 or Instr(UserName,",")>0 or Instr(UserName,"'")>0 or Instr(UserName,",")>0 or Instr(UserName,chr(34))>0 or Instr(UserName,chr(9))>0 or Instr(UserName,"")>0 or Instr(UserName,"$")>0 Then
			Messenge = Messenge & "<li>"+template.Strings(46)
		End If
		Dim RegSplitWords
		RegSplitWords = Split(Dvbbs.Forum_setting(4),",")
		For i = 0 to Ubound(RegSplitWords)
			If Instr(UserName,RegSplitWords(i))>0 Then
				Messenge = Messenge & "<li>"+template.Strings(46)
			End If
		Next
	End If

	If IsValidEmail(UserEmail)=false then
		Messenge = Messenge & "<li>"+template.Strings(30)
	End If

	If Messenge<>"" Then
		'输出错误信息
		Status = 1
		Exit Sub
	End If

	Dim Rs,Sql
	Dim Titlepic,UserClass
	Dim TruePassWord

	Dim RegUserFace,RegTitlePic,RegClassName
	'随机产生用户头像
	Dim ForumAllFace,FaceTotalNum,RegUserFaceNum
	ForumAllFace = Split(Dvbbs.Forum_userface,"|||")
	FaceTotalNum = Ubound(ForumAllFace)-1
	Randomize
	RegUserFaceNum = Int(Rnd * FaceTotalNum)
	RegUserFace = ForumAllFace(0)&ForumAllFace(RegUserFaceNum)

	TruePassWord = Dvbbs.Createpass
	Set Rs = Dvbbs.Execute("Select UserTitle,GroupPic,UserGroupID,IsSetting,ParentGID From Dv_UserGroups Where ParentGID=3 Order By MinArticle")
	UserClass = Rs(0)
	TitlePic = Rs(1)
	Dvbbs.UserGroupID = Rs(2)
	Set Rs = Dvbbs.iCreateObject("Adodb.RecordSet")
	If Cint(Dvbbs.Forum_Setting(24))=1 Then
		Sql="Select * From [Dv_user] Where Username='"&UserName&"' or useremail='"&UserEmail&"'"
	Else
		Sql="Select * From [Dv_user] Where Username='"&UserName&"'"
	End If
	Rs.Open Sql,Conn,1,3
	If Not Rs.Eof And Not Rs.Bof Then
		If Cint(Dvbbs.Forum_Setting(24))=1 Then
			Messenge = "您填写的用户名已经被注册或者已经有用户使用了您填写的电子邮件地址。"
		Else
			Messenge = "您填写的用户名已经被注册。"
		End If
		Status = 1
		Exit Sub
	Else
		Status = 0
		Rs.AddNew
		Rs("UserName") = UserName
		Rs("UserPassword") = UserPass
		Rs("UserEmail") = UserEmail
		Rs("Userclass") = UserClass
		Rs("TitlePic") = TitlePic
		Rs("UserQuesion") = Question
		Rs("UserAnswer") = Answer

		Rs("TruePassWord") = TruePassword
		Rs("UserIM") = "||||||||||||||||||"
		Rs("UserPost") = 0
		Rs("Usersex") = 0
		Rs("Lockuser")=0
		If Dvbbs.Forum_Setting(25)="1" Then
			Rs("UserGroupID")=5
		Else
		   	Rs("UserGroupID")=Dvbbs.UserGroupID
		End If
		Rs("JoinDate")=NOW()
		Rs("UserFace") = RegUserFace
		Rs("UserWidth") = 32
		Rs("Usertoday") = "0|0|0|0|0"
		Rs("UserHeight") = 32
		Rs("UserLogins") = 1
		Rs("LastLogin") = NOW()
		Rs("userWealth") = dvbbs.Forum_user(0)
		Rs("userEP") = dvbbs.Forum_user(5)
		Rs("usercP") = dvbbs.Forum_user(10)
		Rs("UserInfo") = "||||||||||||||||||||||||||||||||||||||||||"
		Rs("Usersetting") = "0|||0|||1"
		Rs("UserPower") = 0
		Rs("UserDel") = 0
		Rs("UserIsbest") = 0
		Rs("UserFav") = "陌生人,我的好友,黑名单"
		Rs("IsChallenge") = 0
		Rs("UserHidden") = 0
		Rs("UserLastIP") = Dvbbs.UserTrueIP
		Rs.Update
		Dvbbs.Execute("UpDate Dv_Setup Set Forum_UserNum=Forum_UserNum+1,Forum_lastUser='"&Dvbbs.HtmlEncode(username)&"'")

	End If
	Rs.Close
	Set Rs = Nothing
	If Status = 0 Then
		Set Rs=Dvbbs.execute("select top 1 userid from [Dv_user] order by userid desc")
		Dvbbs.userid=rs(0)
		Rs.close
		Set Rs=nothing
		Dvbbs.ReloadSetupCache UserName,14
		Dvbbs.ReloadSetupCache (CLng(Dvbbs.CacheData(10,0))+1),10
		Saveregcount(UserName)

		If Cint(Dvbbs.Forum_Setting(23))=0 and Cint(Dvbbs.Forum_Setting(25))=0 Then
			If EnabledSession Then
				Set Dvbbs.UserSession = Nothing 
				Session(Dvbbs.CacheName & "UserID")= empty
			End If
			Dim StatUserID,UserSessionID
			StatUserID = Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("StatUserID")))
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
				StatUserID = Replace(Dvbbs.UserTrueIP,".","")
				UserSessionID = Replace(Startime,".","")
				If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
				StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
			End If
			StatUserID = Ccur(StatUserID)
			Dvbbs.Execute("Delete from dv_online where username='"&dvbbs.membername&"' Or id="&StatUserID&"")
			'Response.Cookies(Dvbbs.Forum_sn)("StatUserID") = StatUserID
			'select case usercookies
			'case 0
			'	Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
			'Case 1
			'	Response.Cookies(Dvbbs.Forum_sn).Expires=Date+1
			'	Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
			'Case 2
			'	Response.Cookies(Dvbbs.Forum_sn).Expires=Date+31
			'	Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
			'case 3
			'	Response.Cookies(Dvbbs.Forum_sn).Expires=Date+365
			'	Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
			'end select
			'Response.Cookies(Dvbbs.Forum_sn)("username") = username
			'Response.Cookies(Dvbbs.Forum_sn)("password") = TruePassWord
			'Response.Cookies(Dvbbs.Forum_sn)("userclass") = userclass
			'Response.Cookies(Dvbbs.Forum_sn)("userid") = Dvbbs.userid
			'Response.Cookies(Dvbbs.Forum_sn)("userhidden") = 2
			'Response.Cookies(Dvbbs.Forum_sn).path = Dvbbs.cookiepath
			Dvbbs.membername = Username
			Dvbbs.userhidden = 2
			Dvbbs.MemberClass = Userclass		
		End If
		Session("regtime")=now()
		Messenge = "注册成功。"
	End If

End Sub

'更新用户状态
Sub Lockuser()
	Dim UserStatus,Rs,Sql,locktype
	If XmlDoc.documentElement.selectSingleNode("userstatus") is Nothing Then
		Messenge = "<li>参数非法，中止请求。"
		Status = 1
		Exit Sub
	ElseIf Not IsNumeric(XmlDoc.documentElement.selectSingleNode("userstatus").text) Then
		Messenge = "<li>参数非法，中止请求。"
		Status = 1
		Exit Sub
	Else
		UserStatus = Clng(XmlDoc.documentElement.selectSingleNode("userstatus").text)
	End If
	Select Case UserStatus
		Case 1
			locktype="锁定"
		Case 2
			locktype="屏蔽"
		Case Else
			locktype="解锁"
	End Select
	If Not IsObject(Conn) Then ConnectionDatabase

	Set Rs = Dvbbs.iCreateObject("Adodb.RecordSet")
	Sql  = "Select Lockuser From [Dv_user] Where UserGroupID>1 and Username='"&UserName&"'"
	Rs.Open Sql,Conn,1,3
	If Not Rs.Eof And Not Rs.Bof Then
		Status = 0
		Messenge = "<li>"&locktype&"成功。"
		Rs("Lockuser") = UserStatus
		Rs.Update
		sql="insert into Dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('"&username&"','"&appid&"','用户操作："&locktype& "','"&Dvbbs.UserTrueIP&"',6)"
		Dvbbs.Execute(SQL)
	End If
	Rs.close
	Set Rs = Nothing
End Sub


'用户信息修改
Sub UpdateUser()
	Dim Rs,Sql
	Dim UserPass,UserEmail,Question,Answer
	UserPass = Dvbbs.checkstr(XmlDoc.documentElement.selectSingleNode("password").text)
	UserEmail = Dvbbs.checkstr(Trim(XmlDoc.documentElement.selectSingleNode("email").text))
	Question = Dvbbs.checkstr(XmlDoc.documentElement.selectSingleNode("question").text)
	Answer = Dvbbs.checkstr(XmlDoc.documentElement.selectSingleNode("answer").text)
	If UserPass<>"" Then
		UserPass = Md5(UserPass,16)
	End If
	If Answer<>"" THen
		Answer = Md5(Answer,16)
	End If
	Set Rs = Dvbbs.iCreateObject("Adodb.RecordSet")
	Sql="Select Top 1 * From [Dv_user] Where Username='"&UserName&"'"
	If Not IsObject(Conn) Then ConnectionDatabase
	Rs.Open Sql,Conn,1,3
	If Not Rs.Eof And Not Rs.Bof Then
		If UserPass<>"" Then Rs("UserPassword") = UserPass
		If Answer<>"" THen Rs("UserAnswer") = Answer
		If UserEmail<>"" Then Rs("UserEmail") = UserEmail
		If Question<>"" Then Rs("UserQuesion") = Question
		Rs.update
		Status = 0
		Messenge = "<li>基本资料修改成功。"
	Else
		Status = 1
		Messenge = "<li>该用户不存在，修改资料失败。"
	End If
	Rs.Close
	Set Rs = Nothing
End Sub

'用户退出
Sub LogoutUser()
	If Not IsObject(Conn) Then ConnectionDatabase
	Dim activeuser,TempNum
	If Not CLng(DVbbs.UserSession.documentElement.selectSingleNode("userinfo/@userid").text)=0 Then
		activeuser="delete from Dv_online where userid= "& DVbbs.UserSession.documentElement.selectSingleNode("userinfo/@userid").text
		Conn.Execute activeuser,TempNum
		'更新缓存总用户在线数据
		MyBoardOnline.Forum_UserOnline = MyBoardOnline.Forum_UserOnline - TempNum
		Dvbbs.Name="Forum_UserOnline"
		Dvbbs.value=MyBoardOnline.Forum_UserOnline
	Else
		If IsNumeric(DVbbs.UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text) Then 
			activeuser="delete from Dv_online where id="& DVbbs.UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text
			Conn.Execute activeuser,TempNum
			'更新缓存总用户在线数据
			MyBoardOnline.Forum_GuestOnline = MyBoardOnline.Forum_GuestOnline - TempNum
			Dvbbs.Name="Forum_GuestOnline"
			Dvbbs.value=MyBoardOnline.Forum_GuestOnline
		End If 
	End If
	MyBoardOnline.Forum_Online = MyBoardOnline.Forum_Online - TempNum
	Dvbbs.Name="Forum_Online"
	Dvbbs.value=MyBoardOnline.Forum_Online
	If EnabledSession Then
		Session(Dvbbs.CacheName & "UserID")=Empty
	End If
	Set Dvbbs.UserSession=Nothing
	Session("flag")=Empty
	Status = 0
	Messenge = "退出成功。"
End Sub


'用户登陆
Sub UesrLogin()
	Dim UserPass
	Dim i
	
	UserPass = Dvbbs.checkstr(XmlDoc.documentElement.selectSingleNode("password").text)
	If UserName="" or UserPass="" Then
		Status = 1
		Messenge = Messenge & "<li>请填写用户名或密码。"
		Exit Sub
	End If
	UserPass = Md5(UserPass,16)
	'判断更新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 dvbbs.cookiepath<>cookies_path Then
		Cookies_path = replace(cookies_path,"'","")
		Dvbbs.execute("update dv_setup set Forum_Cookiespath='"&cookies_path&"'")
		Dim setupData 
		Dvbbs.CacheData(26,0)=cookies_path
		Dvbbs.Name="setup"
		Dvbbs.value = Dvbbs.CacheData
	End If
	'判断用户是否登录
    If ChkUserLogin(UserName, UserPass, "", 3, 1)=False Then
		Status = 1
		Messenge = Messenge & "<li>登陆失败。"
	Else
		Status = 0
		Messenge = Messenge & "<li>登陆成功。"
	End If
End Sub

Rem ==========论坛登录函数=========
Rem 判断用户登录
Function ChkUserLogin(username,password,mobile,usercookies,ctype)
	Dim TruePassWord
	'产生随机密码
	TruePassword = Dvbbs.Createpass
	Dim rsUser,article,userclass,titlepic
	Dim userhidden,lastip,UserLastLogin
	Dim GroupID,ClassSql,FoundGrade
	Dim regname,iMyUserInfo
	Dim sql,sqlstr,OLDuserhidden

	FoundGrade=False
	lastip=Dvbbs.UserTrueIP
	'userhidden=request.form("userhidden")
	If userhidden <> "1" Then userhidden=2
	ChkUserLogin=false
	If mobile<>"" Then
		sqlstr=" Passport='"&mobile&"'"
	Else
		sqlstr=" UserName='"&username&"'"
	End If
	Sql="Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,lastlogin as cometime , LastLogin as activetime,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,userid as boardid"
	Sql=Sql & " From [Dv_User] Where "&sqlstr&""
	set rsUser=Dvbbs.Execute(sql)
	If rsUser.eof and rsUser.bof Then
		Messenge = Messenge & "<li>该用户不存在。"
		ChkUserLogin=False
		Exit Function
	Else
		If rsUser("Lockuser") =1 Or rsUser("UserGroupID") =5 Then
			Status = 1
			Messenge = Messenge & "<li>该用户已被系统锁定。"
			ChkUserLogin=False
			Exit Function
		Else
			If Trim(password)=Trim(rsUser("UserPassword")) Then
				ChkUserLogin=True
				Dvbbs.UserID=RsUser("UserID")
				RegName = RsUser("UserName")
				Article= RsUser("UserPost")
				UserLastLogin = RsUser("cometime")
				UserClass = RsUser("Userclass")		
				GroupID = RsUser("userGroupID")
				OLDuserhidden=RsUser("UserHidden")
				TitlePic = RsUser("UserTitle")
				If Article < 0  Then Article=0
				'Set Dvbbs.UserSession=Dvbbs.RecordsetToxml(rsUser,"userinfo","xml")
				'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@cometime").text=Now()
				'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=DateAdd("s",-3600,Now())
				'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@boardid").text=0
				'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(Dvbbs.UserSession.createNode(2,"isuserpermissionall","")).text=Dvbbs.FoundUserPermission_All()
				If OLDuserhidden <> CLng(userhidden) Then
					'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userhidden").text=userhidden
					Dvbbs.Execute("update Dv_user set userhidden="&userhidden&" where UserId=" & Dvbbs.UserID)
				End If
				'Dim BS
				'Set Bs=Dvbbs.GetBrowser()
				'Dvbbs.UserSession.documentElement.appendChild(Bs.documentElement)
				'If EnabledSession Then 	Session(Dvbbs.CacheName & "UserID")=Dvbbs.UserSession.xml
			Else
				Messenge = Messenge & "<li>请检查您填写的密码是否正确。"
				ChkUserLogin=False
				Exit Function
			End If
		End If
	End If
	If ChkUserLogin Then
		REM 判断用户组(等级)资料，当用户级别为跟随文章数增长则自动更新用户组(等级)
		REM 自动更新用户数据
		REM 如果属于系统或特殊或多属性组
		Set rsUser=Dvbbs.Execute("Select MinArticle,IsSetting,ParentGID,UserTitle,GroupPic From Dv_UserGroups Where UserGroupID="&GroupID)
		If Not (rsUser.Eof And rsUser.Bof) Then
			If rsUser(2)=1 Or rsUser(2)=2 Or rsUser(2)=4 Or rsUser(2)=5 Then
				'用户等级不按照文章升级，用户为系统或特殊或多属性组
				UserClass=rsUser(3)
				TitlePic=rsUser(4)
				FoundGrade=True
			End If
		End If
		If Not FoundGrade Then
			'如果不属于系统或特殊或多属性组,则将该用户属于注册用户组且按照其文章数自动更新其用户组(等级)
			Set rsUser=Dvbbs.Execute("Select Top 1 usertitle,GroupPic,UserGroupID From Dv_UserGroups Where ParentGID=3 And Minarticle<="&Article&" Order By MinArticle Desc,UserGroupID")
			If Not (rsUser.Eof And rsUser.Bof) Then
				UserClass=rsUser(0)
				TitlePic=rsUser(1)
				GroupID=rsUser(2)
				FoundGrade=True
			End If
		End If
		Set rsUser=nothing
		If Not FoundGrade Then
			Status = 1
			Messenge = Messenge & "<li>系统没有找到您的注册用户组资料，请联系管理员进行修正。"
			Exit Function
		End If
		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="&dvbbs.UserID
			Else
				sql="update [Dv_User] set userWealth=userWealth+"&Dvbbs.Forum_user(4)&",userEP=userEP+"&Dvbbs.Forum_user(9)&",userCP=userCP+"&Dvbbs.Forum_user(14)&",LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
			End If
		case 2
			sql="update [Dv_User] set UserPost=UserPost+1,UserTopic=UserTopic+1,userWealth=userWealth+"&Dvbbs.Forum_user(1)&",userEP=userEP+"&Dvbbs.Forum_user(6)&",userCP=userCP+"&Dvbbs.Forum_user(11)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
		case 3
			sql="update [Dv_User] set UserPost=UserPost+1,userWealth=userWealth+"&Dvbbs.Forum_user(2)&",userEP=userEP+"&Dvbbs.Forum_user(7)&",userCP=userCP+"&Dvbbs.Forum_user(12)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
		end select
		Dvbbs.Execute(sql)
		Dim StatUserID,UserSessionID
			StatUserID = Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("StatUserID")))
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
				StatUserID = Replace(Dvbbs.UserTrueIP,".","")
				UserSessionID = Replace(Startime,".","")
				If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
				StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
			End If
		StatUserID = Ccur(StatUserID)
		Dvbbs.Execute("delete from dv_online where  id="&StatUserID&"")
		'If trim(username)<>trim(Dvbbs.membername) Then
			'Response.Cookies(Dvbbs.Forum_sn)("username")=""
			'Response.Cookies(Dvbbs.Forum_sn)("password")=""
			'Response.Cookies(Dvbbs.Forum_sn)("userclass")=""
			'Response.Cookies(Dvbbs.Forum_sn)("userid")=""
			'Response.Cookies(Dvbbs.Forum_sn)("userhidden")=""
			'Response.Cookies(Dvbbs.Forum_sn)("usercookies")=""
			'Dvbbs.Execute("delete from dv_online where username='"&Dvbbs.membername&"'")
		'End If
		'If isnull(usercookies) or usercookies="" Then usercookies="0"
		'select case usercookies
		'case "0"
			'Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
		'case 1
			'Response.Cookies(Dvbbs.Forum_sn).Expires=Date+1
			'Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
		'case 2
			'Response.Cookies(Dvbbs.Forum_sn).Expires=Date+31
			'Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
		'case 3
			'Response.Cookies(Dvbbs.Forum_sn).Expires=Date+365
			'Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
		'end select
		
		'Response.Cookies(Dvbbs.Forum_sn).path = Dvbbs.cookiepath
		'Response.Cookies(Dvbbs.Forum_sn)("username") = regname
		'Response.Cookies(Dvbbs.Forum_sn)("userid") = Dvbbs.UserID
		'Response.Cookies(Dvbbs.Forum_sn)("password") = TruePassWord
		'Response.Cookies(Dvbbs.Forum_sn)("userclass") = userclass
		'Response.Cookies(Dvbbs.Forum_sn)("userhidden") = userhidden
		rem 清除图片上传数的限制
		'Response.Cookies("upNum")=0
		'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@truepassword").text= TruePassWord
		Dvbbs.Membername=Dvbbs.Checkstr(regname)
		Dvbbs.Memberclass=Dvbbs.Checkstr(userclass)
		Dvbbs.UserGroupID=GroupID
	End If
End Function



'-------------------------------------------------------------------------------------------------------
Sub LoadRegSetting()
	Dim Node
	Set XMLDom=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
	If XMLDom.loadxml(Dvbbs.CacheData(27,0)) Then
		If XMLDom.documentElement.nodeName<>"regsetting" Then
			ToDefaultsetting()
		End If
	End If
End Sub

Sub ToDefaultsetting()
	Dim Node
	Set XMLDom=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
	XMLDom.appendChild(XMLDom.createElement("regsetting"))
	Set Node=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"checkip",""))
	Node.attributes.setNamedItem(XMLDom.createNode(2,"use","")).text="0"
	Node.appendChild(XMLDom.createElement("iplist1"))
	Node.appendChild(XMLDom.createElement("iplist2"))
	XMLDom.documentElement.attributes.setNamedItem(XMLDom.createNode(2,"postipinfo","")).text="0"
	XMLDom.documentElement.attributes.setNamedItem(XMLDom.createNode(2,"checknumeric","")).text="0"
	XMLDom.documentElement.attributes.setNamedItem(XMLDom.createNode(2,"checktime","")).text="0"
	XMLDom.documentElement.attributes.setNamedItem(XMLDom.createNode(2,"usevarform","")).text="0"
	XMLDom.documentElement.attributes.setNamedItem(XMLDom.createNode(2,"checkregcount","")).text="0"
	Dvbbs.Execute("update dv_setup set Forum_Boards='"&Dvbbs.checkstr(XMLDom.XML)&"'")
	Dvbbs.loadSetup()
End Sub

Sub Saveregcount(username)
	Dim Node,rs,XMLDom1
	Set XMLDom1=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
	Set Rs=Dvbbs.Execute("select Forum_Ad From Dv_setup")
	If Not XMLDom1.loadxml(Rs(0)) Then
		XMLDom1.LoadXML "<?xml version=""1.0""?><reglist/>"
	Else
		For Each Node in XMLDom1.documentElement.selectNodes("ip")
			If Datediff("d",Node.selectSingleNode("@datetime").text,Now()) > 0 Then
					XMLDom1.documentElement.removeChild(node)	
			End If
		Next
	End If
	Set Node=XMLDom1.documentElement.appendChild(XMLDom1.createNode(1,"ip",""))
	Node.text=Dvbbs.userTrueIP
	Node.attributes.setNamedItem(XMLDom1.createNode(2,"datetime","")).text=Now()
	Node.attributes.setNamedItem(XMLDom1.createNode(2,"username","")).text=username
	Dvbbs.Execute("update Dv_setup set Forum_Ad='"&Dvbbs.checkstr(XMLDom1.xml)&"'")
End Sub

%>