<% Dim HtmlContent,ChannelRootDir Dim strRegItem,GetCode ChannelRootDir = Newasp.InstallDir & "user/" Newasp.LoadTemplates 9999, 5, 0 HtmlContent = Newasp.HtmlContent HtmlContent = Replace(HtmlContent,"{$InstallDir}", Newasp.InstallDir) HtmlContent = Replace(HtmlContent, "{$ChannelID}", 0) '--频道目录 HtmlContent = Replace(HtmlContent,"{$ChannelRootDir}", ChannelRootDir) HtmlContent = Replace(HtmlContent,"{$CurrentStation}","用户注册") HtmlContent = Replace(HtmlContent,"{$PageTitle}","用户注册") HtmlContent = ReadClassMenu(HtmlContent) HtmlContent = ReadClassMenubar(HtmlContent) If CInt(Newasp.membergrade) > 0 Then Response.Redirect "index.asp" If CInt(Newasp.CheckUserReg) <> 1 Then ErrMsg = ErrMsg + Newasp.HtmlSetting(1) Founderr = True ElseIf Newasp.CheckStr(Request("action")) = "agree" Then Call ApplyMember ElseIf Newasp.CheckStr(Request("action")) = "reg" Then Call RegNewMember Else strRegItem = Newasp.HtmlSetting(5) HtmlContent = Replace(HtmlContent,"{$UserManageContent}", Newasp.HtmlSetting(3)) HtmlContent = Replace(HtmlContent,"{$UserRegItem}", Server.HTMLEncode(strRegItem)) HtmlContent = Replace(HtmlContent,"{$SiteName}", Newasp.SiteName) Response.Write HtmlContent End If If Founderr = True Then Call Returnerr(ErrMsg) End If Sub ApplyMember() If Trim(Request.Form("action")) <> "agree" Then ErrMsg = ErrMsg + "

错误的系统参数！

" Founderr = True Exit Sub End If HtmlContent = Replace(HtmlContent,"{$UserManageContent}", Newasp.HtmlSetting(4)) HtmlContent = Replace(HtmlContent,"{$SiteName}", Newasp.SiteName) Response.Write HtmlContent End Sub Sub RegNewMember() Dim Rs,SQL Dim UserPassWord,strUserName,strGroupName,Password Dim rndnum,num1 Dim Question,Answer,usersex,sex On Error Resume Next If Newasp.CheckPost = False Then ErrMsg = ErrMsg + "

您提交的数据不合法，请不要从外部提交注册。

" FoundErr = True End If If Trim(Request.Form("username")) = "" Then ErrMsg = ErrMsg + "

登录账号不能为空！

" Founderr = True End If If Newasp.IsValidStr(Request.Form("username")) = False Then ErrMsg = ErrMsg + "

登录账号中含有非法字符！

" Founderr = True Else strUserName = Newasp.CheckBadstr(Trim(Request.Form("username"))) End If If Trim(Request.Form("nickname")) = "" Then ErrMsg = ErrMsg + "

用户昵称不能为空！

" Founderr = True End If If Newasp.IsValidStr(Request.Form("nickname")) = False Then ErrMsg = ErrMsg + "

用户昵称中含有非法字符！

" Founderr = True End If If Newasp.IsValidPassword(Request.Form("password1")) = False Then ErrMsg = ErrMsg + "

密码中含有非法字符！

" Founderr = True End If If Trim(Request.Form("password1")) <> Trim(Request.Form("password2")) Then ErrMsg = ErrMsg + "

您输入的密码和确认密码不一致！

" Founderr = True End If If IsValidEmail(Request.Form("usermail")) = False Then ErrMsg = ErrMsg + "

您的Email有错误！

" Founderr = True End If If Trim(Request.Form("usersex")) = "" Then ErrMsg = ErrMsg + "

您的姓别不能为空！

" Founderr = True Else usersex = Newasp.CheckBadstr(Request.Form("usersex")) End If If usersex = "女" Then sex = 0 Else sex = 1 End If If Request("verifycode") = "" Then ErrMsg = ErrMsg + "

请返回输入验证码码。

" Founderr = True ElseIf Session("getcode") = "9999" Then Session("getcode") = "" ErrMsg = ErrMsg + "

请不要重复提交，如需重新登陆请返回登陆页面。

" Founderr = True ElseIf CStr(Session("getcode"))<>CStr(Trim(Request("verifycode"))) Then ErrMsg = ErrMsg + "

您输入的验证码和系统产生的不一致，请重新输入。

