<!--#include file="Index_Setting.asp"-->
<!--#include file="Inc/Cl_ClsEmail.asp"-->
<!--#include file="Inc/Cl_Md5.asp"-->
<!--#include file="Inc/Cl_ClsCount.asp"-->
<!--#include file="Inc/UPIConfig.asp"-->
<title>恒浪创力整合接口</title>
<%
Dim HLMd5Info,UpiMd5Info,Action
Dim UserName,Password,PwdConfirm,Question,Answer,Sex,Email,CookieDate
Dim UserReName,IDCard,BirthDay,CityInfo,ZipCode,UserTelePhone,UserAddRess,TruePassWord
Dim SchoolAge,UserWorking,UserHomePhone,UserMobile
Dim UserIM,CheckNum,CheckUrl,sqlReg,rsReg
Dim strMsg,strTitle,strbody
Dim RsGroup,sChargeType,sValidDays,sGroupPoint,sUserInfo,rsUGroup,sAddPoint
Dim rs_1,str_1,RegSiteIds
'---------通行证字段赋值
UpiMd5Info = UCase(Trim(Request("Md5Info")))
Action = Trim(Request("action"))
RegSiteIds=Trim(Request("RegSiteId"))
UserName = replace(Trim(Request("name")),"'","")
Password = replace(Trim(Request("pass")),"'","")
If Len(Password) = 32 Then Password = Mid(Password,9,16)
Question = Trim(Request("question"))
Answer = Trim(Request("answer"))
If Len(Answer)=32 Then Answer=Mid(Answer,9,16)
Sex = Trim(Request("sex"))
If Sex="" or Sex=2 or Sex=3 Then Sex=0
Email = Trim(Request("email"))
'--------------------------------------
UserReName=Trim(Request("TrueName"))
'-------------------------
CookieDate = Trim(Request("save"))
'--------------------------CL REG Begin-----------------------
If Action="LogoutUser" then Call LogoutUser()
If Not (Action = "" or UserName = "" or UpiMd5Info = "") Then

	HLMd5Info = MD5(UserName&SecurityKey,32)
	
	If UpiMd5Info = UCase(HLMd5Info) Then
	Select Case Action
		Case "AddUser"
			Call AddUser()
			Call RegSiteID()	
		Case "LoginUser"
			Call LoginUser()
		Case "ModifyInfo"
		   Call ModifyUserInfo()
		Case"ModifyPsw"
		   Call ModifyUserPsw()
		Case "DelUser"
		   Call DelUser()
		End Select
    End If
End If

Sub AddUser()

