<!--#include file="../connshop.asp"-->
<!--#include file="../include/lebi_config.asp"-->
<!--#include file="../include/lebi_md5.asp"-->
<%
'**************************************
'* 最后更新 2010-08-30 by 56770.kingdge
'* Copyright www.56770.com
'**************************************
' 声明：本程序修改自动网论坛系统Api接口
'======================================
Dim XMLDom,XmlDoc,Node,Status,Messenge
Dim UserName,Act,appid
Status = 1
Messenge = ""

If Request.QueryString<>"" And API_Enable Then
	SaveUserCookie()
Else
	Set XmlDoc = CreateObject("msxml2.FreeThreadedDOMDocument" & MsxmlVersion)
	XmlDoc.ASYNC = False
	If API_Enable Then
		If Not XmlDoc.LOAD(Request) Then
			Status = 1
			Messenge = "数据非法，操作中止！"
			appid = "未知"
		Else
			If CheckPost() Then
				Select Case Act
					Case "checkname"
						Checkname()
					Case "reguser"
						UserReguser()
					Case "login"
						UesrLogin()
					Case "logout"
						LogoutUser()
					Case "update"
						UpdateUser()
					Case "delete"
						Deleteuser()
					Case "lock"
						Lockuser()
					Case "getinfo"
						GetUserinfo()
				End Select
			End If
		End If
	Else
		Status = 0
		Messenge = "API接口关闭，操作中止！"
		appid = "56770 EShop"
	End If
	ReponseData()
	Set XmlDoc = Nothing
End If

Sub ReponseData()
	If Act <> "getinfo" Then
		XmlDoc.loadxml "<root><appid>dvbbs</appid><status>0</status><body><message/></body></root>"
	End If
	XmlDoc.documentElement.selectSingleNode("appid").text = "56770 EShop"
	If API_Debug And Act <> "reguser" Then
		XmlDoc.documentElement.selectSingleNode("status").text = 0
		Messenge = ""
	Else
		XmlDoc.documentElement.selectSingleNode("status").text = status
	End If
	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>非法请求。</li>"
		Exit Function
	End If
	UserName =Safereplace(XmlDoc.documentElement.selectSingleNode("username").text)
	Syskey = XmlDoc.documentElement.selectSingleNode("syskey").text
	Act = XmlDoc.documentElement.selectSingleNode("action").text
	Appid = XmlDoc.documentElement.selectSingleNode("appid").text

	Dim NewMd5,OldMd5
	NewMd5 = Md5(UserName & API_ConformKey)
	Md5OLD = 1
	OldMd5 = Md5(UserName & API_ConformKey)
	Md5OLD = 0

	If Syskey=NewMd5 or Syskey=OldMd5 Then
		CheckPost = True
	Else
		Status = 1
		Messenge = Messenge & "<li>请求数据验证不通过，请与管理员联系。"& Syskey &"|"&NewMd5&"|"&OldMd5&"</li>"
	End If
End Function

Sub GetUserinfo()
	Dim Rs,Sql,Sex
	XmlDoc.loadxml "<root><appid>56770 EShop</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 [Lebi_User] WHERE User_Id='" & Safereplace(UserName) & "'"
	Set Rs = Conn.Execute(Sql)
	If Not Rs.Eof And Not Rs.Bof Then
		If Rs("sex") = "先生" Then
				Sex = "1"
		Else
				Sex = "0"
		End If
		XmlDoc.documentElement.selectSingleNode("body/email").text = Rs("user_mail") & ""
		XmlDoc.documentElement.selectSingleNode("body/question").text = Rs("user_question") & ""
		XmlDoc.documentElement.selectSingleNode("body/answer").text = Rs("user_answer") & ""
		XmlDoc.documentElement.selectSingleNode("body/gender").text = Sex & ""
		XmlDoc.documentElement.selectSingleNode("body/mobile").text = RS("user_tel") & ""
		XmlDoc.documentElement.selectSingleNode("body/userip").text = Rs("regip") & ""
		XmlDoc.documentElement.selectSingleNode("body/jointime").text = Rs("regdate") & ""
		XmlDoc.documentElement.selectSingleNode("body/balance").text = Rs("usermoney") & ""
		XmlDoc.documentElement.selectSingleNode("body/qq").text = Rs("Oicq") & ""
		XmlDoc.documentElement.selectSingleNode("body/truename").text = Rs("user_name") & ""
		XmlDoc.documentElement.selectSingleNode("body/telephone").text = Rs("user_tel") & ""
		XmlDoc.documentElement.selectSingleNode("body/address").text = Rs("user_adds") & ""
		Status = 0
		Messenge = Messenge & "<li>读取用户资料成功。</li>"
	Else
		Status = 1
		Messenge = Messenge & "<li>该用户不存在。</li>"
	End If
	Rs.Close
	Set Rs = Nothing
End Sub

Sub Checkname()
	Dim Rs,SQL,UserEmail
	UserEmail = Safereplace(Trim(XmlDoc.documentElement.selectSingleNode("email").text))
'	If IsValidEmail(UserEmail) = False Then
'		Messenge = "<li>您的Email有错误！</li>"
'		Status = 1
'		Exit Sub
'	End If
'	If CInt(Setting(28)) = 1 Then
'		Set Rs = Conn.Execute("SELECT id FROM [Lebi_User] WHERE Email='" & UserEmail & "'")
'		If Not Rs.EOF Then
'			Status = 1
'			Messenge = "<li>此邮箱["&UserEmail&"]已经占用，请您换一个邮箱再注册吧。</li>"
'			Exit Sub
'		End If
'		Rs.Close:Set Rs = Nothing
'	End If
	Set Rs = Conn.Execute("SELECT User_Id FROM [Lebi_User] WHERE User_Id ='" & UserName & "'")
	If Not (Rs.bof And Rs.EOF) Then
		Status = 1
		Messenge =  "<li>此用户已经存在,请换一个用户名再试！</li>"
	Else
		Status = 0
		Messenge =  "<li><font color=red><b>" & UserName & "</b></font> 尚未被人使用，赶紧注册吧！</li>"
	End If
	Rs.Close:Set Rs = Nothing
	Status = 0
End Sub

Sub UserReguser()
	Dim nickname,UserPass,UserEmail,Question,Answer,usercookies
	Dim strGroupName,Password,usersex,sex
	Dim Rs,SQL
	UserPass = Safereplace(XmlDoc.documentElement.selectSingleNode("password").text)
	UserEmail = Safereplace(Trim(XmlDoc.documentElement.selectSingleNode("email").text))
	Question = Safereplace(XmlDoc.documentElement.selectSingleNode("question").text)
	Answer = Safereplace(XmlDoc.documentElement.selectSingleNode("answer").text)
	sex = Safereplace(XmlDoc.documentElement.selectSingleNode("gender").text)

	If sex = "0" Then
		usersex = "女"
	Else
		usersex = "男"
	End If
	usercookies = 1
	If UserName ="" Or UserPass = "" Then
		Status = 1
		Messenge = Messenge & "<li>请填写用户名或密码。"
		Exit Sub
	End If
	Password = MD5(UserPass)
	If IsValidEmail(UserEmail) = False Then
		Messenge = Messenge & "<li>您的Email有错误！</li>"
		Status = 1
		Exit Sub
	End If
	Set Rs = Conn.Execute("SELECT User_Id FROM [Lebi_User] WHERE User_Id='" & UserName & "'")
	If Not (Rs.BOF And Rs.EOF) Then
		Status = 1
		Messenge = Messenge & "<li>Sorry！此用户已经存在,请换一个用户名再试！</li>"
		Exit Sub
	End If
	Rs.Close:Set Rs = Nothing
	Set Rs = Server.CreateObject("ADODB.Recordset")
	SQL = "SELECT * FROM [Lebi_User]"
	Rs.Open SQL,Conn,1,3
	Rs.Addnew
		Rs("User_Id") = UserName
		Rs("User_Password") = Password                          '注册会员
		Rs("User_Name") = UserName
		Rs("User_Mail") = UserEmail
		Rs("Sex") = usersex
		Rs("Oicq") = qq
		RS("Regdate")= Now()
		RS("RegIp") = request.servervariables("remote_addr")
		RS("LastLoginTime") = Now()
		RS("LastLoginIp") = request.servervariables("remote_addr")
		If Answer <> "" Then Rs("User_Answer") = Md5(Answer)
		Rs("User_Question") = Question
		If Not IsNull(Config_Lebi_Eshop(1)) And IsNumeric(Config_Lebi_Eshop(1)) Then
			RS("User_Grade") = CInt(Config_Lebi_Eshop(1))
		Else
			RS("User_Grade") = 1
		End If
		RS("Jifen") = Config_Lebi_Eshop(0)
		RS("Locksj") = Now()
		RS("Logins") = 1
		RS("UserMoney") = 0
		RS("SumPay") = 0
		RS("IfPay") = 0
		RS("Shenqing") = 0
		RS("Lock") = 1
		RS("SumMoney") = 0
	Rs.Update
	RS.Close
	Status = 0
	Messenge = "用户注册成功。"
End Sub