" Founderr = True End If Session("getcode") = "" Set Rs = Newasp.Execute("SELECT username FROM NC_User WHERE username='" & strUserName & "'") If Not (Rs.BOF And Rs.EOF) Then FoundErr = True ErrMsg = ErrMsg + "

Sorry！此用户已经存在,请换一个用户名再试！

" Exit Sub End If Rs.Close:Set Rs = Nothing Set Rs = Newasp.Execute("SELECT username FROM NC_Admin WHERE username='" & strUserName & "'") If Not (Rs.BOF And Rs.EOF) Then FoundErr = True ErrMsg = ErrMsg + "

Sorry！此用户已经存在,请换一个用户名再试！

" Exit Sub End If Rs.Close:Set Rs = Nothing If CInt(Newasp.ChkSameMail) = 1 Then Set Rs = Newasp.Execute("SELECT userid FROM NC_User WHERE usermail='" & Newasp.CheckStr(Request("usermail")) & "'") If Not Rs.EOF Then FoundErr = True ErrMsg = ErrMsg + "

对不起！本系统已经限制一个邮箱只能注册一个账号。

此邮箱["&Request("usermail")&"]已经占用，请您换一个邮箱再注册吧。

" End If Rs.Close:Set Rs = Nothing End If If CInt(Newasp.MailInformPass) = 1 Then Randomize Do While Len(rndnum) < 8 num1 = CStr(Chr((57 - 48) * rnd + 48)) rndnum = rndnum & num1 loop UserPassWord = rndnum Else UserPassWord = Trim(Request.Form("password2")) End If Password = md5(UserPassWord) Question = Trim(Request.Form("question")) Answer = Trim(Request.Form("answer")) If Question = "" Then Question = Newasp.GetRandomCode If Answer = "" Then Answer = Newasp.GetRandomCode '----------------------------------------------------------------- '系统整合 '----------------------------------------------------------------- Dim API_Newasp,API_SaveCookie,SysKey If API_Enable Then Set API_Newasp = New API_Conformity API_Newasp.NodeValue "action","reguser",0,False API_Newasp.NodeValue "username",strUserName,1,False Md5OLD = 1 SysKey = Md5(API_Newasp.XmlNode("username") & API_ConformKey) Md5OLD = 0 API_Newasp.NodeValue "syskey",SysKey,0,False API_Newasp.NodeValue "password",UserPassWord,0,False API_Newasp.NodeValue "email",Newasp.CheckStr(Request.Form("usermail")),1,False API_Newasp.NodeValue "question",Question,1,False API_Newasp.NodeValue "answer",Answer,1,False API_Newasp.NodeValue "gender",sex,0,False API_Newasp.SendHttpData If API_Newasp.Status = "1" Then Founderr = True ErrMsg = ErrMsg & API_Newasp.Message Exit Sub Else API_SaveCookie = API_Newasp.SetCookie(SysKey,strUserName,Password,1) End If Set API_Newasp = Nothing End If '----------------------------------------------------------------- If Founderr = True Then Exit Sub Call PreventRefresh '防刷新 Set Rs = Newasp.Execute("SELECT GroupName FROM NC_UserGroup WHERE Groupid=3") If Rs.BOF And Rs.EOF Then strGroupName = "普通会员" Else strGroupName = Newasp.CheckBadstr(Rs(0)) If Len(strGroupName) = 0 Then strGroupName = "普通会员" End If Rs.Close:Set Rs = Nothing Set Rs = Server.CreateObject("ADODB.Recordset") SQL = "select * from NC_User where (userid is null)" Rs.Open SQL,Conn,1,3 Rs.Addnew Rs("username") = strUserName Rs("password") = Password Rs("nickname") = Newasp.CheckBadstr(Request.Form("nickname")) Rs("UserGrade") = 1 Rs("UserGroup") = strGroupName Rs("UserClass") = 0 If CInt(Newasp.AdminCheckReg) = 1 Then Rs("UserLock") = 1 Else Rs("UserLock") = 0 End If Rs("UserFace") = "face/1.gif" Rs("userpoint") = CLng(Newasp.AddUserPoint) Rs("usermoney") = 0 Rs("savemoney") = 0 Rs("prepaid") = 0 Rs("experience") = 10 Rs("charm") = 10 Rs("TrueName") = Newasp.CheckBadstr(Request.Form("username")) Rs("usersex") = usersex Rs("usermail") = Newasp.CheckStr(Request.Form("usermail")) Rs("oicq") = "" Rs("question") = Question Rs("answer") = md5(Answer) Rs("JoinTime") = Now() Rs("ExpireTime") = Now() Rs("LastTime") = Now() Rs("Protect") = 0 Rs("usermsg") = 0 Rs("userlastip") = Newasp.GetUserip If CInt(Newasp.AdminCheckReg) = 0 And CInt(Newasp.MailInformPass) = 0 Then Rs("userlogin") = 1 Else Rs("userlogin") = 0 End If Rs("usersetting") = ",,,,,,,,,,,,,,,,,,,,,,,,,,,,,," Rs.update Rs.Close SQL = "SELECT userid,username,password,nickname,UserGrade,UserGroup,UserClass,UserLock,userlogin FROM NC_user WHERE username = '" & Newasp.CheckBadstr(Request.Form("username")) & "' ORDER BY userid DESC" Rs.Open SQL, Conn, 1, 3 If Rs("UserLock") = 0 And CInt(Newasp.MailInformPass) = 0 Then Response.Cookies(Newasp.Cookies_Name)("userid") = Rs("userid") Response.Cookies(Newasp.Cookies_Name)("username") = Rs("username") Response.Cookies(Newasp.Cookies_Name)("password") = Rs("password") Response.Cookies(Newasp.Cookies_Name)("nickname") = Rs("nickname") Response.Cookies(Newasp.Cookies_Name)("UserGrade") = Rs("UserGrade") Response.Cookies(Newasp.Cookies_Name)("UserGroup") = Rs("UserGroup") Response.Cookies(Newasp.Cookies_Name)("UserClass") = Rs("UserClass") '----------------------------------------------------------------- '系统整合 '----------------------------------------------------------------- If API_Enable Then Response.Write API_SaveCookie Response.Flush End If '----------------------------------------------------------------- End If Rs.Close Set Rs = Nothing '发送注册邮件 Dim username,useremail,topic,mailbody,strMessage If CInt(Newasp.IsCloseMail) = 0 And CInt(Newasp.SendRegMessage) = 1 Then username = strUserName useremail = Trim(Request.Form("usermail")) topic = "您在 " & Newasp.SiteName & " 的注册资料" mailbody = Newasp.HtmlSetting(6) mailbody = Replace(mailbody,"{$SiteName}", Newasp.SiteName, 1, -1, 1) mailbody = Replace(mailbody,"{$SiteUrl}", Newasp.SiteUrl, 1, -1, 1) mailbody = Replace(mailbody,"{$UserName}", username, 1, -1, 1) mailbody = Replace(mailbody,"{$EmailTopic}", topic, 1, -1, 1) mailbody = Replace(mailbody,"{$PassWord}", UserPassWord, 1, -1, 1) Select Case CInt(Newasp.SendMailType) Case 0 strMessage = "