if Cl.Web_Setting(21)<>"Yes" then 
Cl.OutErr("<li>对不起，本站暂停新用户注册服务！</li>")
response.end
End if

    UserIM			=sRIM(Trim(Request("Homepage")))&"|||"&sRIM(Trim(Request("QQ")))&"|||"&sRIM(Trim(Request("ICQ")))&"|||"&sRIM(Trim(Request("MSN")))&"|||"&sRIM(Trim(Request("AIM")))&"|||"&sRIM(Trim(Request("YaHoo")))&"|||"&sRIM(Trim(Request("UC")))
	UserIM			= Server.HTMLencode(UserIM)
	UserReName		= Trim(request("UserReName"))
	IDCard			= Trim(request("IDCard"))
	BirthDay		= Trim(request("BirthDay"))
	CityInfo		=Server.HTMLencode(sRIM(Trim("中国"))&"|||"&sRIM(Trim(request("Province")))&"|||"&sRIM(Trim(request("City"))))
	ZipCode			= Trim(Request("ZipCode"))
	UserTelePhone	= Trim(request("UserTelePhone"))
	UserAddRess		= Trim(request("UserAddRess"))
	SchoolAge		= Trim(request("SchoolAge"))
	UserWorking		= Trim(request("UserWorking"))
	UserHomePhone	= Trim(request("UserHomePhone"))
	UserMobile		= Trim(request("UserMobile"))
    CheckNum = Cl.Createpass(12)
	CheckUrl=Request.ServerVariables("HTTP_REFERER")
	CheckUrl=left(CheckUrl,instrrev(CheckUrl,"/")) & "Reg.asp?Action=active&UserName=" & UserName & "&Password=" & Password & "&CheckNum=" & CheckNum
	sqlReg="Select Top 1 * From " & Db.UserTable & " where " & Db.UserName & "='" & UserName & "' or " & Db.UserEmail & "='" & Email & "'"
	set rsReg=server.createobject("adodb.recordset")
	OpenConn_U : rsReg.open sqlReg,Conn_U,1,3
	if not(rsReg.bof and rsReg.eof) then
		rsReg.close:set rsReg=Nothing
		Cl.OutErr("<br><li>你注册的用户或者用户邮箱已经存在！请换一个用户名或者用户邮箱再试试！</li>")
	End if
	Set RsGroup=Cl.Execute("Select ChargeType,ValidDays,GroupPoint From Cl_UserGroup Where ID=4")
	if Not (RsGroup.Bof and RsGroup.Eof) then
		sChargeType	= RsGroup(0)
		sValidDays	= RsGroup(1)
		sGroupPoint	= RsGroup(2)
	else
		sChargeType	= 1
		sValidDays	= 0
		sGroupPoint	= 0
	end if
	RsGroup.Close : Set RsGroup=Nothing
	rsReg.addnew
	rsReg(Db.UserName)		= UserName
	rsReg(Db.UserReName)	= UserReName
	rsReg(Db.UserPassword)	= Password
	if IsDate(Birthday) then
		rsReg(Db.UserBirthday)	= Birthday
	end if
	rsReg(Db.UserQuestion)	= Question
	rsReg(Db.UserAnswer)	= md5(Answer,16)
	rsReg(Db.UserSex)		= Sex
	rsReg(Db.UserEmail)		= Email
	rsReg(Db.UserIM)		= UserIM
	rsReg(Db.UserJoinDate)	= Now()
	rsReg(Db.UserDataNum)	= 0
	rsReg(Db.UserLogins)	= 0
	rsReg(Db.UserLastLogin)	= Now()
	rsReg(Db.ChargeType)	= sChargeType
	rsReg(Db.UserPoint)		= sGroupPoint
	rsReg(Db.BeginDate)		= Now()
	rsReg(Db.ValidNum)		= sValidDays
	rsReg(Db.UserCheckNum)	= CheckNum
	rsReg(Db.UserLastIP)	= Cl.UserTrueIP
	if Cl.Web_Setting(23)="Yes" then
		rsReg(Db.UserLevel)	= 7
	else
		if Cl.Web_Setting(24)="Yes" then
			rsReg(Db.UserLevel)= 6
		else
			rsReg(Db.UserLevel)= 4
		end if
	end if
	rsReg(Db.UserFace)		= ""
	rsReg(Db.UserFaceWidth) = 60
	rsReg(Db.UserFaceHeight)= 60
	rsReg(Db.UserTelePhone) = UserTelePhone
	rsReg(Db.UserHomePhone) = UserHomePhone
	rsReg(Db.UserMobile)	= UserMobile
	rsReg(Db.CityInfo)		= CityInfo
	rsReg(Db.UserAddRess)	= UserAddRess
	rsReg(Db.UserWorking)	= UserWorking
	rsReg(Db.IDCard)		= IDCard
	rsReg(Db.ZipCode)		= ZipCode
	rsReg(Db.SchoolAge)		= SchoolAge
	rsReg.Update
	rsReg.Close : Set rsReg=Nothing
	'==========================================================
	Set rsReg=Cl.Execute_U("Select "&Db.UserID&","&Db.UserPassWord&","&Db.UserLevel&" From "&Db.UserTable&" Where "&Db.UserName&"='"&UserName&"'")
	if Not rsReg.eof then
		if rsReg(Db.UserLevel)=4 then
		if Cl.UserID=0 then
			Set Count = New Cls_Count
			Count.DelOnline 0, Cl.UserID, Session(Cl.CacheName & "UserID")(0)
			Set Count = Nothing
		end if
		'Response.Cookies(Cl.Web_Cookies).path			= InstallDir
		Response.Cookies(Cl.Web_Cookies)("UserID")		= rsReg(0)
		Response.Cookies(Cl.Web_Cookies)("UserName")	= UserName
		Response.Cookies(Cl.Web_Cookies)("Password")	= rsReg(1)
		Response.Cookies(Cl.Web_Cookies)("UserLevel")	= 4
		End if
	End if
	rsReg.close:set rsReg=Nothing
	
