<!--#include file="conn/hl_conn.asp"-->
<!--#include file="inc/hl_function.asp"-->
<!--#include file="inc/upiconfig.asp"-->
<!--#include file="inc/md5.asp"-->

<META http-equiv=Content-Type content="text/html; charset=gb2312"><LINK 
href="img/css.css" type=text/css rel=stylesheet>
<STYLE type=text/css>
.style1 {
	COLOR: #ff0000
}
.style6 {
	FONT-SIZE: 14px; FONT-FAMILY: "宋体"
}
.style7 {
	FONT-SIZE: 14px
}
.style128 {
	FONT-SIZE: 24px; COLOR: #ff3300; FONT-STYLE: italic; FONT-FAMILY: Geneva, Arial, Helvetica, sans-serif
}
.style13 {
	FONT-SIZE: 20px; COLOR: #0066ff; FONT-FAMILY: "黑体"
}
.style3 {
	FONT-WEIGHT: bold; FONT-SIZE: 18px; COLOR: #ff3300; FONT-FAMILY: "宋体"
}
body {
	background-color: #ffffff;
	margin-left: 0px;
	margin-top: 0px;
}
.td {font-size: 12px}
.STYLE14 {color: #000000}
.leftmenu11 {	PADDING-LEFT: 6px; FONT-WEIGHT: bold; FONT-SIZE: 14px; BACKGROUND-IMAGE: url(img/leftmanu_bg1.gif); CURSOR: hand; PADDING-TOP: 4px; HEIGHT: 29px
}
.leftmenu21 {	PADDING-LEFT: 10px; FONT-SIZE: 14px; BACKGROUND-IMAGE: url(img/leftmanu_bg2.gif); HEIGHT: 26px
}
.leftmenu4 {	BORDER-RIGHT: #4296ce 0px solid; BORDER-TOP: #4296ce 1px solid; PADDING-LEFT: 7px; FONT-SIZE: 14px; BACKGROUND-IMAGE: url(img/leftmanu_bg3.gif); PADDING-BOTTOM: 1px; BORDER-LEFT: #4296ce 0px solid; PADDING-TOP: 1px; BORDER-BOTTOM: #4296ce 0px solid
}
.leftmenu111 {PADDING-LEFT: 6px; FONT-WEIGHT: bold; FONT-SIZE: 14px; BACKGROUND-IMAGE: url(http://img.china.alibaba.com/img/chs/myalibaba/leftmanu_bg1.gif); CURSOR: hand; PADDING-TOP: 4px; HEIGHT: 29px
}
.leftmenu211 {PADDING-LEFT: 10px; FONT-SIZE: 14px; BACKGROUND-IMAGE: url(http://img.china.alibaba.com/img/chs/myalibaba/leftmanu_bg2.gif); HEIGHT: 26px
}
.leftmenu41 {BORDER-RIGHT: #4296ce 0px solid; BORDER-TOP: #4296ce 1px solid; PADDING-LEFT: 7px; FONT-SIZE: 14px; BACKGROUND-IMAGE: url(http://img.china.alibaba.com/img/chs/myalibaba/leftmanu_bg3.gif); PADDING-BOTTOM: 1px; BORDER-LEFT: #4296ce 0px solid; PADDING-TOP: 1px; BORDER-BOTTOM: #4296ce 0px solid
}
</STYLE>


<%
Dim UserPassword,Answer
'ComeUrl=trim(request("ComeUrl"))
'if  then
	'ComeUrl=Request.ServerVariables("HTTP_REFERER")
'end if
if ComeUrl="" then
	ComeUrl="User_ControlPad.asp"
end if
Const RegEmailOnce = True   '每个Email只可以注册一次

set rs=server.CreateObject("adodb.recordset")
sql="select * from [hl_control] where control_flag=1"
rs.open sql,conn,1,1
num=rs.recordcount
dim strFields,strFields2
do while not rs.eof
strFields =strFields&rs("control_name")&","&rs("control_intro")&"|"
rs.movenext
loop
rs.close

arrFields = Split(strFields, "|")
for i=0 to ubound(arrFields)
arrTemp = Split(arrFields(i), ",")
Select Case arrTemp(0)
case"username"
UserName=trim(request(arrTemp(0)))
if UserName=""  Or strLength(UserName)> 14 Or strLength(UserName)< 4 Then 
FoundErr = True
ErrMsg = ErrMsg &"<li>请输入用户名(不能大于14小于4)</li>"
call WriteErrMsg(ErrMsg)
response.End()
Else
            If CheckBadChar(username) = False Then
                ErrMsg = ErrMsg & "<li>用户名中含有非法字符</li>"
                FoundErr = True
				call WriteErrMsg(ErrMsg)
				response.End()
            End If
End If
case"userpassword"
UserPassword=trim(request(arrTemp(0)))
'UserPasswords= md5(UserPassword,16)

If UserPassword = "" Or strLength(UserPassword) > 16 Or strLength(UserPassword) < 6 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请输入密码(不能大于16小于6)</li>"
			call WriteErrMsg(ErrMsg)
			response.End()
        Else
            If CheckBadChar(UserPassword) = False Then
                ErrMsg = ErrMsg + "<li>密码中含有非法字符</li>"
                FoundErr = True
				call WriteErrMsg(ErrMsg)
				response.End()
            End If
        End If
case"userquestion"
Question=trim(request(arrTemp(0)))
if Question="" then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>问题不能为空</li>"
			call WriteErrMsg(ErrMsg)
            response.End()
end if
case"useranswer"
Answer=trim(request(arrTemp(0)))
if Answer="" then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>答案不能为空</li>"
			call WriteErrMsg(ErrMsg)
            response.End()
end if
case"useremail"
Email=trim(request(arrTemp(0)))
If Email = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>Email不能为空</li>"
			call WriteErrMsg(ErrMsg)
            response.End()
        Else
            If IsValidEmail(Email) = False Then
                ErrMsg = ErrMsg & "<li>您的Email有错误</li>"
                FoundErr = True
				call WriteErrMsg(ErrMsg)
                response.End()
            End If
        End If
case else
if trim(request(arrTemp(0)))="" then
FoundErr = True
ErrMsg = ErrMsg & "<li>"&arrTemp(1)&"不能为空</li>"
call WriteErrMsg(ErrMsg)
response.End()
end if
end select
next

If FoundErr = False Then
sqlReg = "select * from hl_user where username='"&UserName&"'"
            Set rsReg = Server.CreateObject("adodb.recordset")
            rsReg.Open sqlReg, Conn, 1, 3
            If Not (rsReg.BOF And rsReg.EOF) Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>您注册的用户已经存在！请换一个用户名再试试！</li>"
				call WriteErrMsg(ErrMsg)
                response.End()
			else
			    If RegEmailOnce = True Then
                    Dim rsEmailOnce
                    Set rsEmailOnce = Conn.Execute("select id,useremail from hl_user where useremail='"&Email& "'")
                    If Not (rsEmailOnce.BOF And rsEmailOnce.EOF) Then
                        FoundErr = True
                        ErrMsg = ErrMsg & "<li>您注册的Email已经存在！请更换Email再试试！</li>"
						call WriteErrMsg(ErrMsg)
                        response.End()
                    End If
                    Set rsEmailOnce = Nothing
                End If
				rsReg.addnew
				rsReg("logins")=0
				rsReg("adddate")=date()
				rsReg("loginip")=Request.ServerVariables("REMOTE_ADDR")'IP地址为去掉HTTP头
				rsReg("lastlogin")=now()
				For i = 0 To UBound(arrFields)
				arrTemp = Split(arrFields(i), ",")
				if arrTemp(0)<>"repassword" and arrTemp(0)<>"userpassword" and arrTemp(0)<>"useranswer" then'密码另外写入
				rsReg(arrTemp(0)) = Trim(Request(arrTemp(0)))
				end if
				next
				rsReg("userpassword")=MD5(UserPassword,32)
				rsReg("useranswer")=MD5(Answer,32)
				rsReg("reg_site")=0
				rsReg.Update
				session("hl_user")=rsReg("username")
                rsReg.Close
                Set rsReg = Nothing
			end if
				Sex=replace(Trim(request("sex")),"'","")
			   Md5Info=MD5(UserName & SecurityKey, 32)
			      pass=MD5(UserPassword, 32)
			    answer=MD5(Answer, 32)
			 session("hl_user")="hl_user_center"
			 'Response.Cookies("hl_user")("username")=UserName
		     'Response.Cookies("hl_user")("password")=pass
            Response.Write "<html>" & vbCrLf
            Response.Write "<head>" & vbCrLf
            Response.Write "<meta http-equiv=""refresh"" content=""" & RefreshTime & ";URL=Admin_user.asp"" />"&vbCrLf
            Response.Write "<title>注册结果</title>" & vbCrLf
            Response.Write "</head>" & vbCrLf
            Response.Write "<body>" & vbCrLf
			Response.Write "<br><br><br><br><br>"
            Response.Write "<div align='center'><span style='font-size:9pt'>正在进行新会员添加操作，请稍等...</span></div>" & vbCrLf
			Response.Write "<div align='center'><img src='img/interface.gif' width='500' height='20' /></div>"
            If IsNull(SecurityKey) = False And SecurityKey <> "" And IsNull(arrUpiUrls) = False And arrUpiUrls <> "" Then
            HLUpi = Split(arrUpiUrls, "|")
			RegSiteId=split(RegSiteIds,",")   
            For iNum = 0 To UBound(HLUpi)
			Response.Write "<iframe id='AddUser' width='100%' height='0' frameborder='0' src=""" & HLUpi(iNum) & "?action=AddUser&Md5Info=" & Md5Info & "&name=" & UserName & "&pass=" & pass & "&question=" & Question & "&answer=" & answer & "&Email=" & Email & "&sex=" & Sex & "&RegSiteId="& RegSiteId(iNum) &"&lock=0&save=0""></iframe>"& vbCrLf
            Next
            End If
            Response.Write "</body>" & vbCrLf
            Response.Write "</html>" & vbCrLf
           				
end if
Function TimeDelaySeconds(DelaySeconds)
    Dim SecCount, Sec2
    Dim Sec1
    SecCount = 0
    Sec2 = 0
    While SecCount < DelaySeconds + 1
        Sec1 = Second(Time())
        If Sec1 <> Sec2 Then
            Sec2 = Second(Time())
            SecCount = SecCount + 1
        End If
    Wend
End Function

Function CheckBadChar(strChar)
    Dim strBadChar, arrBadChar, i
    strBadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & ""
    arrBadChar = Split(strBadChar, ",")
    If strChar = "" Then
        CheckBadChar = False
    Else
        For i = 0 To UBound(arrBadChar)
            If InStr(strChar, arrBadChar(i)) > 0 Then
                CheckBadChar = False
                Exit Function
            End If
        Next
    End If
    CheckBadChar = True
End Function

%>