系统未开启邮件功能，请记住您的注册信息。

" Case 1 Call Jmail(useremail, topic, mailbody) Case 2 Call Cdonts(useremail, topic, mailbody) Case 3 Call aspemail(useremail, topic, mailbody) Case Else strMessage = "

系统未开启邮件功能，请记住您的注册信息。

" End Select If SendMail = "OK" Then strMessage = "

您的注册信息已经发往您的邮箱，[" & Request("usermail") & "] 请注意查收。

" Else strMessage = "

由于系统错误，给您发送的注册资料未成功。

" End If End If If CInt(Newasp.AdminCheckReg) = 1 Then strMessage = strMessage & "

请等待管理员认证……

" End If sucmsg = Newasp.HtmlSetting(2) sucmsg = Replace(sucmsg, "{$UserName}", Request("username")) sucmsg = Replace(sucmsg, "{$Message}", strMessage) Call ReturnIndex(sucmsg) '----------------------------------------------------------------- '系统整合 '----------------------------------------------------------------- If API_Enable Then If API_ReguserUrl <> "0" Then Response.Write "" End If End If '----------------------------------------------------------------- End Sub Sub ReturnIndex(message) Response.Write "" & vbCrLf Response.Write "" Response.Write "

" & vbCrLf Response.Write "" Response.Write "" Response.Write " " Response.Write " " Response.Write "" Response.Write "" Response.Write " " Response.Write "" Response.Write "" Response.Write " " Response.Write " " Response.Write "" Response.Write "" Response.Write "" Response.Write " " Response.Write " " Response.Write "" Response.Write "

3 秒钟后系统将自动转到用户管理首页 " & message & "
返回上一页...

" Response.Write "

" Response.Write "" End Sub CloseConn %>