End Sub

Sub LoginUser()
TruePassWord	= Cl.Createpass(16)

    sql="select U." & Db.UserID & ",U." & Db.UserName & ",U." & Db.UserPassWord & ",U."&Db.UserReName&",U." & Db.UserEmail & ",U." & Db.UserSex & ",U." & Db.UserFace & ",U." & Db.UserFaceWidth & ",U." & Db.UserFaceHeight & ",U." & Db.UserIM & ",U." & Db.UserJoinDate & ",U." & Db.UserLastLogin & ",U." & Db.UserLogins & ",U." & Db.UserQuestion & ",U." & Db.UserAnswer & ",U." & Db.UserLastIP & ",U." & Db.UserDataNum & ",U." & Db.UserLevel & ",U." & Db.UserPoint & ",U." & Db.UserMoney & ",U." & Db.ChargeType & ",U." & Db.BeginDate & ",U." & Db.ValidNum & ",U." & Db.UserTPassWord & ",U." & Db.WaitReceive & ",U." & Db.Received & ",U." & Db.UserMsg & ",G.GroupName,G.GroupImg,G.LoginPoint,G.Purview,G.Purview_Other,G.arrClassView,G.arrClassInput,G.arrClassCheck,G.arrClassMaster From " & Db.UserTable & " U Inner Join Cl_UserGroup G On U." & Db.UserLevel & "=G.ID where U." & Db.UserLock & "=0 and U." & Db.UserName & "='" & UserName & "'"
	Set Rs=Cl.Execute_U(sql)
	
	if rs.bof and rs.eof then
		rs.close:set rs=Nothing
		Call Cl.OutMsg("用户名或密码错误！！！","Login.Asp?ComeUrl=" & ComeUrl)
	End if
	if Password<>Rs(2) then
		rs.close:set rs=Nothing
		Call Cl.OutMsg("用户名或密码错误！！！","Login.Asp?ComeUrl=" & ComeUrl)
	End if
	
	if Rs(17)=6 or Rs(17)=7 then
		rs.close:set rs=Nothing
		Call Cl.OutMsg("对不起，你尚未通过认证，不能登录！","Index.asp") 
	End if
	if DateDiff("D",rs(11),Now)>0 then
		'添加积分
		Cl.Execute_U("Update " & Db.UserTable & " Set " & Db.UserLastIP & "='" & Cl.UserTrueIP & "'," & Db.UserLastLogin & "='" & Now & "'," & Db.UserLogins & "=" & rs(12) & "+1," & Db.UserPoint & "=" & rs(18) & "+"&rs(29)&","&Db.UserTPassWord&"='"&TruePassWord&"' Where "&Db.UserID&"=" & rs(0) & "")
	else
		Cl.Execute_U("Update " & Db.UserTable & " Set " & Db.UserLastIP & "='" & Cl.UserTrueIP & "'," & Db.UserLastLogin & "='" & Now & "'," & Db.UserLogins & "=" & rs(12) & "+1, "&Db.UserTPassWord&"='"&TruePassWord&"' Where "&Db.UserID&"=" & rs(0) & "")
	end if
	
	if Cl.UserID=0 then
		Set Count = New Cls_Count
		Count.DelOnline 0, Cl.UserID, Session(Cl.CacheName & "UserID")(0)
		Set Count = Nothing
	end if
	
	'Response.Cookies(Cl.Web_Cookies).path			= InstallDir
	Response.Cookies(Cl.Web_Cookies)("UserID")		= rs(0)
	Response.Cookies(Cl.Web_Cookies)("UserName")	= UserName
	Response.Cookies(Cl.Web_Cookies)("Password")	= PassWord
	Response.Cookies(Cl.Web_Cookies)("TruePassWord")= TruePassWord
	Response.Cookies(Cl.Web_Cookies)("UserLevel")	= rs(17)
	
	Select Case CookieDate
	Case 1 : Response.Cookies(Cl.Web_Cookies).Expires=Date+1
	Case 2 : Response.Cookies(Cl.Web_Cookies).Expires=Date+31
	Case 3 : Response.Cookies(Cl.Web_Cookies).Expires=Date+365
	End Select
	sValidDays=rs(22)-DateDiff("D",rs(21),now())
	if sValidDays<0 then sValidDays=0
		
	sUserInfo=rs.GetString(,1, "@@@","","")
	Cl.User_Info=Split("ClCMS@@@"& Now & "@@@" & Now &"@@@" & Cl.ScriptName & "@@@" & sUserInfo & "@@@" & sValidDays & "@@@ClCMS","@@@")
	Cl.User_Info(27)=TruePassWord
	Session(Cl.CacheName & "UserID") = Cl.User_Info
	rs.Close:Set rs = Nothing
	