Sub UesrLogin()
	Dim UserPass
	UserPass = XmlDoc.documentElement.selectSingleNode("password").text
	If UserName="" or UserPass="" Then
		Status = 1
		Messenge = Messenge & "<li>请填写用户名或密码。</li>"
		Exit Sub
	End If
	UserPass = Md5(UserPass)
	If ChkUserLogin(username,UserPass,1) Then
		Status = 0
		Messenge = Messenge & "<li>登陆成功。</li>"
	Else
		Status = 1
		Messenge = Messenge & "<li>登陆失败。</li>"
	End If
End Sub

Sub LogoutUser()
		Response.Cookies(cookiesname&"_user").path = "/"
		Response.cookies(cookiesname&"_user")("user_id") = ""
		Response.cookies(cookiesname&"_user")("user_grade") = ""
		Response.cookies(cookiesname&"_user")("user_key") = ""
		session(cookiesname&"_user"&"user_id")=""
		session(cookiesname&"_user"&"user_grade")=""
End Sub

Sub UpdateUser()
	Dim Rs,SQL
	Dim UserPass,UserEmail,Question,Answer
	UserPass = XmlDoc.documentElement.selectSingleNode("password").text
	UserEmail = Trim(XmlDoc.documentElement.selectSingleNode("email").text)
	Question = XmlDoc.documentElement.selectSingleNode("question").text
	Answer = XmlDoc.documentElement.selectSingleNode("answer").text
	If UserPass <> "" Then
		UserPass = Md5(UserPass)
	End If
	If Answer <> "" THen
		Answer = Answer
	End If
	If IsValidEmail(UserEmail) = False Then
		UserEmail = ""
	End If
	Set Rs = Server.CreateObject("Adodb.RecordSet")
	SQL = "SELECT TOP 1 * FROM [Lebi_User] WHERE User_Id='" & UserName & "'"
	Rs.Open SQL,Conn,1,3
	If Not Rs.Eof And Not Rs.Bof Then
		If UserPass <> "" Then Rs("User_Password") = UserPass
		If UserEmail <> "" Then Rs("User_Mail") = UserEmail
		If Answer <> "" THen Rs("User_Answer") = Answer
		If Question <> "" Then Rs("User_Question") = Md5(Question)
		Rs.update
		Status = 0
		Messenge = "<li>基本资料修改成功。</li>"
	Else
		Status = 1
		Messenge = "<li>该用户不存在，修改资料失败。</li>"
	End If
	Rs.Close:Set Rs = Nothing
End Sub

Sub Deleteuser()
	Dim Del_Users,i,AllUserID,Del_UserName
	Dim Rs
	Del_Users = Split(UserName,",")
	For i = 0 To UBound(Del_Users)
		Del_UserName =Safereplace(Del_Users(i))
		Set Rs = Conn.Execute("SELECT User_Id FROM [Lebi_User] WHERE User_Id='" & Del_UserName & "'")
		If Not (Rs.Eof And Rs.Bof) Then
			Conn.Execute ("DELETE FROM [Lebi_User] WHERE User_Id='" & Del_UserName & "')")
			Conn.Execute ("DELETE FROM [Lebi_Action] WHERE User_Id='" & Del_UserName & "')")
			Messenge = Messenge & "<li>用户（" & Del_UserName & "）删除成功。</li>"
		End If
	Next
	Set Rs = Nothing
	Status = 0
End Sub

Sub Lockuser()
'	Dim UserStatus
'	If XmlDoc.documentElement.selectSingleNode("userstatus") is Nothing Then
'		Messenge = "<li>参数非法，中止请求。</li>"
'		Status = 1
'		Exit Sub
'	ElseIf Not IsNumeric(XmlDoc.documentElement.selectSingleNode("userstatus").text) Then
'		Messenge = "<li>参数非法，中止请求。</li>"
'		Status = 1
'		Exit Sub
'	Else
'		UserStatus = Clng(XmlDoc.documentElement.selectSingleNode("userstatus").text)
'	End If
'	If UserStatus = 0 Then
'		Conn.Execute ("UPDATE [Lebi_User] SET zt=1 WHERE User_Id='" & UserName & "'")
'	Else
'		Conn.Execute ("UPDATE [Lebi_User] SET zt=0 WHERE User_Id='" & UserName & "'")
'	End If
	Status = 0
End Sub

