<% Dvbbs.LoadTemplates("usermanager") Dvbbs.Stats=Dvbbs.MemberName&"升级成为VIP用户" Dvbbs.mainsetting(0)="98%" Dvbbs.Head() Dvbbs.ErrType = 1 '转到不显示顶部和导航的错误显示页 Page_Main() Dvbbs.Footer() Sub Page_Main() If Dvbbs.userid=0 Then Dvbbs.AddErrCode(6):Dvbbs.Showerr() '判断用户是否在线。 If Dvbbs.Master Then Response.redirect "showerr.asp?ErrCodes=

论坛管理员不需要执行升级操作。&action=NoHeadErr" End If Select Case Request("action") Case "UpVipUser" Call UpVipUser() Case Else Call JoinVip() End Select End Sub Sub UpVipUser() Dim GroupID,Btype,vipmoney,vipticket GroupID = Dvbbs.CheckNumeric(Request.Form("vipgroupid")) Btype = Dvbbs.CheckNumeric(Request.Form("Btype")) vipmoney = Dvbbs.CheckNumeric(Request.Form("vipmoney")) vipticket = Dvbbs.CheckNumeric(Request.Form("vipticket")) If GroupID = 0 or not (vipmoney>0 Or vipticket>0) Then Response.redirect "showerr.asp?ErrCodes=

参数错误，请按要求填写后再进行操作。&action=NoHeadErr" Exit Sub End If Dim Rs,Sql,VipGroupSetting,UpSetting Dim MustNum,NeedPoint,UpDats,DayStr MustNum = 0 UpDats = 0 Dvbbs.MyUserInfo(37) = cCur(Dvbbs.MyUserInfo(37)) Dvbbs.MyUserInfo(38) = cCur(Dvbbs.MyUserInfo(38)) If IsSqlDataBase=1 Then DayStr = "day" Else DayStr = "'d'" End If Sql = "SELECT UserGroupID,Title,Usertitle,GroupSetting,GroupPic FROM Dv_UserGroups WHERE ParentGID=5 and UserGroupID="&GroupID SET Rs = Dvbbs.Execute(SQL) If Not Rs.eof Then VipGroupSetting = Split(Rs(3),",") UpSetting = Split(VipGroupSetting(71),"§") '升级到该组所需金币数金币数§点券数§有效天数§最低天数 If Btype=1 Then '点券支付 vipmoney = 0 If Dvbbs.CheckNumeric(UpSetting(3))>0 Then '当有最低天数限制 MustNum = Dvbbs.CheckNumeric(UpSetting(3))*Dvbbs.CheckNumeric(UpSetting(1))/Dvbbs.CheckNumeric(UpSetting(2)) If MustNum>0 Then MustNum = cCur(FormatNumber(MustNum,0)) Else Response.redirect "showerr.asp?ErrCodes=

您要支付的点券数不能为0，请重新确认后再进行操作。&action=NoHeadErr" Exit Sub End If End If If Dvbbs.MyUserInfo(38)您的点券数不足，请重新确认后再进行操作。&action=NoHeadErr" Exit Sub End If Dvbbs.MyUserInfo(38) = Dvbbs.MyUserInfo(38) - vipticket UpDats = vipticket*Dvbbs.CheckNumeric(UpSetting(2))/Dvbbs.CheckNumeric(UpSetting(1)) UpDats = Int(FormatNumber(UpDats,0)) Else '金币支付 vipticket = 0 If Dvbbs.CheckNumeric(UpSetting(3))>0 Then '当有最低天数限制 MustNum = Dvbbs.CheckNumeric(UpSetting(3))*Dvbbs.CheckNumeric(UpSetting(0))/Dvbbs.CheckNumeric(UpSetting(2)) If MustNum>0 Then MustNum = cCur(FormatNumber(MustNum,0)) Else Response.redirect "showerr.asp?ErrCodes=

您要支付的金币数不能为0，请重新确认后再进行操作。&action=NoHeadErr" Exit Sub End If End If If Dvbbs.MyUserInfo(37)您的金币数不足，请重新确认后再进行操作。&action=NoHeadErr" Exit Sub End If Dvbbs.MyUserInfo(37) = Dvbbs.MyUserInfo(37) - vipmoney UpDats = vipmoney*Dvbbs.CheckNumeric(UpSetting(2))/Dvbbs.CheckNumeric(UpSetting(0)) UpDats = Int(FormatNumber(UpDats,0)) End If If Not IsDate(Dvbbs.MyUserInfo(40)) Then Dvbbs.MyUserInfo(40) = Now() End If If Not IsDate(Dvbbs.MyUserInfo(41)) Then Dvbbs.MyUserInfo(41) = Now() End If Dvbbs.MyUserInfo(41) = DateAdd("d", UpDats, Dvbbs.MyUserInfo(41)) Sql = "UPDATE [Dv_User] Set UserGroupID="&GroupID&",UserClass='"&Dvbbs.Checkstr(Rs(2))&"',TitlePic='"&Dvbbs.Checkstr(Rs(4))&"',UserMoney=UserMoney-"&vipmoney&",UserTicket = UserTicket-"&vipticket If Dvbbs.VipGroupUser Then Sql = Sql &",Vip_EndTime = Dateadd("&DayStr&","&UpDats&",Vip_EndTime) Where UserID="&Dvbbs.UserID Else Sql = Sql &",Vip_StarTime = "&SqlNowString&",Vip_EndTime = Dateadd("&DayStr&","&UpDats&","&SqlNowString&") Where UserID="&Dvbbs.UserID End If 'Response.Write sql Dvbbs.Execute(Sql) Session(Dvbbs.CacheName & "UserID") = Dvbbs.MyUserInfo Dim LogMsg LogMsg = "恭喜您：操作成功，获得( "&Rs(1)&"--"&Rs(2)&" ) "&UpDats &" 天的使用期限，金币减少"&vipmoney&",点券减少"&vipticket&"。" Call Dvbbs.ToolsLog(0,0,vipmoney,vipticket,6,LogMsg,Dvbbs.MyUserInfo(37)&"|"&Dvbbs.MyUserInfo(38)) Dvbbs.Dvbbs_Suc(LogMsg) Else Response.redirect "showerr.asp?ErrCodes=

参数错误，所选取的VIP用户组不存在，请按要求填写后再进行操作。&action=NoHeadErr" Exit Sub End If Rs.close:Set Rs = Nothing End Sub '申请及续费VIP表单 Sub JoinVip() Call JS_VipGroupInfo() Response.Write template.html(21) Call UserInfo() End Sub '构造VIP用户组信息JS对象 Sub JS_VipGroupInfo() Dim Rs,Sql,VipGroupSetting,i Sql = "SELECT UserGroupID,Title,Usertitle,GroupSetting FROM Dv_UserGroups WHERE ParentGID=5" SET Rs = Dvbbs.Execute(SQL) If Not Rs.eof Then SQL=Rs.GetRows(-1) Rs.close:Set Rs = Nothing Else '未添加VIP用户组 Response.redirect "showerr.asp?ErrCodes=

系统还未添加VIP用户组，请联系系统管理员。&action=NoHeadErr" Exit Sub End If Dim VID,VTitle,VUTitle,VMSetting,VTSetting,VSetting Dim NMoney,Mdays,Ldays,NTicket Response.Write VBNewline Response.Write "" & VBNewline End Sub '-------------------------------------------------------------------------------- '用户信息 '-------------------------------------------------------------------------------- Sub UserInfo() Dim Sql,Rs,UserToolsCount %> <% End Sub %>