End Sub

Sub LogoutUser()
if Cl.UserID>0 then
	Set Count = New Cls_Count
	Count.DelOnline 1, Cl.UserID, 0
	Set Count = Nothing
end if
Cl.EmptyCookies
End Sub

Sub DelUser()
Dim DleName,DleoneName,str,j
DleoneName = Split(UserName, ",")
str=""
For j = 0 To UBound(DleoneName)
str=str+"UserName='"&Trim(DleoneName(j))&"' or "
Next
str=str+"r"
str=replace(str,"or r","")
	sql="delete from " & Db.UserTable & " Where " &str
	Cl.Execute_U sql
End sub

Sub ModifyUserInfo()
	Dim tempSQL
	tempSQL = "UPDATE "& Db.UserTable &" Set "
	If Question <> "" Then
		tempSQL = tempSQL & Db.UserQuestion&"='" & Question & "'"
	End If
	If Answer <> "" and Len(Answer) = 16 Then
		tempSQL = tempSQL & ","&Db.UserAnswer&"='" & Answer & "'"
	End If
	If Email <> "" Then
		tempSQL = tempSQL & ","&Db.UserEmail&"='" & Email & "'"
	End If
	If Sex <> "" and IsNumeric(Sex) Then
		If Sex <0 or Sex > 1 Then Sex = 0
		tempSQL = tempSQL & ","&Db.UserSex&"='" &Sex&"'"
	End If
	If UserReName <> "" Then
		tempSQL = tempSQL & ","&Db.UserReName&"='" & UserReName & "'"
	End If
	tempSQL = tempSQL & " WHERE "&Db.UserName&"='" & UserName & "'"
	Cl.Execute_U tempSQL
End Sub

Sub ModifyUserPsw()
Dim temp1SQL
temp1SQL = "UPDATE "& Db.UserTable &" Set "
temp1SQL = temp1SQL & Db.UserPassword&"='" & PassWord & "'"
temp1SQL = temp1SQL & " WHERE "&Db.UserName&"='" & UserName & "'"
Cl.Execute_U temp1SQL
end sub

Sub RegSiteID()

set rs_1=server.CreateObject("adodb.recordset")'检查是否有注册目标系统reg_site包含注册系统的id
    str_1="select reg_site,id from hl_user where username='"&replace(request("name"),"'","")&"'"
	rs_1.open str_1,conns,1,3
	if InStr(rs_1("reg_site"),RegSiteIds)>0 then 
	  response.End()
	   else
	   RegSiteIds=rs_1("reg_site")&","&RegSiteIds
	   rs_1("reg_site")=RegSiteIds
	   rs_1.update
	   rs_1.close
	   set rs_1=nothing
	end if
	
