<!--#include file=conn.asp-->
<!--#include file=config.asp-->
<!--#include file=const.asp-->
<!--#include file=char.asp-->
<!--#include file=inc/Email_Cls.asp-->
<!--#include file=md5.asp-->
<!-- #include file="inc/UPIConfig.asp" -->

<%
'完整调用形式：
'<script src="Interface.asp?action=操作类型&name=用户名&Md5Info=验证串&pass=密码&lock=是否锁定&question=提示问题&answer=答案&email=电子邮件&sex=性别&save=Cookies保存选项"
'action、name、Md5Info是必填参数
'删除用户时不需要其它参数
'更新资料时，提供所要更新的信息即可
'注意：这里传递的用户密码为32位MD5加密
Dim Action,useremail,username,userpassword,question,answer,babynam,babybirth


Dim PEMd5Info

UpiMd5Info = UCase(Trim(Request("Md5Info")))
Action = Trim(Request("action"))
username = Trim(Request("name"))
userpassword = Trim(Request("pass"))
If Len(userpassword) = 32 Then userpassword = Mid(userpassword,9,16)

question = Trim(Request("question"))
answer = Trim(Request("answer"))
If Len(answer) = 32 Then answer = Mid(answer,9,16)
UpiUserSex = Trim(Request("sex"))
useremail=trim(request("email"))
if(UpiUserSex="1") Then
sex="先生"
else
sex="女士"
end if

useremail = Trim(Request("email"))

If Not (Action = "" or username = "" or UpiMd5Info = "") Then
	PEMd5Info = MD5(username&SecurityKey,32)
	If UpiMd5Info = UCase(PEMd5Info) Then

		Select Case Action
		Case "AddUser"
			Call AddUser()
		Case "LoginUser"
			Call LoginUser()
		Case "LogoutUser"
			Call LogoutUser()
		Case "ModifyInfo"
			Call ModifyUserInfo()
		Case"ModifyPsw"
		    Call ModifyUserPsw()
		Case "DelUser"
			Call DelUser()
		End Select
End If
End If


Sub AddUser()
dim Username,Usersex,Viptj
dim Useremail,Userface,Faceinfo,Userpoint,Userfriends
dim UserIM,Usersign,showRe,birthday,Facewidth,Faceheight
dim mailbody,sendmsg
dim Quesion,Answer,Topic,CodeStr
dim userinfo
dim userclass,splitwords

Viptj=checkStr(request("Viptj"))
if Viptj="" then
Viptj=0
end if


dim Reguserlens
Reguserlens=split(Reguserlen,"|")
if trim(request("name"))="" or strLength(trim(request("name")))>Cint(Reguserlens(1)) or strLength(trim(request("name")))<Cint(Reguserlens(0)) then
	errmsg=errmsg+"<br>"+"<li>请输入您的用户名(长度不能大于"&Reguserlens(0)&"小于"&Reguserlens(1)&")。"
	founderr=true
else
	username=trim(request("name"))
end if
if Instr(trim(request("name")),"=")>0 or Instr(trim(request("name")),"%")>0 or Instr(trim(request("name")),chr(32))>0 or Instr(trim(request("name")),"?")>0 or Instr(trim(request("name")),"&")>0 or Instr(trim(request("name")),";")>0 or Instr(trim(request("name")),",")>0 or Instr(trim(request("name")),"'")>0 or Instr(trim(request("name")),",")>0 or Instr(trim(request("name")),chr(34))>0 or Instr(trim(request("name")),chr(9))>0 or Instr(trim(request("name")),"")>0 or Instr(trim(request("name")),"$")>0 then
	errmsg=errmsg+"<br>"+"<li>用户名中含有非法字符。"
	founderr=true
else
	username=trim(request("name"))
end if


splitwords=split(RSplitWord,",")

if request("Usersex")=0 or request("Usersex")=1 then
	Usersex=request("Usersex")
else
	Usersex=1
end if
dim Password
Password=userpassword

'Userface=request("Userface")
'Facewidth=request("Facewidth")
'Faceheight=request("Faceheight")
birthday="2006-05-02"
'以下为存入数据库操作

dim titlepic,UserGroupID
Set Rs=Conn.Execute("Select top 1 UserTitle,GroupPic,UserGroupID,IsSetting,ParentGID From Ms_UserGroups Where ParentGID=3 Order By MinArticle asc")
userclass=rs(0)
titlepic=rs(1)
If Regchecked=1 Then
UserGroupID = 5
else
UserGroupID = Rs(2)
end if
set rs=server.createobject("adodb.recordset")
if cint(emailctrl)=1 then
sql="select * from [Ms_user] where Username='"&username&"' or useremail='"&useremail&"'"
else
sql="select * from [Ms_user] where Username='"&username&"'"
end if
rs.open sql,conn,1,3
if not rs.eof and not rs.bof then

	if cint(emailctrl)=1 then
		errmsg=errmsg+"<br>"+"<li>您输入的用户名已经被注册或者已经有用户使用了您填写的电子邮件地址。"
		response.write errmsg
		exit sub
	else
		errmsg=errmsg+"<br>"+"<li>您输入的用户名已经被注册。"
		response.write errmsg
		'exit sub
	end if
