<!--#include file="conn/hl_conn.asp"-->
<!--#include file="inc/HL_RegSet.asp"-->
<!--#include file="inc/hl_function.asp"-->
<!--#include file="inc/md5.asp"-->
<link href="img/css.css" rel="stylesheet" type="text/css" />
<SCRIPT LANGUAGE="JavaScript">
<!-- Hide

function killErrors() {
return true;
}

window.onerror = killErrors;

// -->
</SCRIPT>
<!--容错代码结束-->
<%
Const RegEmailOnce = True   'True每个Email只可以注册一次,False为可重复注册
Const RegNameNumber= True   'True为允许全数字注册,False为不允许全数字注册
IF RegClose=1 Then Response.End()
Dim UserPassword,Answer,CheckCode
        ComeUrl=trim(request("ComeUrl"))
     If ComeUrl="" then
	    ComeUrl=HL_Url
     End if
     If RegCheckCode=1 Then
        CheckCode=ReplaceBadChar(Trim(Request("CheckCode")))
        If CheckCode="" or CheckCode<>Session("CheckCode") Then
        FoundErr = True
		ErrMsg = ErrMsg &"<li>你输入的验证码不正确</li>"
        End if
     End IF
      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>"
                    Else
                        If CheckBadChar(UserName) = False Then
                           ErrMsg = ErrMsg & "<li>用户名中含有非法字符</li>"
                            FoundErr = True
			End If
			IF IsNumeric(username) and RegNameNumber= False Then
			   ErrMsg = ErrMsg & "<li>用户名不能全是数字</li>"
                        FoundErr = True
				        End If
						
                    End If
               case"userpassword"
                    UserPassword=trim(request(arrTemp(0)))
                    If UserPassword = "" Or strLength(UserPassword) > 16 Or strLength(UserPassword) < 6 Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>请输入密码(不能大于16小于6)</li>"
			        Else
                       If CheckBadChar(UserPassword) = False Then
                       ErrMsg = ErrMsg + "<li>密码中含有非法字符</li>"
                       FoundErr = True
				       End If
                    End If
             case"userquestion"
                    Question=trim(request(arrTemp(0)))
                   If Question="" then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>问题不能为空</li>"
			       End if
            case"useranswer"
                    Answer=trim(request(arrTemp(0)))
                    If Answer="" then
                      FoundErr = True
                      ErrMsg = ErrMsg & "<li>答案不能为空</li>"
			        End if
            case"useremail"
                    Email=trim(request(arrTemp(0)))
                    If Email = "" or CheckBadChar(Email) = False Then
                       FoundErr = True
                       ErrMsg = ErrMsg & "<li>Email不能为空或含有非法字符</li>"
		    Else
                        If IsValidEmail(Email) = False Then
                          ErrMsg = ErrMsg & "<li>您的Email有错误</li>"
                          FoundErr = True
			End If
                    End If
            case else
                    If trim(request(arrTemp(0)))="" then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>"&arrTemp(1)&"不能为空</li>"
                    End if
           end select
next
If FoundErr = True Then 
call WriteErrMsg(ErrMsg)
Response.End()
Else
            IF RegEmailOnce = True Then   '判断是否有重复注册Email
               sqlReg = "select * from hl_user where useremail='"&Email&"'"
               Set rsReg = Server.CreateObject("adodb.recordset")
               rsReg.Open sqlReg, Conn, 1, 1 
               If not rsReg.eof then
                  FoundErr = True
                  ErrMsg = ErrMsg & "<li>你的Email已经被注册</li>"
		  call WriteErrMsg(ErrMsg)
                  Response.End()
               End If
            End If
                         
            sqlReg = "select * from hl_user where username='"&UserName&"'"
            Set rsReg = Server.CreateObject("adodb.recordset")
            rsReg.Open sqlReg, Conn, 1, 3
            If (rsReg.BOF And rsReg.EOF) Then
                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
				rsReg.Close
            Set rsReg = Nothing
	  Else 
		FoundErr = True
                ErrMsg = ErrMsg & "<li>你的用户名已经被注册</li>"
		call WriteErrMsg(ErrMsg)
                Response.End()
	 End if
	   Dim SecurityKey,HL_Url
           Set rsweb=server.CreateObject("ADODB.Recordset")
               sqlweb="select top 1 hl_webkey,hl_weburl from hl_web"
               rsweb.open sqlweb,conn,1,1
               SecurityKey = rsweb(0)                
               HL_Url=rsweb(1)
		rsweb.close
		set rsweb=nothing
				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")=Md5(UserPassword,16)
			   If Domainname<>"" Then Response.Cookies("hl_user").Domain=Domainname
			   Set rs=server.CreateObject("ADODB.Recordset")
               sqlreg="select hl_interface from hl_config where hl_open=1 and hl_RegClose=0"
               rs.open sqlreg,conn,1,1
               do while not rs.eof
               RegUpiUrls =RegUpiUrls&rs(0)&"|"                       
               rs.movenext
               loop
			   rs.close
			   set rs=nothing
			   RegUpiUrls=RegUpiUrls&"|"
               RegUpiUrls=replace(RegUpiUrls,"||","")
               HLUpi = Split(RegUpiUrls, "|")
			   RegSiteId=split(RegSiteIds,",")
			   IF RegCome=1 Then 
			      ComeUrl=Hl_Url&Manage_Url&"User_Index.asp"
				  ElseIf RegCome=2 Then
				    ComeUrl=Hl_Url
					ElseIf RegCome=3 Then
					 ComeUrl=ComeUrl
					 ElseIf RegCome=4 Then
					  ComeUrl=RegComeUrl
			    End IF
			If IsNull(SecurityKey) = False And SecurityKey <> "" And IsNull(RegUpiUrls) = False And RegUpiUrls<> "" Then
               For iNum = 0 To UBound(HLUpi)
			   Response.Write "<script src=""" & HLUpi(iNum) & "?action=AddUser&Md5Info=" & Md5Info & "&name=" & UserName & "&pass=" & pass & "&question=" & Question & "&answer=" & answer & "&Email=" & Email & "&sex=" & Sex & "&OriginPass="&UserPassword &"&lock=0&save=0&usertype="&request("usertype")&"""></script>"& vbCrLf
			Next
			response.Write("<script language=JavaScript>top.location='"&ComeUrl&"';</script>")
          	Else
			Response.Write "<span style='font-size:9pt'>现在关闭注册请<a href='User_Index.asp>返回</a></span>"
           	End If			
End if

Function CheckBadChar(strChar)'注册设置禁止注册字符用“,”分隔
    Dim strBadChar,arrBadChar,i
    strBadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:,admin,guest,法轮,李志洪,江泽民,胡锦涛,管理员,操你,fuck," & Chr(34) & ""
    arrBadChar = Split(strBadChar, ",")
    If strChar = "" Then
        CheckBadChar = False
    Else
        For i = 0 To UBound(arrBadChar)
            If InStr(lcase(strChar), arrBadChar(i)) > 0 Then
                CheckBadChar = False
                Exit Function
            End If
        Next
    End If
    CheckBadChar = True
End Function

%>