End sub

Sub Reg_Active()
	username=Trim(Request.QueryString("UserName"))
	password=Trim(Request.QueryString("PassWord"))
	CheckNum=Trim(Request.QueryString("CheckNum"))
	if UserName="" or Password="" or CheckNum="" then
		Call Cl.OutMsg("要激活的用户名、密码或者验证码不能为空！","Index.asp")
		exit sub
	end if
	PwdConfirm=md5(password,16)
	set rs=server.createobject("adodb.recordset")
	sql="select "&Db.UserID&"," & Db.UserEmail & "," & Db.UserLocK & "," & Db.UserLevel & "," & Db.UserCheckNum & " from " & Db.UserTable & " where " & Db.UserName & "='" & username & "' and " & Db.UserPassword & "='" & PwdConfirm &"'"
	OpenConn_U
	rs.open sql,Conn_U,1,3
	if rs.bof and rs.eof then
		rs.close:set rs=Nothing
		Call Cl.OutMsg("要激活的用户名、密码或者验证码错误！","Index.asp")
	else
		if rs(Db.UserLock)<>0 then
			Call Cl.OutMsg("要激活的用户名已经被管理员锁住，请连系管理员！","Index.asp")
		Elseif Cint(rs(Db.UserLevel))<=4 then
			Call Cl.OutMsg("您已经是本站认证用户，无需再进行激活，请赶紧登录吧！","Login.Asp")
		Elseif CheckNum<>rs(Db.UserCheckNum) then
			Call Cl.OutMsg("要激活的用户名、密码或者验证码错误！","Index.asp")
		else
			if Cl.Web_Setting(24)="Yes" then
				rs(Db.UserLevel)=6
				rs.update
				Call Cl.OutMsg("恭喜你通过了Email验证。请等待管理开通你的帐号。开通后，你就正式正为本站的一员了。","Index.asp")
			else
				Email=rs(Db.UserEmail)
				rs(Db.UserLevel)=4
				rs(Db.UserCheckNum)=""
				rs.update
				rs.close:set rs=Nothing
				Call Cl.OutMsg("恭喜你正式成为本站的一员，请赶紧登录吧！","Login.Asp")
			end if
		end if
		rs.close:set rs=Nothing
	end if
End Sub
Function Cl_SendEmail(Useremail,MailTitle,Mailbody)
	Dim ClEmail
	Set ClEmail = New Cls_SendMail
	ClEmail.SendObject = Cint(Cl.Web_Setting(17))	'设置选取组件
	ClEmail.ServerLoginName = Cl.Web_Setting(19)	'您的邮件服务器登录名
	ClEmail.ServerLoginPass = Cl.Web_Setting(20)	'登录密码
	ClEmail.SendSMTP = Cl.Web_Setting(18)			'SMTP地址
	ClEmail.SendFromEmail = Cl.Web_Info(8)		'发送来源地址
	ClEmail.SendFromName = Cl.Web_Info(0)		'发送人信息
	If ClEmail.ErrCode = 0 Then 
		ClEmail.SendMail Useremail,MailTitle,Mailbody	'执行发送邮件
	End If
	if ClEmail.ErrCode=0 Then
		Cl_SendEmail=True
	else
		Cl_SendEmail=False
	end if
	Set ClEmail = Nothing
End Function

Function sRIM(s)
	Dim w
	w=Trim(s)
	If w<>"" and Not IsNull(w) Then 
		w=Replace(w,"|","")
	End If
	sRIM=w
End Function
%>
<%
'==================================================
'恒浪网站整合管理系统V4.05 请保留此版权信息~
'Powered by HoWave.net
'
'邮箱: websky888@126.com		
'ＱＱ: 615939753				
'网站: www.howave.net			www.jsp163.com
'论坛: bbs.howave.net			bbs.jsp163.com
'
'Copyright (C) 2006 HoWave.Net All Rights Reserved.
'==================================================
%>