<% Dim Action Action=Lcase(Request.Querystring("Action")) If Len(Action)>15 Then BBS.GotoErr(1) BBS.CheckMake if Action<>"getpassword" and Action<>"forgetpassword" Then BBS.Position=BBS.Position&" -> 用户控制面版" If Not BBS.FoundUser Then BBS.GotoErr(4) End If Select Case Action Case"myinfo" MyInfo() Case"savemyinfo" SaveMyInfo Case"mypassword" MyPassword Case"savemypassword" SaveMyPassword Case"forgetpassword" forgetpassword Case"getpassword" GetPassword Case else BBS.GoToErr(1) End Select BBS.Footer() Set BBS =Nothing Sub MyManager() Response.Write BBS.ReadSkins("用户控制面版") End Sub Sub Myinfo() Dim Rs,S,temp,Temp1 BBS.Head "","","修改个人资料" MyManager() SET RS=BBS.Execute("Select Name,Sex,Birthday,Mail,Home,IsQQpic,QQ,Pic,Pich,Picw,IsSign,Sign,Honor,GradeID From[user]where ID="&BBS.MyID&" And Isdel=False") IF Rs.eof Then BBS.MakeCookiesEmpty():BBS.GotoErr(100) S="
" S=S&"
必填资料
" S=S&BBS.Row("用户名称
此为论坛ID帐号,自己不能修改","
"&Rs("Name")&"","65%","45px") If Rs("Sex")=1 Then Temp=" checked" Else Temp="" If Rs("Sex")=0 Then Temp1=" checked" Else Temp1="" S=S&BBS.Row("您的性别:"," 帅哥   靓女","65%","") S=S&BBS.Row("Email地址
请输入有效的邮件地址","","65%","44px") S=S&"
选填资料
" S=S&"
" S=S&BBS.Row("生日:","","65%","20px") S=S&BBS.Row("主页:
填写你的个人主页,让大家见识见识!","","65%","44px") If Rs("IsQQPic") Then Temp=" checked" Else Temp="" End If S=S&BBS.Row("QQ号码:
填写您的QQ地址,方便与他人的联系"," 启用QQ形象作为头像","65%","44px") S=S&"
" S=S&BBS.Row("选择论坛头像:
使用论坛自带的图像",HeadPicOpt() &" ","65%","50") If SESSION(CacheName& "MyGradeInfo")(14)="1" then Temp="
" Else Temp="" End if S=S&BBS.Row("自定义头像:
如果图像位置中有连接图片将以自定义的为主",Temp&" 完整Url地址
图像宽度: 高度:(最大限度:120)","65%","") S=S&"
" If SESSION(CacheName& "MyGradeInfo")(8)="0" then Temp="您还没达到可以自定头衔称号的等级权限" Else Temp="" End If S=S&BBS.Row("自定义头衔称号:
最多8个汉字",Temp,"65%","40px") S=S&BBS.Row("个性签名:
文字将出现在您发表的文章的结尾处
体现您的个性(最多255个字符)","","65%","") S=S&"
  