Sub SaveUserCookie()
	Dim S_syskey,Password,usercookies,TruePassWord,userclass,Userhidden
	S_syskey = Request.QueryString("syskey")
	UserName =Safereplace(Request.QueryString("UserName"))
	Password = Request.QueryString("Password")
	usercookies = Request.QueryString("savecookie")
	If UserName="" or S_syskey="" Then Exit Sub
	Dim NewMd5,OldMd5
	NewMd5 = Md5(UserName & API_ConformKey)
	Md5OLD = 1
	OldMd5 = Md5(UserName & API_ConformKey)
	Md5OLD = 0
	If Not (S_syskey=NewMd5 or S_syskey=OldMd5) Then
		Exit Sub
	End If
	If usercookies="" or Not IsNumeric(usercookies) Then usercookies = 0
	'用户退出
	If Password = "" Then
		Response.Cookies(cookiesname&"_user").path = "/"
		Response.cookies(cookiesname&"_user")("user_id") = ""
		Response.cookies(cookiesname&"_user")("user_grade") = ""
		Response.cookies(cookiesname&"_user")("user_key") = ""
		session(cookiesname&"_user"&"user_id")=""
		session(cookiesname&"_user"&"user_grade")=""
		Exit Sub
	End If
	ChkUserLogin username,password,usercookies
End Sub

Function ChkUserLogin(username,password,usercookies)
	ChkUserLogin = False
	Dim Rs,SQL
	Set Rs = Server.CreateObject("ADODB.Recordset")
	SQL = "SELECT Id,User_Id,User_Name,User_Password,User_Grade,User_Mail,LastLoginTime,Logins,Regdate,RegIp,LastLoginIp,Jifen,Locksj,UserMoney,SumPay,IfPay,Shenqing,Lock,SumMoney FROM [Lebi_User] WHERE User_Id='" & UserName & "'"
	Rs.Open SQL, Conn, 1, 3
	If Not Rs.EOF Then
		If password <> Rs("User_Password") Then
			ChkUserLogin = False
			Exit Function
		End If
		'登录成功，更新用户相应的数据
         RS("LastLoginTime") = Now()
         RS("Logins") = RS("Logins") + 1
		Rs.Update
		'Response.Cookies(cookiesname&"_user").path = "/"
		Response.cookies(cookiesname&"_user")("user_id") = UserName
		Response.cookies(cookiesname&"_user")("user_grade") = RS("User_Grade")
		Response.cookies(cookiesname&"_user")("user_key") = md5(password)
		session(cookiesname&"_user"&"user_id") = UserName
		session(cookiesname&"_user"&"user_grade") = RS("User_Grade")
		Select Case usercookies
		Case 0
			Response.Cookies(cookiesname&"_user")("usercookies") = usercookies
		Case 1
			Response.Cookies(cookiesname&"_user")("usercookies") = usercookies
			Response.Cookies(cookiesname&"_user").Expires=Date+1
		Case 2
			Response.Cookies(cookiesname&"_user").Expires=Date+31
			Response.Cookies(cookiesname&"_user")("usercookies") = usercookies
		Case 3
			Response.Cookies(cookiesname&"_user").Expires=Date+365
			Response.Cookies(cookiesname&"_user")("usercookies") = usercookies
		End Select
		ChkUserLogin = True
	Else
		Rs.Addnew
			Rs("User_Id") = UserName
			Rs("User_Password") = Password
			Rs("User_Name") = UserName
			Rs("User_Mail") = UserEmail
			RS("RegIp")=request.servervariables("remote_addr")
			RS("Regdate")= Now()
			RS("LastLoginTime")=Now
			RS("Logins")=1
			RS("LastLoginIp") = request.servervariables("remote_addr")
			If Not IsNull(Config_Lebi_Eshop(1)) And IsNumeric(Config_Lebi_Eshop(1)) Then
				RS("User_Grade") = CInt(Config_Lebi_Eshop(1))
			Else
				RS("User_Grade") = 1
			End If
			RS("Jifen") = Config_Lebi_Eshop(0)
			RS("Locksj") = Now()
			RS("UserMoney") = 0
			RS("SumPay") = 0
			RS("IfPay") = 0
			RS("Shenqing") = 0
			RS("Lock") = 1
			RS("SumMoney") = 0
		Rs.update
		Rs.Close
		Set Rs = Conn.Execute("SELECT Id,User_Grade FROM [Lebi_User] WHERE User_Id='" & UserName & "'")
		'Response.Cookies(cookiesname&"_user").path = "/"
		Response.cookies(cookiesname&"_user")("user_id") = UserName
		Response.cookies(cookiesname&"_user")("user_grade") = RS("User_Grade")
		Response.cookies(cookiesname&"_user")("user_key") = md5(password)
		session(cookiesname&"_user"&"user_id") = UserName
		session(cookiesname&"_user"&"user_grade") = RS("User_Grade")
		Rs.Close : Set Rs = Nothing
		ChkUserLogin = True
	End If
	Rs.Close:Set Rs = Nothing
End Function

%>