<% Dim Action,Page_Url If Session(CacheName&"RegTime")+BBS.Info(9)/1440>now() then BBS.GotoErr(24) If BBS.Info(40)="0" then BBS.GoToErr(23) Action=request.querystring("action") If Action <> "" Then Page_Url = "?action="&Action Else Page_Url = "" End If BBS.Head"Register.asp"&Page_Url,"","注册新用户" If Len(Action)>10 Then BBS.GoToErr(1) Select Case Action Case"agree" Register() Case"check" RegSaveData() Case Else RegMain() End Select BBS.Footer() Set BBS =Nothing Sub RegMain() Dim Caption,Content Caption="注册协议" Content="
"&_ "
" BBS.ShowTable Caption,Content End Sub Sub RegSaveData() With BBS .CheckMake'禁止外部提交 Dim S,Caption,Content,Rs,Name,password,RePassword,Clue,Answer,Mail,PicUrl,headpicoption,PicW,PicH,Home,Sign,QQ,IsQQpic,Sex,Birthday,iCode,UserID,IsDel Name=.Fun.GetStr("name") password=.Fun.GetStr("password") RePassword=.Fun.GetStr("repassword") Clue=.Fun.GetStr("clue") Answer=.Fun.GetStr("answer") Mail=.Fun.GetStr("mail") iCode=.Fun.GetStr("iCode") If name="" or Password="" or RePassword="" or Mail="" or Clue="" or Answer="" Then .GoToErr(36) If .Fun.StrLength(name)>14 or .Fun.StrLength(name)<2 or .Fun.strLength(password)>14 Then .GoToErr(38) If Not .Fun.CheckName(name) OR Not .Fun.CheckPassword(Password) Then .GoToErr(37) If instr(lcase(.Info(52)),lcase(Name))>0 Then .GoToErr(37) If Not .Execute("SELECT name FROM [user] where Name='"&Name&"'").Eof Then .GoToErr(39) IF instr("123456|1234567|12345678|123456789|1111111|222222|333333|888888|aaaaaaa","|"& Password &"|")>0 or len(Password)<6 Then .GoToErr(40) If Repassword<>Password Then .GoToErr(41) If .Info(13)="1" Then If iCode<>Session("iCode") or Session("iCode")="" Then .GotoErr(8) End If Mail=server.HTMLEnCode(Mail) If Not .Fun.IsValidEmail(Mail) Then .GoToErr(42) '只允一个邮箱 If .Info(42)="1" Then If Not .Execute("SELECT ID FROM [user] where Mail='"&Mail&"'").Eof Then .GoToErr(49) End If If .Fun.GetStr("rnd")<>"bd04c9fea4c8" Then .GoToErr(2) If Len(Clue)<3 or Len(Answer)<3 Then .GoToErr(43) If not .Fun.CheckIn(Clue) or not .Fun.CheckIn(Answer) Then .GoToErr(44) PicUrl=lcase(.Fun.HtmlCode(.Fun.GetStr("PicUrl"))) headpicoption=.Fun.HtmlCode(.Fun.GetStr("headpicoption")) If Not .Fun.isInteger(headpicoption) Or Not .Fun.IsUrl(PicUrl) Then .GoToErr(81) Home=.Fun.HtmlCode(.Fun.GetStr("Home")) Sex=.Fun.GetStr("Sex") Birthday=.Fun.GetStr("Birthday") QQ=.Fun.GetStr("QQ") IsQQpic=.Fun.GetStr("IsQQpic") If Instr(Home,"://")=0 Then Home=.Info(1) If IsQQpic<>"1" Then IsQQpic="0" Sign=Replace(Left(.Fun.Replacehtml(.Fun.GetStr("Sign")),255),"{帖子内容}","") PicH=.Fun.GetStr("PicH") PicW=.Fun.Getstr("PicW") If .Info(57)="1" And (Instr(PicUrl,"://")>0 Or Instr(Lcase(Picurl),"www")>0 Or Instr(Lcase(PicUrl),"..")>0) Then .GotoErr(45)'禁止外部图片 If PicUrl="" then PicUrl="Pic/headpic/"& headpicoption &".gif" PicW= .Info(54) PicH= .Info(55) End If If (QQ<>"" And not isnumeric(QQ)) Or (IsQQpic="1" and QQ="") then .GoToErr(46) If Len(Clue)>70 Or Len(Answer)>70 or Len(Mail)>50 or Len(PicUrl)>220 or Len(QQ)>20 or Len(Home)>250 Then .GoToErr(47) If Not isnumeric(PicW) or Not isnumeric(PicH) Then .GoToErr(48) If Int(PicW)>int(.Info(56)) or Int(PicH)>int(.Info(56)) then PicW=.Info(54) PicH=.Info(55) End If If Not isdate(Birthday) then Birthday="Null" Else .Cache.clean("Birthday") Birthday="'"&Birthday&"'" End If If .Info(41)="1" then IsDel=2'注册核审 S="
  • 你的注册信息已提交,请您等待管理员的审核!
  • " Else IsDel=0 S="
  • 现在登陆
  • " End If .Execute("Insert into [User](Name,[Password],Clue,Answer,Mail,Home,Sex,IsQQpic,Birthday,QQ,Pic,PicW,PicH,RegTime,LastTime,Sign,Regip,Coin,Isdel,GoodNum,EssayNum,Mark,BankSave,isShow,isVip,isSign,LoginNum,GameCoin,BankTime)VALUES('"&Name&"','"&Md5(password)&"','"&Clue&"','"&Md5(Answer)&"','"&Mail&"','"&Home&"',"&Sex&","&IsQQpic&","&Birthday&",'"&QQ&"','"&PicUrl&"',"&PicW&","&PicH&",'"&.NowBbsTime&"','"&.NowBbsTime&"','"&Sign&"','"&.MyIP&"',100,"&IsDel&",0,0,0,0,0,0,0,0,0,'"&.NowBbsTime&"')") UserID=.Execute("Select ID From[User] where Name='"&Name&"'")(0) .UpdateGrade UserID,0,0 .Execute("update [Config] set NewUser='"&name&"',UserNum=UserNum+1") '自动发送留言 If .Info(43)="1" Then .Execute("insert into [sms](name,MyName,Content,ubbString) values('自动送信系统','"&name&"','"&.Info(46)&"',',')") .Execute("update [User] set NewSmsNum=1,SmsSize=1 Where Name='"&name&"'") End If Caption="注册成功" Content="
    恭喜您成为本论坛会员"&S&"
  • 返回首页
  • " .ShowTable Caption,Content Session(CacheName&"RegTime")=Now() S=Replace(Join(.InfoUpdate,","),","&.InfoUpdate(5)&","&.InfoUpdate(6)&",",","&Int(.InfoUpdate(5))+1&","&Name&",") .Cache.Add "InfoUpdate",S,dateadd("n",2000,.NowBBSTime) End with End Sub Sub Register() Dim S S="
    " S=S&"
    必填资料
    " S=S&BBS.Row("用户名称:
    注册用户名不能超过14个字符(7个汉字)"," ","65%","40px") S=S&BBS.Row("密码(最少6位,最多16位)
    请使用除“'”和“|”和中文以外的字符","
    未能评级
    ","65%","43px") S=S&BBS.Row("重复密码
    请再输一遍确认","","65%","40px") If BBS.Info(13)="1" Then S=S&BBS.Row("请输入右边的验证码:",BBS.GetiCode,"65%","") S=S&BBS.Row("您的性别:"," 帅哥   靓女","65%","") S=S&BBS.Row("密码问题
    忘记密码的提示问题","","65%","40px") S=S&BBS.Row("问题答案
    忘记密码的提示问题答案,用于取回论坛密码","","65%","40px") S=S&BBS.Row("OICQ号码:
    填写您的QQ地址,方便与他人的联系"," 启用QQ形象作为头像","65%","40px") S=S&BBS.Row("Email地址
    请输入有效的邮件地址","","65%","40px") S=S&"
    选填资料
    " S=S&"
    " S=S&BBS.Row("生日:","","65%","20px") S=S&BBS.Row("主页:
    填写你的个人主页,让大家见识见识!","","65%","40px") S=S&"
    " S=S&BBS.Row("选择论坛头像:
    使用论坛自带的图像",HeadPicOpt() &" ","65%","") S=S&BBS.Row("自定义头像:
    如果图像位置中有连接图片将以自定义的为主"," 完整Url地址
    图像宽度: 高度:(最大限度:120)","65%","") S=S&"
    " S=S&BBS.Row("个性签名:
    文字将出现在您发表的文章的结尾处
    体现您的个性(最多255个字符)","","65%","") S=S&"
      
    " BBS.ShowTable"新用户注册",S %> <% End Sub Function HeadPicOpt() Dim S,i for i=2 to Int(BBS.Info(53)) S=S&"" Next HeadPicOpt="" End Function %>