" BBS.ShowTable"修改我的资料",S %> <% End Sub Function HeadPicOpt() Dim Temp,i for i=2 to Int(BBS.Info(53)) Temp=Temp&"" Next HeadPicOpt="" End Function Sub SaveMyInfo() With BBS .Head"","","修改个人资料" MyManager() Dim Temp,Content,Rs,Sql,Name,Mail,PicUrl,HeadPic,PicW,PicH,Home,Sign,QQ,IsQQpic,Sex,Birthday,Honor Name=.Fun.GetStr("name") Mail=.Fun.GetStr("mail") Honor=.Fun.GetStr("Honor") If Mail="" Then .GoToErr(42) 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&"' And ID<>"&.MyID).Eof Then .GoToErr(49) End If PicUrl=lcase(.Fun.HtmlCode(.Fun.GetStr("PicUrl"))) headpic=.Fun.HtmlCode(.Fun.GetStr("headpicoption")) If Not .Fun.isInteger(headpic) 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 IsQQPic="" Then IsQQPic=0 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/"& HeadPic &".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(Honor)>16 or Len(Mail)>50 or Len(HeadPic)>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 Birthday=Replace(Birthday,",","-") If Not isdate(Birthday) then Birthday="Birthday=Null" Else .Cache.clean("Birthday") Birthday="Birthday='"&Birthday&"'" End If .execute("update [User] set "&Birthday&",Sex="&Sex&",PicW="&PicW&",PicH="&PicH&",Mail='"&Mail&"',QQ='"&QQ&"',Honor='"&Honor&"',Pic='"&PicUrl&"',Home='"&Home&"',Sign='"&Sign&"',IsQQpic="&IsQQpic&" where ID="&BBS.MyID) Content="
  • 资料修改成功!
  • 返回我的用户控制面版
  • 返回首页
  • " .ShowTable"修改成功",Content Session(CacheName & "MyInfo") = Empty End with End Sub Sub MyPassword Dim S BBS.Head "","","修改密码" MyManager() S="
    " S=S&BBS.Row("旧密码确认:
    请输入旧密码进入确认","","65%","44px") S=S&BBS.Row("新的密码(最多14位):
    请使用除“'”和“|”以及中文以外的字符","","65%","44px") S=S&BBS.Row("重复密码:
    请再输一遍确认","","65%","44px") S=S&BBS.Row("密码问题
    忘记密码的提示问题"," 如不改请不要填写","65%","40px") S=S&BBS.Row("问题答案
    忘记密码的提示问题答案,用于取回论坛密码"," 同上","65%","40px") S=S&"
      
    " BBS.ShowTable "修改密码",S End Sub Sub SaveMyPassword Dim Password,NewPassword,RePassword,Caption,Content,Clue,Answer BBS.CheckMake'禁止外部提交 BBS.Head"","","修改密码" MyManager() Password=BBS.Fun.GetStr("Password") NewPassword=BBS.Fun.GetStr("NewPassword") RePassword=BBS.Fun.GetStr("RePassword") Clue=BBS.Fun.GetStr("clue") Answer=BBS.Fun.GetStr("answer") If Password="" or Repassword="" or NewPassword="" Then BBS.GoToErr(36) If Repassword<>NewPassword Then BBS.GoToErr(41) If Not BBS.Fun.CheckPassword(Password) Or Not BBS.Fun.CheckPassword(NewPassword) Then BBS.GoToErr(37) If BBS.Fun.StrLength(NewPassword)>14 Then BBS.GoToErr(38) If md5(Password)<>BBS.MyPassword Then BBS.GoToErr(56) IF instr("|12345|123456|1234567|12345678|123456789|1234567890|0123456789|111111|222222|333333|888888|aaaaaa|","|"& Password &"|")>0 or len(Password)<5 Then BBS.GoToErr(40) If Clue<>"" or Answer<>"" Then If Len(Clue)<3 or Len(Answer)<3 Then BBS.GoToErr(43) If not BBS.Fun.CheckIn(Clue) or not BBS.Fun.CheckIn(Answer) Then BBS.GoToErr(44) BBS.execute("update [user] set [Clue]='"&Clue&"',Answer='"&MD5(Answer)&"' where ID="&BBS.MyID) End IF NewPassword=Md5(Newpassword) BBS.execute("update [user] set [password]='"&Newpassword&"' where ID="&BBS.MyID) BBS.LetMemor "","MyPassword",NewPassword Session(CacheName & "MyInfo") = Empty Content="
  • 密码修改成功!
  • 返回用户控制面版
  • 返回首页
  • " BBS.ShowTable "修改成功",Content End Sub Sub ForgetPassword Dim UserName,rs,S BBS.Head"","","找回密码" UserName=BBS.Fun.GetStr("UserName") If UserName="" Then S="
    " S=S&BBS.Row("您的用户名:"," 请输入注册的用户名称进入确认","90%","22px") S=S&"
    " Else BBS.CheckMake'禁止外部提交 If BBS.SafeBuckler(UserName,BBS.MyIP,0) Then BBS.Alert"BBS安全盾已启动!\n\n对不起,你尝试找回密码错误超过3次,今天不能再找回密码了。\n你的信息已被系统记录!","Index.asp" set rs=BBS.Execute("select clue from [User] where name='"&UserName&"'") S="
    " S=S&BBS.Row("用户名称:",""& UserName &"","90%","22px") S=S&BBS.Row("密码问题:", ""&Rs("clue")&"","90%","22px") S=S&BBS.Row("问题答案:"," 请输入您在注册时填写的问题答案","90%","22px") S=S&"
      
    " End If BBS.ShowTable"找回密码",S End Sub Sub GetPassword Dim UserName,Clue,Answer,NewPassword,Content BBS.Head"","","找回密码" UserName=BBS.Fun.GetStr("UserName") If BBS.SafeBuckler(UserName,BBS.MyIP,0) Then BBS.Alert"BBS安全盾已启动!\n\n对不起,你尝试找回密码错误超过3次,今天不能再找回密码了。\n你的信息已被系统记录!","Index.asp" Answer=BBS.Fun.GetStr("Answer") If UserName="" or Answer="" Then BBS.GoToErr(36) If Not BBS.Fun.CheckName(UserName) Then BBS.GoToErr(37) If not BBS.Fun.CheckIn(Answer) Then BBS.GoToErr(44) IF BBS.execute("select name from [User] where name='"&UserName&"' And Answer='"&Md5(Answer)&"'").eof Then BBS.SafeBuckler UserName,BBS.MyIP,1 BBS.GoToErr(57) Else Randomize NewPassword=int(900000*rnd)+100000 BBS.execute("update [user] set [password]='"&Md5(NewPassword)&"' where name='"&UserName&"'") BBS.execute("update [Admin] set [password]='"&Md5(NewPassword)&"' where name='"&UserName&"'") Content="
  • 您成功的通过密码保护的检验!
  • 用户名称:"&UserName&"   获得新密码:"&NewPassword&"
  • 先记住新密码,请您马上登陆论坛,尽快修改密码!
  • " BBS.ShowTable "成功通过验证",Content End If End Sub %>