📄 user_reg.asp
字号:
<%
Option Explicit
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
%>
<!--#Include File="../Conn.asp"-->
<!--#Include File="../Inc/Const.asp"-->
<!--#Include File="../Inc/ClassSendMail.asp"-->
<!--#Include File="../Inc/MD5.asp"-->
<%
On Error Resume Next
'检查页面来源
If CheckComeURL = False Then
EL_Common.ShowErrorMsg(EL_Common.Lang("BaseConfig.ComeURLError", "禁止从本站外部提交数据"))
Call ApplicationTerminate()
End If
Select Case Action
Case "SaveNewUser": Call SaveNewUser()
Case Else: Call ShowInput()
End Select
Call EL_Common.ShowScriptError()
Call ApplicationTerminate()
Sub ShowInput()
Dim HTML, DefaultQuestion
HTML = EL_Common.Template(-2, 12, 0)
HTML = EL_Common.ReplaceCommonLabels(HTML)
HTML = EL_Common.RegExpStaticLabel(HTML, "{$PageTitle}", EL_Common.Join2String(SiteTitle, EL_Common.Lang("User.UserReg", "会员注册"), EL_Common.TitleDivide))
HTML = EL_Common.RegExpStaticLabel(HTML, "{$MetaKeywords}", "<meta name=""keywords"" content="""& MetaKeywords &""" />")
HTML = EL_Common.RegExpStaticLabel(HTML, "{$MetaDescription}", "<meta name=""description"" content="""& MetaDescription &""" />")
HTML = EL_Common.RegExpStaticLabel(HTML, "{$ShowPath}", EL_Common.Lang("BaseConfig.SiteIndex", "") & EL_Common.Lang("BaseConfig.Path", " >> ") &"会员注册")
HTML = EL_Common.RegExpStaticLabel(HTML, "{$DefaultSkin}", EL_Common.Skin(0, 0, 0))
DefaultQuestion = EL_Common.GetFieldValue("DefaultQuestion", "EL_Config", "1=1")
DefaultQuestion = Split(DefaultQuestion, "|")
Dim StrQuestion, i
StrQuestion = "<select id='Question' name='Question'>"
For i = 0 To Ubound(DefaultQuestion)
StrQuestion = StrQuestion &"<option value='"& EL_Common.ServerHTMLEncode(DefaultQuestion(i)) &"'>"& EL_Common.ServerHTMLEncode(DefaultQuestion(i)) &"</option>"
Next
StrQuestion = StrQuestion &"</select>"
HTML = EL_Common.RegExpStaticLabel(HTML, "{$ShowDefaultQuestion}", StrQuestion)
Response.Write HTML
End Sub
Sub SaveNewUser()
Dim ConfigCmd, rsConfig, i, UserID
Dim CheckUserType, EmailCheckContent, UserNameLimit, UserNameMax, BadCharInUserName, DisabledUserName
Dim UserRegNeedFields, BrotherRegNeedFields, EnableMsgToNewUser, MsgTitle, MsgContent
Dim UserName, TrueName, Password, PasswordConfirm, Sex, Birthday, IDCard, Question, Answer, Email
Dim CompanyName, Mobile, Phone, Fax, Marriage, Job, JobTitle, Income, QQ, ICQ, MSN, Address, ZipCode, Sign, CheckCode
UserName = EL_Common.ELRequest("UserName", 1)
TrueName = EL_Common.ELRequest("TrueName", 1)
Password = EL_Common.ELRequest("Password", 1)
PasswordConfirm = EL_Common.ELRequest("PasswordConfirm", 1)
CheckCode = UCase(EL_Common.ELRequest("CheckCode", 1))
Sex = EL_Common.ELRequest("Sex", 2)
Birthday = EL_Common.ELRequest("Birthday_yy", 2) &"-"& EL_Common.ELRequest("Birthday_mm", 2) &"-"& EL_Common.ELRequest("Birthday_dd", 2)
IDCard = EL_Common.ELRequest("IDCard", 1)
Question = EL_Common.ELRequest("Question", 1)
Answer = EL_Common.ELRequest("Answer", 1)
Email = EL_Common.ELRequest("Email", 1)
CompanyName = EL_Common.ELRequest("CompanyName", 1)
Mobile = EL_Common.ELRequest("Mobile", 1)
Phone = EL_Common.ELRequest("Phone", 1)
Fax = EL_Common.ELRequest("Fax", 1)
Marriage = EL_Common.ELRequest("Marriage", 1)
Job = EL_Common.ELRequest("Job", 1)
JobTitle = EL_Common.ELRequest("JobTitle", 1)
Income = EL_Common.ELRequest("Income", 2)
QQ = EL_Common.ELRequest("QQ", 2)
ICQ = EL_Common.ELRequest("ICQ", 2)
MSN = EL_Common.ELRequest("MSN", 1)
Address = EL_Common.ELRequest("Address", 1)
ZipCode = EL_Common.ELRequest("ZipCode", 1)
Sign = EL_Common.ELRequest("Sign", 1)
If CheckCode <> Session("CheckCode") Or CheckCode ="" Then
EL_Common.ShowErrorMsg(EL_Common.Lang("BaseConfig.CheckCodeError", "验证码错误"))
Exit Sub
End If
Call EL_Common.InitCommand(ConfigCmd, "EL_SP_UserReg")
With ConfigCmd
.Parameters.Append .CreateParameter("RETURN", 2, 4)
Set rsConfig = .Execute()
End With
rsConfig.Close()
If ConfigCmd(0) = 0 Then
EL_Common.ShowErrorMsg(EL_Common.Lang("User.Error1", "对不起！本站暂停会员注册！"))
Exit Sub
End If
rsConfig.Open()
CheckUserType = rsConfig("CheckUserType")
EmailCheckContent = rsConfig("EmailCheckContent")
UserNameLimit = rsConfig("UserNameLimit")
UserNameMax = rsConfig("UserNameMax")
BadCharInUserName = rsConfig("BadCharInUserName")
DisabledUserName = rsConfig("DisabledUserName")
UserRegNeedFields = rsConfig("UserRegNeedFields")
EnableMsgToNewUser = rsConfig("EnableMsgToNewUser")
MsgTitle = rsConfig("MsgTitle")
MsgContent = rsConfig("MsgContent")
rsConfig.Close()
Set rsConfig = Nothing
Set ConfigCmd = Nothing
If EL_Common.StrLength(UserName) < UserNameLimit Then
EL_Common.ShowErrorMsg(EL_Common.RegExpStaticLabel(EL_Common.Lang("User.Error3", "会员名长度不能小于{$UserNameLimit}个字符"), "{$UserNameLimit}", UserNameLimit))
Exit Sub
End If
If EL_Common.StrLength(UserName) > UserNameMax Then
EL_Common.ShowErrorMsg(EL_Common.RegExpStaticLabel(EL_Common.Lang("User.Error4", "会员名长度不能大于{$UserNameMax}个字符"), "{$UserNameMax}", UserNameMax))
Exit Sub
End If
If BadCharInUserName <> "" Then
Dim arrBadCharInUserName
BadCharInUserName = EL_Common.Join2String(BadCharInUserName, "$", "|") '加入过滤系统特殊字符$
arrBadCharInUserName = Split(BadCharInUserName, "|")
For i = 0 To Ubound(arrBadCharInUserName)
If Instr(UserName, arrBadCharInUserName(i))>0 Then
EL_Common.ShowErrorMsg(EL_Common.RegExpStaticLabel(EL_Common.Lang("User.Error5", "会员名包含了非法字符"" {$BadChar} """), "{$BadChar}", arrBadCharInUserName(i)))
Exit Sub
End If
Next
End If
If DisabledUserName <> "" Then
Dim arrDisabledUserName
arrDisabledUserName = Split(DisabledUserName, "|")
For i = 0 To Ubound(arrDisabledUserName)
If UserName = arrDisabledUserName(i) Then
EL_Common.ShowErrorMsg(EL_Common.Lang("User.Error6", "此会员名被禁止注册"))
Exit Sub
End If
Next
End If
Dim arrUserRegNeedFields
arrUserRegNeedFields = Split(UserRegNeedFields, ",")
For i = 0 To Ubound(arrUserRegNeedFields)
If Eval(arrUserRegNeedFields(i)) = "" Then
EL_Common.ShowErrorMsg(EL_Common.RegExpStaticLabel(EL_Common.Lang("User.NeedFieldError", "{$FieldName}不能为空"), "{$FieldName}", EL_Common.Lang("User."& arrUserRegNeedFields(i), arrUserRegNeedFields(i))))
Exit Sub
End If
Next
If Password <> PasswordConfirm Then
EL_Common.ShowErrorMsg(EL_Common.Lang("User.Error7", "您两次输入的密码不一致"))
Exit Sub
End If
If EL_Common.CheckEmail(Email) = False Then
EL_Common.ShowErrorMsg(EL_Common.Lang("BaseConfig.EmailError", "电子邮件格式错误"))
Exit Sub
End If
Dim NewUserCmd, RndCheckCode, RndPassword
If CheckUserType = 1 Then
RndCheckCode = GetRndNumber(128)
Else
RndCheckCode = ""
End If
RndPassword = GetRndNumber(32)
Password = MD5(Password, 32)
Answer = MD5(Answer, 32)
Call EL_Common.InitCommand(NewUserCmd, "EL_SP_NewUser")
With NewUserCmd
.Parameters.Append .CreateParameter("RETURN", 2, 4)
.Parameters.Append .CreateParameter("@UserID", 3, 2, 4)
.Parameters.Append .CreateParameter("@UserName", 200, 1, 50, UserName)
.Parameters.Append .CreateParameter("@TrueName", 200, 1, 50, TrueName)
.Parameters.Append .CreateParameter("@Password", 200, 1, 32, Password)
.Parameters.Append .CreateParameter("@Sex", 2, 1, 4, Sex)
.Parameters.Append .CreateParameter("@Birthday", 135, 1, 8, Birthday)
.Parameters.Append .CreateParameter("@IDCard", 200, 1, 20, IDCard)
.Parameters.Append .CreateParameter("@Question", 200, 1, 255, Question)
.Parameters.Append .CreateParameter("@Answer", 200, 1, 32, Answer)
.Parameters.Append .CreateParameter("@Mobile", 200, 1, 30, Mobile)
.Parameters.Append .CreateParameter("@Phone", 200, 1, 30, Phone)
.Parameters.Append .CreateParameter("@Fax", 200, 1, 30, Fax)
.Parameters.Append .CreateParameter("@QQ", 200, 1, 30, QQ)
.Parameters.Append .CreateParameter("@ICQ", 200, 1, 30, ICQ)
.Parameters.Append .CreateParameter("@MSN", 200, 1, 100, MSN)
.Parameters.Append .CreateParameter("@Email", 200, 1, 100, Email)
.Parameters.Append .CreateParameter("@Address", 200, 1, 255, Address)
.Parameters.Append .CreateParameter("@ZipCode", 200, 1, 10, ZipCode)
.Parameters.Append .CreateParameter("@Marriage", 200, 1, 10, Marriage)
.Parameters.Append .CreateParameter("@Job", 200, 1, 30, Job)
.Parameters.Append .CreateParameter("@JobTitle", 200, 1, 30, JobTitle)
.Parameters.Append .CreateParameter("@Income", 3, 1, 4, Income)
.Parameters.Append .CreateParameter("@CompanyName", 200, 1, 100, CompanyName)
.Parameters.Append .CreateParameter("@Sign", 200, 1, 500, Sign)
.Parameters.Append .CreateParameter("@RndCheckCode", 200, 1, 128, RndCheckCode)
.Parameters.Append .CreateParameter("@RndPassword", 200, 1, 32, RndPassword)
.Parameters.Append .CreateParameter("@RemoteIP", 200, 1, 15, RemoteIP)
.Execute()
End With
Select Case NewUserCmd(0)
Case 40:
Set NewUserCmd = Nothing
EL_Common.ShowErrorMsg(EL_Common.Lang("User.Error8", "此用户名已经存在"))
Exit Sub
Case 41:
Set NewUserCmd = Nothing
EL_Common.ShowErrorMsg(EL_Common.Lang("User.Error9", "您使用的电子邮件已经被注册"))
Exit Sub
End Select
UserID = NewUserCmd(1)
Set NewUserCmd = Nothing
'写Cookie
If CheckUserType = 0 Then
Response.Cookies("User_"& EL_Sn)("UserID") = UserID
Response.Cookies("User_"& EL_Sn)("UserName") = UserName
Response.Cookies("User_"& EL_Sn)("UserPassword") = Password
Response.Cookies("User_"& EL_Sn)("UserRndPassword") = RndPassword
Response.Cookies("EL_User_Counter")("UserID") = UserID
End If
'站内短信
If EnableMsgToNewUser = True Then
Dim MsgCmd
MsgContent = EL_Common.RegExpStaticLabel(MsgContent, "{$UserName}", UserName)
MsgContent = EL_Common.RegExpStaticLabel(MsgContent, "{$SiteName}", SiteName)
Call EL_Common.InitCommand(MsgCmd, "EL_SP_SendMessage")
With MsgCmd
.Parameters.Append .CreateParameter("@SendType,", 3, 1, 4, 2)
.Parameters.Append .CreateParameter("@GroupID,", 200, 1, 500, "")
.Parameters.Append .CreateParameter("@Title,", 200, 1, 255, MsgTitle)
.Parameters.Append .CreateParameter("@Sender,", 200, 1, 255, SiteName)
.Parameters.Append .CreateParameter("@Receiver,", 200, 1, 4000, UserName)
.Parameters.Append .CreateParameter("@Content,", 203, 1, EL_Common.LenParameter(MsgContent), MsgContent)
.Execute()
End With
Set MsgCmd = Nothing
End If
'发送邮件验证
If CheckUserType = 1 Then
Dim CheckURL
CheckURL = SiteURL
CheckURL = Replace(CheckURL, "\", "/")
While(Right(CheckURL, 1) = "/")
CheckURL = Left(CheckURL, Len(CheckURL)-1)
Wend
CheckURL = CheckURL & InstallDir &"User/CheckNewUser.asp?UserID="& UserID &"&UserName="& UserName &"&c="& RndCheckCode
Call SendMail(Email, CheckURL, EmailCheckContent)
End If
'返回注册成功
Session("TempUserID") = UserID
Response.Redirect "User_RegSuccess.asp"
End Sub
Sub SendMail(ByVal ToEmail, ByVal CheckURL, ByVal EmailCheckContent)
Dim EL_SendMail, EmailBody
EmailBody = EmailCheckContent
EmailBody = EL_Common.RegExpStaticLabel(EmailBody, "{$UserName}", ToUserName)
EmailBody = EL_Common.RegExpStaticLabel(EmailBody, "{$SiteName}", SiteName)
EmailBody = EL_Common.RegExpStaticLabel(EmailBody, "{$UserRegCheckUrl}", CheckURL)
EmailBody = EL_Common.RegExpStaticLabel(EmailBody, "{$WebmasterName}", WebmasterName)
EmailBody = EL_Common.RegExpStaticLabel(EmailBody, "{$RegDate}", Date())
EmailBody = "<HTML><BODY bgcolor=""#FFFFFF"">"& EL_Common.HTMLEncode(EmailBody) &"</BODY></HTML>"
Set EL_SendMail = New ClassSendMail
EL_SendMail.SubjectName = EL_Common.RegExpStaticLabel(EL_Common.Lang("User.MailSubject", "{$SiteName}会员注册验证"), "{$SiteName}", SiteName)
EL_SendMail.FromUserName = SiteName
EL_SendMail.FromEmail = WebmasterEmail
EL_SendMail.ToEmail = ToEmail
EL_SendMail.EmailBody = EmailBody
EL_SendMail.SendMail()
Set EL_SendMail = Nothing
End Sub
Function GetRndNumber(NLen)
Dim Ran, i, strNumber
strNumber = ""
For i = 1 To NLen
Randomize
Ran = CInt(Rnd * 2)
Randomize
If Ran = 0 Then
Ran = CInt(Rnd * 25) + 97
strNumber = strNumber & UCase(Chr(Ran))
ElseIf Ran = 1 Then
Ran = CInt(Rnd * 9)
strNumber = strNumber & Ran
ElseIf Ran = 2 Then
Ran = CInt(Rnd * 25) + 97
strNumber = strNumber & Chr(Ran)
End If
Next
GetRndNumber = strNumber
End Function
Function CheckComeURL()
CheckComeURL = False
If ComeURL = "" Then Exit Function
Dim Current_URL
Current_URL = "http://" & Trim(Request.ServerVariables("HTTP_HOST"))
Current_URL = Current_URL & Trim(Request.ServerVariables("SCRIPT_NAME"))
CheckComeURL = EL_Common.CheckComefrom(ComeURL, Current_URL)
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -