<!--#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


'---------通行证字段赋值
UpiMd5Info = UCase(Trim(Request("Md5Info")))
Action = Trim(Request("action"))
username = replace(Trim(Request("name")),"'","")
password = replace(Trim(Request("pass")),"'","")
If Len(password) = 32 Then password = Mid(password,9,16)
'--------------------------------------
CookieDate = Trim(Request("save"))
If CookieDate=0 or CookieDate="" Then CookieDate=1
'--------------------------CL REG Begin-----------------------
If Action="LogoutUser" then Call LogoutUser()
If Not (Action = "" or UserName = "" or UpiMd5Info = "") Then

	HLMd5Info = MD5(username&AdminSecurityKey,32)
	
	If UpiMd5Info = UCase(HLMd5Info) Then
	Select Case Action
		Case "AddUser"
			Call AddUser()
			
		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
	Sex=0
	Question="your password"
	Answer=password
	Email=username&"@jsp163.com"
	rsReg(Db.UserQuestion)	= Question
	rsReg(Db.UserAnswer)	= Answer
	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
	Response.Write "<script src='" & HL_Url & "b_interface.asp?action=AddUser&Md5Info=" &UpiMd5Info & "&name=" & username & "&pass=" & password  & "&save=" & CookieDate & "'></ script>" & vbCrLf
	
End Sub

Sub AddAdmin()
	dim Purview,adduser
	dim cMaxID,sPurview
	dim arrClassInput,arrClassCheck,arrClassMaster
	cMaxID=Cl.Execute("select Max(ChannelID) from Cl_Channel")(0)
	if Not IsNumeric(cMaxID) then cMaxID=5
	
	adduser=username
	Purview=""
	if Purview="" or Not IsNumeric(Purview) then Purview=2
	for i=1 to cMaxID
		sPurview=Trim(Request("Purview_"&i&""))
		if sPurview="" or Not IsNumeric(sPurview) then sPurview=4
		Purview=Purview & "," & Clng(sPurview)
	next
	
		'提升前台用户权限
	Cl.Execute_U("Update "&Db.UserTable&" Set "&Db.UserLevel&"=1 Where "&Db.UserName&"='"&adduser&"'")

	sql="Select * from Cl_Admin where username='"&username&"'"
	Set rs=Server.CreateObject("Adodb.RecordSet")
	OpenConn : rs.Open sql,Conn,1,3
	if not (rs.bof and rs.EOF) then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>数据库中已经存在此管理员！</li>"
		rs.close:set rs=Nothing
		exit sub
	end if
	response.Write username
   	rs.addnew
 	rs("username")=username
   	rs("password")=password
    rs("Purview")=Purview
    rs("Purview_Other")="modifypwd"
 	rs("AddUser")=adduser
	rs.update
	rs.Close:set rs=Nothing
	'Cl.SaveAdminLog
	

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)("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)
	CookieDate=1
	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
	Response.Write "<iframe id='LoginUser' width='100%' height='0' frameborder='0' src='" & HL_Url & "b_interface.asp?action=LoginUser&Md5Info=" &UpiMd5Info & "&name=" & username & "&pass=" & password  & "&save=" & CookieDate & "'></iframe>" & vbCrLf
	
End Sub


Sub LoginAdmin()
if Cl.ChkUserLogin()=False then
	response.Redirect "" & Cl.WebDir & "User/Login.Asp"
end if
if Clng(Cl.User_Info(21))<>1 then
	Response.Redirect Cl.WebDir & "Showerr.asp?action=OtherErr&ErrCodes=<li>您不是系统管理员！"
end if
dim Sql,Rs
FoundErr=False
if FoundErr<>True then
	Sql="select ID,UserName,PassWord,Purview,Purview_Other,arrClassMaster,arrClassCheck,arrClassInput From Cl_Admin where username='" & UserName & "' and adduser='"&Cl.User_Info(5) &"'"
	Set Rs=Cl.Execute(Sql)
	
	if Rs.bof and Rs.eof then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>用户名或密码错误或者您不是后台管理员！</li>"
		Rs.close:set Rs=Nothing
	else
		if password<>Rs(2) then
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>用户名或密码错误，请返回重新输入！</li>"
			Rs.close:set Rs=Nothing
		else
			Cl.Execute("update Cl_Admin set LastLoginIP='"&Cl.UserTrueIP&"',LastLoginTime="&SqlNowString&",LoginTimes=LoginTimes+1 Where UserName='"&UserName&"'")
			Session.Timeout=20
			Session("AdminName")=rs(1)
			Session("AdminPass")=rs(2)
					
			Rs.close:set Rs=Nothing
			
			Cl.Execute_L("insert into [Cl_AdminLog] (UserID,UserName,UserLevel,UserIP,ScriptName,LogContent,LogTime) values ('"&Cl.User_Info(4)&"','"&Cl.User_Info(5)&"','"&Cl.User_Info(21)&"','"&Cl.UserTrueIP&"','"&Cl.ScriptName&"','登录后台成功！','"&Now&"')")
			
		end if
	end if
end if
End Sub

Sub LogoutUser()
	Session("AdminName")=Empty
	Session("PassWord")=Empty
	Session(Cl.CacheName & "AdminInfo")=Empty
	Cl.SaveAdminLog
	response.redirect "../Index.asp"
End Sub

Sub DelUser()
	sql="delete from " & Db.UserTable & " Where UserName='" & UserName&"' and UserPassWord='"&PassWord&"'"
	Cl.Execute_U sql
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 ShowErr(ErrMsg)
	dim strErr
	strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
	strErr=strErr & "<link href='../Skins/Admin_Style.Css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
	strErr=strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
	strErr=strErr & "  <tr align='center'><td height='22' class='title'><strong>错误信息</strong></td></tr>" & vbcrlf
	strErr=strErr & "  <tr><td height='100' class='tdbg' valign='top'><b>产生错误的可能原因：</b><br>" & ErrMsg &"</td></tr>" & vbcrlf
	strErr=strErr & "  <tr align='center'><td class='tdbg'><a href='Admin_Index.asp?Action=admin_login'>&lt;&lt; 返回登录页面</a></td></tr>" & vbcrlf
	strErr=strErr & "</table>" & vbcrlf
	strErr=strErr & "</body></html>" & vbcrlf
	response.write strErr
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.
'==================================================
%>