else
	rs.addnew
	rs("UserName")=username
	rs("UserPassword")=password
	rs("UserEmail")=trim(request("email"))
	rs("Userclass")=userclass
	rs("TitlePic")=titlepic
	rs("UserQuesion")=quesion
	rs("UserAnswer")=answer
	rs("UserIM")=UserIM
	rs("userFace")="images/userface/image1.gif"
	rs("faceinfo")="90|||115"
	rs("UserToday")="0|||0|||0"
	if Request("TemplateId")="" then
	rs("TemplateId")=1
	else
	rs("TemplateId")=Request("TemplateId")
	end if
	rs("Vipset")="0|"&Viptj&""
	if Request("Pheight")<>"" then
	rs("Userheight")=Request("Pheight")
	end if
	If Request("Signature")<>"" Then rs("UserSign")=Htmlencode(Trim(Request("Signature")))
		rs("UserGroupID")=UserGroupID
		rs("Lockuser")=0
		if len(Usersex)<1 then Usersex=1
		rs("UserSex")=Usersex
		If birthday<>"" Then rs("UserBirthday")=birthday
		rs("JoinDate")=NOW()
		rs("UserLogins")=1
		rs("LastLogin")=NOW()
		rs("Userfriends")="||||||||||||||||||||||||普通话"
		rs("UserIm")="||||||||||||||||||"
		rs("UserLastIP")=Request.ServerVariables("REMOTE_ADDR")
		rs.update
		conn.execute("UpDate Ms_Setup Set UserNum=UserNum+1,LastUser='"&username&"' where Cid=1")
		conn.execute("UpDate Ms_UserGroups Set Useradd=Useradd+1 where UserGroupID="&UserGroupID&"")
End If
rs.close
'response.write " --------------------------------"
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	dim usercookies
	usercookies="0"

	if chkuserlogin2(username,password,usercookies,1)=false then
		errmsg=errmsg+"<br>"+"<li>您的用户名并不存在，或者您的密码错误，或者您的帐号已被管理员锁定。"
		founderr=true
		response.write errmsg
		'exit sub
	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
	
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	
%>
<meta HTTP-EQUIV=REFRESH CONTENT='2; URL=index.asp'>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
<tr>
<th height=24>注册成功：<%=webname%>欢迎您的到来</th>
</tr>
<tr><td class=tablebody1><br>
<ul><%=sendmsg%><li><a href="index.asp">进入<%=webname%>交友中心</a></li>
<li>请查看您邮件并激活相应链接获得系统赠送的金钱点数！</li></ul>
</td></tr>
</table>
<%

End Sub '注册新用户结束

'登录子程序开始
Sub LoginUser()

	dim UserIP,username,userclass,password,codestr,Userart
	dim usercookies,comeurl
	UserIP=replace(Request.ServerVariables("REMOTE_ADDR"),"'","")

		username=trim(checkStr(request("name")))

     Password=userpassword
	
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 cookiepath<>cookies_path Then
		cookies_path=replace(cookies_path,"'","")
		errmsg=errmsg+"<br>"+"<li>对不起，网站的cookie设置错误，请联系管理员！"
		founderr=true
	End If
	
	if founderr then exit sub
	usercookies=request("CookieDate")
	if chkuserlogin(username,password,usercookies,1)=false then
		errmsg=errmsg+"<br>"+"<li>您的用户名并不存在，或者您的密码错误，或者您的帐号已被管理员锁定。"
		founderr=true
		exit sub
	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
response.Write "ok"
End Sub
'登陆结束

Sub ModifyUserInfo()
dim rs33,sql33
set rs33=server.createobject("adodb.recordset")
sql33="Select * from Ms_User where UserName='"&trim(request("name"))&"'"
rs33.open sql33,conn,1,3

if rs33.eof  then
	errmsg=errmsg+"<br>"+"<li>该用户名不存在。"
	founderr=true
	exit sub
else
	rs33("UserEmail")=trim(request("email"))

	rs33.Update
end if
rs33.close
set rs33=nothing
response.Write "用户资料修改成功！"
response.end
End Sub

Sub ModifyUserPsw()
dim rs33,sql33
set rs33=server.createobject("adodb.recordset")
sql33="Select * from Ms_User where UserName='"&trim(request("name"))&"'"
rs33.open sql33,conn,1,3
if rs33.eof  then
	errmsg=errmsg+"<br>"+"<li>该用户名不存在。"
	founderr=true
	exit sub
else
    dim Password
    Password=userpassword
	rs33("UserPassword")=password
	rs33.Update
end if
rs33.close
set rs33=nothing
response.Write "密码修改成功！"
response.end
End Sub
Sub DelUser()

conn.execute "delete from [qyml] where user in ("&username&") "


conn.close

End Sub

sub LogoutUser()

	dim activeuser
	membername=trim(request("name"))
	if session("userid")<>"" then
	activeuser="delete from Ms_online where id="&session("userid")
	Conn.Execute activeuser
	end if
	if membername<>"" then
	activeuser="delete from Ms_online where username='"&membername&"'"
	Conn.Execute activeuser
	end if
	Response.Cookies(Forum_sn).path=cookiepath
	Response.Cookies(Forum_sn)("username")=""
	Response.Cookies(Forum_sn)("password")=""
	Response.Cookies(Forum_sn)("userclass")=""
	Response.Cookies(Forum_sn)("userid")=""
	Response.Cookies(Forum_sn)("userhidden")=""
	Response.Cookies(Forum_sn)("usercookies")=""
	session("userid")=""
	conn.close
	set conn=nothing

end sub

Public function chkuserlogin2(username,password,usercookies,ctype)

dim rsUser,UserArt,userclass,titlepic,sqlstr,upsqlstr
dim userhidden,lastip,UserLastLogin,Udiarys,Uphotos,GroupIDs
dim UserGrade,GroupID,ClassSql,FoundGrade,Vipend,VipGroupUser
dim regname,UserWealth,UserEP,UserCP,UserPower,Usvip
FoundGrade=False

lastip=replace(Request.ServerVariables("REMOTE_ADDR"),"'","")

'userhidden=request.form("userhidden")
'if not isnumeric(userhidden) and userhidden="" then userhidden=2
chkuserlogin2=false

if ctype=1 then
	sqlstr=" username='"&checkStr(username)&"'"
elseif trim(username)=trim(membername) then
	sqlstr=" userid="&userid&""
else
	sqlstr=" username='"&checkStr(username)&"'"
end if

sql="select userpassword,lockuser,userclass,UserArt,LastLogin,userid,UserGroupID,titlepic,username,UserWealth,UserEP,UserCP,UserPower,Userdiary,UserPics,Vip_EndTime,UserVip from [Ms_User] where "&sqlstr&""
set rsUser=conn.execute(sql)
if rsUser.eof and rsUser.bof then
	chkuserlogin2=false
else
	if trim(password)<>trim(rsUser(0)) then
		chkuserlogin2=false
	elseif rsUser(1)=1 or rsUser(1)=2 then
		chkuserlogin2=false
	elseif rsUser(6)=5 then
		chkuserlogin2=false
	else
		Userclass=rsUser(2)
		UserArt=rsUser(3)
		UserLastLogin=rsUser(4)
		userid=rsUser(5)
		GroupID=rsUser(6)
		GroupIDs=GroupID
		titlepic=rsUser(7)
		regname=rsUser(8)
		UserWealth=rsUser(9)
		UserEP=rsUser(10)
		UserCP=rsUser(11)
		UserPower=rsUser(12)
		Udiarys=rsUser(13)
		Uphotos=rsUser(14)
		Vipend=rsUser(15)
		Usvip=rsUser(16)
		if UserArt<0 then UserArt=0
		chkuserlogin2=true
	end if
end if

if Not isNull(Vipend) or Vipend<>"" then''判断是否VIP组成员
	if isdate(Vipend) then
		If DateDiff("d",Now(),Vipend)>0 Then
			VipGroupUser=True
		Else
			Dim Trs
			IF GroupID>8 then
				Set tRs=Conn.Execute("Select Top 1 UserTitle,GroupPic,UserGroupID From Ms_UserGroups Where ParentGID=3 And MinArticle<="&UserArt&" Order By MinArticle Desc")
					If not tRs.Eof Then
						Conn.Execute("Update Ms_User Set UserClass='"&tRs("UserTitle")&"',TitlePic='"&tRs("GroupPic")&"',UserGroupID="&tRs("UserGroupID")&",Vip_StarTime=null,Vip_EndTime=null,UserVip=0 Where UserID="&UserID)
					End If
						Set tRs=Nothing
			Else
						Conn.Execute("Update Ms_User Set Vip_StarTime=null,Vip_EndTime=null,UserVip=0 Where UserID="&UserID)
			End If
		End If
	End If
End If
''VIP即时贴

if Usvip>1 then
dim Vipmsg
		Vipmsg="大家好，我是"&username&"，我现在已经上线，欢迎访问我的小屋！"
		sql="Insert into Ms_news (Username,Title,Addtime,Content,Typeid) VALUES ('"&username&"','"&Vipmsg&"',now(),'"&Vipmsg&"',1)"
	conn.execute(sql)
end if
if chkUserLogin2 then
REM 判断用户等级资料，当用户级别为跟随文章数增长则自动更新等级
REM 自动更新用户数据
Set rsUser=Conn.Execute("Select MinArticle,IsSetting,ParentGID,UserTitle,GroupPic From Ms_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
			'用户等级不按照文章升级，用户为系统或特殊或VIP组
			UserClass=rsUser(3)
			TitlePic=rsUser(4)
			FoundGrade=True
		End If
	End If
	If Not FoundGrade Then
		'如果不属于系统或特殊或VIP组,则将该用户属于注册用户组且按照其文章数自动更新其用户组(等级)
		if Upgroupset=1 then''是否以文章日记相册自动更新
		upsqlstr=" (Minarticle<="&UserArt&" and Udiary<="&Udiarys&" and Uphoto<="&Uphotos&") "
		else
		upsqlstr=" (Minarticle<="&UserArt&" or Udiary<="&Udiarys&" or Uphoto<="&Uphotos&") "
		end if
		Set rsUser=Conn.Execute("Select Top 1 UserTitle,GroupPic,UserGroupID From Ms_UserGroups Where ParentGID=3 And "&upsqlstr&" 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
		if GroupIDs<GroupID then
		conn.execute("UpDate Ms_UserGroups Set Useradd=Useradd+1 where UserGroupID="&GroupID&"")''升级之后组+1
		conn.execute("UpDate Ms_UserGroups Set Useradd=Useradd-1 where UserGroupID="&GroupIDs&"")''升级之后原组-1
		end if
	End If
	Set rsUser=nothing
''读取会员登录时增加多少金钱、经验、魅力、体力等
dim Upwealth,UpEp,UpCp,Uppower,splitLoginset
splitLoginset=split(Loginseting,"|")
Upwealth=Cint(splitLoginset(0))
UpEp=Cint(splitLoginset(1))
UpCp=Cint(splitLoginset(2))
Uppower=Cint(splitLoginset(3))
select case ctype
case 1
	if datediff("d",UserLastLogin,Now())=0 then
		sql="update [Ms_user] set lastlogin=Now(),UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&" where userid="&UserID
	else
		sql="update [Ms_user] set userWealth=userWealth+"&Upwealth&",userEP=userEP+"&UpEp&",userCP=userCP+"&UpCp&",UserPower=UserPower+"&Uppower&",lastlogin=Now(),UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&" where userid="&UserID
	end if
case 2
	sql="update [Ms_user] set UserArt=UserArt+1,userWealth=userWealth+"&Upwealth&",userEP=userEP+"&UpEp&",userCP=userCP+"&UpCp&",UserPower=UserPower+"&Uppower&",lastlogin=Now(),UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&" where userid="&UserID
case 3
	sql="update [Ms_user] set UserArt=UserArt+1,userWealth=userWealth+"&Upwealth&",userEP=userEP+"&UpEp&",userCP=userCP+"&UpCp&",UserPower=UserPower+"&Uppower&",lastlogin=Now(),UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&" where userid="&UserID
end select
conn.execute(sql)
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)
	conn.Execute("delete from Ms_online where  id="&StatUserID&"")
If founduser and trim(username)<>trim(membername) Then
		Response.Cookies(Forum_sn).path=cookiepath
		Response.Cookies(Forum_sn)("username")=""
		Response.Cookies(Forum_sn)("password")=""
		Response.Cookies(Forum_sn)("userclass")=""
		Response.Cookies(Forum_sn)("userid")=""
		Response.Cookies(Forum_sn)("userhidden")=""
		Response.Cookies(Forum_sn)("usercookies")=""
		conn.execute("delete from Ms_online where username='"&membername&"'")
	End If
if isnull(usercookies) or usercookies="" then usercookies="0"
select case 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") = regname
Response.Cookies(Forum_sn)("userid") = UserID
Response.Cookies(Forum_sn)("password") = PassWord
Response.Cookies(Forum_sn)("userclass") = userclass
Response.Cookies(Forum_sn)("userhidden") = userhidden
			response.write " --------------------------------"
rem 清除图片上传数的限制
response.cookies("upNum")=0
end if
set rsUser=nothing
set UserGrade=nothing
end function
%>