<% Dvbbs.stats="购买论坛点券" Dvbbs.LoadTemplates("") Dvbbs.nav() Dvbbs.Head_var 0,0,"用户控制面板","usermanager.asp" If Request("raction")="alipay_return" Then AliPay_Return() Dvbbs.Footer() Response.End ElseIf Request("action")="alipay_return" Then AliPay_Return() Dvbbs.Footer() Response.End ElseIf Request("action")="Re_inmoney" Then Re_inmoney() Dvbbs.Footer() Response.End End If If Dvbbs.userid=0 Then Dvbbs.AddErrCode(6):Dvbbs.Showerr() Dvbbs.TrueCheckUserLogin() 'If (Dvbbs.Forum_ChanSetting(13)="1" And Dvbbs.Forum_ChanSetting(0)="1") And Dvbbs.Forum_ChanSetting(3)="0" Then ' Response.redirect "showerr.asp?ErrCodes=
  • 当前论坛没有开启网上支付或手机短信点播兑换点券的服务,请和系统管理员联系。&action=OtherErr" 'End If CenterMain() Dvbbs.Showerr() Dvbbs.Footer() Sub CenterMain() 'Tools_Nav_Link() %>
    <%UserInfo()%> <% Select Case Request.QueryString("action") Case "dsms" DSms() Case "Re_Sms" Re_Sms() Case "inmoney" inmoney() Case "alipay" AliPay() Case "alipay_1" AliPay_1() Case "alipay_return" AliPay_Return() Case "UserCenter" UserCenter() Case "UserToolsLog_List" UserToolsLog_List() Case "PayList" PayList() Case Else SmsPayMain() End Select %>
    <% End Sub Sub SmsPayMain() MainReadMe(0) If Dvbbs.Forum_ChanSetting(3)="0" Then %> 网络银行支付购买点券:使用前请到 阿里巴巴.支付宝 申请一个支付宝账号,支付过程不收取手续费
    请输入要支付的金额: 获取<%=CCur(Dvbbs.Forum_ChanSetting(14))*1%>张论坛点券。 (最低 1 元人民币 )
    您成功支付后有系统可能需要几分钟的时间等待支付结果,因此可能无法瞬间入账,支付成功后请刷新此页面并查看点券数是否正确。 <%End If%> <%If Dvbbs.Forum_ChanSetting(13)="1" And Dvbbs.Forum_ChanSetting(0)="1" Then%> 手机点播短信获奖点券:手机短信服务由北京阳光加信提供
    短信点播,请选择您要点播的资讯类别: 赠送 <%=Dvbbs.Forum_ChanSetting(14) * 2%> 张论坛点券
    兑换获奖论坛点券,请输入您收到的点券确认码:
    温馨提示:多个点券确认码可以使用逗号分隔开一次提交,如:20041030001,20041030002,20041030003 <%End If%> 点券使用小贴士
    ① 论坛点券可用于购买论坛中出售的各种趣味性道具
    ② 论坛点券和金币可用于参与论坛中一些需要点券购买贴的浏览、当您的帖子有人正确回答后赠与回复用户等操作
    ③ 各种论坛道具有其不同的功能,比如际遇卡可让目标用户(也可是您自己)随机出现一些际遇(如增减金钱获丢失道具等)
    ④ 论坛点券可在论坛用户中相互转让,前提是目标用户必须符合论坛设置以及购买了道具转让器
    ⑤ 系统中部分特殊的道具出于限制使用的目的,是需要用户同时拥有金币和点券才能购买的,有部分道具只有在特殊的情况下才会出现,这部分道具是用点券或金币都不能购买到的。 <% End Sub '短信点播第一次信息提交部分 Sub DSms() If Request("money")="" Then Response.redirect "showerr.asp?ErrCodes=
  • 非法的订阅参数。&action=OtherErr" Exit Sub ElseIf Not IsNumeric(Request("money")) Then Response.redirect "showerr.asp?ErrCodes=
  • 非法的订阅参数。&action=OtherErr" Exit Sub ElseIf Cint(Request("money"))<>2 And Cint(Request("money"))<>4 And Cint(Request("money"))<>6 Then Response.redirect "showerr.asp?ErrCodes=
  • 非法的订阅参数。&action=OtherErr" Exit Sub End If Get_ChallengeWord Dim Rs,UserMobile Set Rs=dvbbs.execute("select UserMobile,IsChallenge from [dv_user] where UserID="&Dvbbs.UserID) If Rs.Eof And Rs.Bof Then Response.redirect "showerr.asp?ErrCodes=
  • 您的用户并不存在,请重新登录或注册论坛。&action=OtherErr" Exit Sub Else If Rs("IsChallenge")=0 Then Response.redirect "showerr.asp?ErrCodes=
  • 您还不是本站的阳光会员,不能使用此功能,请升级为阳光会员。&action=iOtherErr" Exit Sub Else UserMobile = Rs("UserMobile") End If End If Set Rs=Dvbbs.Execute("Select Top 1 * From Dv_ChallengeInfo") If Rs.Eof And Rs.Bof Then Response.redirect "showerr.asp?ErrCodes=
  • 错误的数据,请联系动网论坛官方解决。&action=OtherErr" Exit Sub End If %> 正在提交数据,请稍后…… "> "> "> ">
  • <% Rs.Close Set Rs=Nothing End Sub '短信点播第一次提交接收信息部分 Sub Re_Sms() If Request("errorcode")="1" Then Dim challengeWord_key,retokerWord challengeWord_key=session("challengeWord_key") retokerWord=trim(request("token")) If challengeWord_key=retokerWord Then %>
    论坛成功信息
    操作成功:

  • 成功,请您前往论坛道具中心输入您手机中收到的论坛点券兑换序列号。
  • << 前往点券兑换   ||   关闭窗口>>

    <% Else 'Response.Write challengeWord_key &"||"&retokerWord Response.redirect "showerr.asp?ErrCodes=
  • 错误,非法的参数。&action=OtherErr" Exit Sub End If Else Response.redirect "showerr.asp?ErrCodes=
  • 错误,"&Request("errormsg")&"。&action=OtherErr" Exit Sub End If Emp_ChallengeWord End Sub '短信点播第二次序列号提交部分 Sub inmoney() If Request("SmsCode")="" Then Response.redirect "showerr.asp?ErrCodes=
  • 请输入正确的点券兑换序列号。&action=OtherErr" Exit Sub End If Get_ChallengeWord Dim Rs,UserMobile Set Rs=dvbbs.execute("select UserMobile,IsChallenge from [dv_user] where UserID="&Dvbbs.UserID) If Rs.Eof And Rs.Bof Then Response.redirect "showerr.asp?ErrCodes=
  • 您的用户并不存在,请重新登录或注册论坛。&action=OtherErr" Exit Sub Else If Rs("IsChallenge")=0 Then Response.redirect "showerr.asp?ErrCodes=
  • 您还不是本站的阳光会员,不能使用此功能,请升级为阳光会员。&action=iOtherErr" Exit Sub Else UserMobile = Rs("UserMobile") End If End If Set Rs=Dvbbs.Execute("Select Top 1 * From Dv_ChallengeInfo") If Rs.Eof And Rs.Bof Then Response.redirect "showerr.asp?ErrCodes=
  • 错误的数据,请联系动网论坛官方解决。&action=OtherErr" Exit Sub End If '进入论坛订单库 Dim SmsCode,PayMoney,i SmsCode = Split(Request("SmsCode"),",") PayMoney = (Ubound(SmsCode) + 1) * 2 Dvbbs.Execute("InSert Into Dv_ChanOrders (O_type,O_Username,O_isApply,O_issuc,O_PayMoney,O_Paycode,O_AddTime) Values (2,'"&Dvbbs.MemberName&"',0,0,"&PayMoney&",'"&Replace(Session("challengeWord"),"dv","")&"',"&SqlNowString&")") %> 正在提交数据,如果您的论坛地址设置了URL转发,将不能正确传输信息,请稍后……
    "> "> ">
    <% Rs.Close Set Rs=Nothing End Sub '短信点播第二次提交返回部分-充值到账号 Sub Re_inmoney() If Request("errorcode")<>"1" Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,"&Request("errormsg")&"。&action=OtherErr" Exit Sub End If Dim challengeWord_key,retokerWord,UserInMoney,PayCode 'challengeWord_key=session("challengeWord_key") retokerWord = Replace(Request("token"),"'","''") UserInMoney = Request("money") PayCode = Replace(Request("seqno"),"'","''") If Not IsNumeric(UserInMoney) Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,非法的参数1"&UserInMoney&"。&action=OtherErr" If Cint(UserInMoney)<0 Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,非法的参数2"&UserInMoney&"。&action=OtherErr" If retokerWord = "" Or PayCode = "" Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,非法的参数,"&UserInMoney&","&retokerWord&","&PayCode&"。&action=OtherErr" PayCode = Replace(Lcase(PayCode),"dv","") UserInMoney = FormatNumber(UserInMoney,2) '验证订单信息 Dim Rs Set Rs = Dvbbs.Execute("Select * From Dv_ChanOrders Where O_IsSuc=0 And O_PayCode = '"&PayCode&"'") If Rs.Eof And Rs.Bof Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,找不到该订单信息或该订单已支付成功。&action=OtherErr" Exit Sub Else '加密字符串验证 '重新生成加密字符串对照返回加密字符串 Dim PayCodeEnCode PayCodeEnCode = Md5("dv" & Rs("O_PayCode") & ":" & Trim(Request("errorcode")) & ":" & Trim(Request("money")) & ":" & Dvbbs.CacheData(21,0),32) 'Response.Write SignStr 'Response.Write "
    " 'Response.Write PayCodeEncode 'response.end If PayCodeEncode <> retokerWord Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,订单校验失败。&action=OtherErr" Exit Sub End If '更新数据库资料 '更新用户资料 Dvbbs.Execute("Update Dv_User Set UserTicket = UserTicket + " & Dvbbs.Forum_ChanSetting(14) * UserInMoney & " Where UserName='"&Rs("O_UserName")&"'") If Dvbbs.UserID > 0 And Lcase(Dvbbs.MemberName)=Lcase(Rs("O_UserName")) Then Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) + cCur(Dvbbs.Forum_ChanSetting(14) * UserInMoney) End If '更新订单状态 Dvbbs.Execute("Update Dv_ChanOrders Set O_IsSuc=1,O_PayMoney="&UserInMoney&" Where O_ID = " & Rs("O_ID")) End If Rs.Close Set Rs=Nothing Emp_ChallengeWord %>
    论坛成功信息
    操作成功:

  • 成功,您本次兑换了 <%=(Dvbbs.Forum_ChanSetting(14) * UserInMoney)%> 张论坛点券。
  • << 返回用户控制面板   ||   去把点券转换成论坛金币>>

    <% End Sub Sub AliPay() Dim PayMoney PayMoney = Request("paymoney") If PayMoney = "" Or Not IsNumeric(PayMoney) Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,非法的付款参数。&action=OtherErr" Exit Sub End If If PayMoney < 1 Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,每笔订单金额最小为 2 元人民币。&action=iOtherErr" Exit Sub End If PayMoney = FormatNumber(PayMoney,2) '生成订单号:01+yyyyMMddhhmmss+六位随机数 '生成日期字串 Dim NowTimes,PayMonth,PayDay,PayHour,PayMin,PaySe,PayDayStr,RandomizeStr,num1 Dim PayCode,PayCodeEnCode NowTimes = Now() PayMonth = Month(NowTimes) If Len(PayMonth)=1 Then PayMonth = "0" & PayMonth PayDay = Day(NowTimes) If Len(PayDay)=1 Then PayDay = "0" & PayDay PayHour = Hour(NowTimes) If Len(PayHour)=1 Then PayHour = "0" & PayHour PayMin = Minute(NowTimes) If Len(PayMin)=1 Then PayMin = "0" & PayMin PaySe = Second(NowTimes) If Len(PaySe)=1 Then PaySe = "0" & PaySe PayDayStr = Year(NowTimes) & PayMonth & PayDay & PayHour & PayMin & PaySe '生成随机字串 Randomize Do While Len(RandomizeStr)<5 num1 = CStr(Chr((57-48)*rnd+48)) RandomizeStr = RandomizeStr & num1 Loop 'Response.Write RandomizeStr 'Response.Write "
    " 'Response.Write PayDayStr If Dvbbs.Forum_ChanSetting(5) <> "0" Then PayCode = "01" & Dvbbs.Forum_ChanSetting(5) & PayDayStr & RandomizeStr Else PayCode = PayDayStr & RandomizeStr & Left(MD5(Dvbbs.Forum_ChanSetting(4)&Dvbbs.Forum_ChanSetting(6),32),8) End If Dim EnCodeStr EnCodeStr = "cmd1001subject购买点券body购买论坛点券order_no"&PayCode&"date"&Left(PayCode,8)&"price"&PayMoney&"type2number1transport3ordinary_fee0express_fee0seller"&Lcase(Dvbbs.Forum_ChanSetting(4))&"partner2088002048522272"&Dvbbs.Forum_ChanSetting(6)&"" EnCodeStr = MD5(EnCodeStr,32) '进入论坛订单库 Dvbbs.Execute("InSert Into Dv_ChanOrders (O_type,O_Username,O_isApply,O_issuc,O_PayMoney,O_Paycode,O_AddTime) Values (1,'"&Dvbbs.MemberName&"',0,0,"&PayMoney&",'"&PayCode&"','"&NowTimes&"')") '提交到动网官方主服务器 If Dvbbs.Forum_ChanSetting(5) <> "0" Then %> 正在提交数据,如果您的论坛地址设置了URL转发,将不能正确传输信息,请稍后……
    <% Else %> 正在提交数据,如果您的论坛地址设置了URL转发,将不能正确传输信息,请稍后……
    <% End If End Sub 'msg_id,order_no,gross,buyer_email,buyer_name,buyer_address,buyer_zipcode,buyer_tel,buyer_mobile,action,date 'pay.dvbbs.net/top.asp?msg_id=8b63d5ddb43677c2e2fda715aee35517&order_no=2005091115595084464&gross=1.00&buyer_email=xxx%40msn.com&buyer_name=xxx&buyer_address=dvbbs&buyer_zipcode=123456&buyer_tel=&buyer_mobile=&action=sendOff&date=20050911155809&ac=64bc1914702b5fa2897874a916df28fc 'md5(URLDecode("msg_id8b63d5ddb43677c2e2fda715aee35517order_no2005091115595084464gross1.00buyer_emaildvshatan%40msn.combuyer_name%CB%CE%BA%A3%B2%A8buyer_addressdvbbsbuyer_zipcode123456buyer_telbuyer_mobileactionsendOffdate20050911155809")&Dvbbs.Forum_ChanSetting(6),32) '在线支付返回结果处理,不登陆也可执行 Sub AliPay_Return() If Dvbbs.Forum_ChanSetting(5) <> "0" Then AliPay_Return_Old() Else Response.Clear Dim Rs,Order_No,EnCodeStr,UserInMoney Order_No = Dvbbs.CheckStr(Request("order_no")) Set Rs = Dvbbs.Execute("Select * From Dv_ChanOrders Where O_IsSuc=0 And O_PayCode = '"&Order_No&"'") If Rs.Eof And Rs.Bof Then Response.Write "N" Else EnCodeStr = "msg_id"&Request("msg_id")&"order_no"&Order_No&"gross"&FormatNumber(Rs("O_PayMoney"),2)&"buyer_email"&Request("buyer_email")&"buyer_name"&Request("buyer_name")&"buyer_address"&Request("buyer_address")&"buyer_zipcode"&Request("buyer_zipcode")&"buyer_tel"&Request("buyer_tel")&"buyer_mobile"&Request("buyer_mobile")&"action"&Request("action")&"date"&Request("date")&"" EnCodeStr = EnCodeStr & Dvbbs.Forum_ChanSetting(6) EnCodeStr = URLDecode(EnCodeStr) EnCodeStr = Md5(EnCodeStr,32) If EnCodeStr = Trim(Request("ac")) Then Response.Write "Y" '更新数据库资料 UserInMoney = Rs("O_PayMoney") '更新用户资料 Dvbbs.Execute("Update Dv_User Set UserTicket = UserTicket + " & Dvbbs.Forum_ChanSetting(14) * UserInMoney & " Where UserName='"&Rs("O_UserName")&"'") If Dvbbs.UserID > 0 And Lcase(Dvbbs.MemberName)=Lcase(Rs("O_UserName")) Then Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) + cCur(Dvbbs.Forum_ChanSetting(14) * UserInMoney) End If '更新订单状态 Dvbbs.Execute("Update Dv_ChanOrders Set O_IsSuc=1 Where O_ID = " & Rs("O_ID")) Else Response.Write "N" End If End If Response.End End If End Sub Sub AliPay_Return_Old() '得到和判断返回参数 Dim PayCode,SignStr,Success,UserInMoney PayCode = Replace(Request("paycode"),"'","") SignStr = Replace(Request("sign"),"'","") Success = Request("success") If PayCode = "" Or SignStr = "" Or Success = "" Or Not IsNumeric(Success) Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,非法的订单参数。&action=OtherErr" Exit Sub End If If Cint(Success) = 0 Then Response.redirect "showerr.asp?ErrCodes=
  • 订单支付失败,请详细检查您的支付信息,重新进入支付页面。&action=iOtherErr" Exit Sub End If '验证订单信息 Dim Rs Set Rs = Dvbbs.Execute("Select * From Dv_ChanOrders Where O_IsSuc=0 And O_PayCode = '"&PayCode&"'") If Rs.Eof And Rs.Bof Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,找不到该订单信息或该订单已支付成功。&action=OtherErr" Exit Sub Else '加密字符串验证 '重新生成加密字符串对照返回加密字符串 Dim PayCodeEnCode PayCodeEnCode = Md5(Rs("O_PayCode") & ":" & Success & ":" & Rs("O_PayMoney") & ":" & Dvbbs.Forum_ChanSetting(6),32) 'Response.Write SignStr 'Response.Write "
    " 'Response.Write PayCodeEncode 'response.end If PayCodeEncode <> SignStr Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,订单校验失败。如银行支付已成功,请到未成功订单中找到该订单并选择重新获取结果。&action=OtherErr" Exit Sub End If '更新数据库资料 UserInMoney = Rs("O_PayMoney") '更新用户资料 Dvbbs.Execute("Update Dv_User Set UserTicket = UserTicket + " & Dvbbs.Forum_ChanSetting(14) * UserInMoney & " Where UserName='"&Rs("O_UserName")&"'") If Dvbbs.UserID > 0 And Lcase(Dvbbs.MemberName)=Lcase(Rs("O_UserName")) Then Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) + cCur(Dvbbs.Forum_ChanSetting(14) * UserInMoney) End If '更新订单状态 Dvbbs.Execute("Update Dv_ChanOrders Set O_IsSuc=1 Where O_ID = " & Rs("O_ID")) End If Rs.Close Set Rs=Nothing %>
    论坛成功信息
    操作成功:

  • 成功,您本次兑换了 <%=(Dvbbs.Forum_ChanSetting(14) * UserInMoney)%> 张论坛点券。
  • << 返回用户控制面板   ||   去把点券转换成论坛金币>>

    <% End Sub '-------------------------------------------------------------------------------- '用户信息 '-------------------------------------------------------------------------------- Sub UserInfo() Dim Sql,Rs,UserToolsCount 'Sql = "Select Sum(ToolsCount) From [Dv_Plus_Tools_Buss] where UserID="& Dvbbs.UserID 'Set Rs = Dvbbs.Plus_Execute(Sql) 'UserToolsCount = Rs(0) 'If IsNull(UserToolsCount) Then UserToolsCount = 0 %>
    个人资料
    金币:<%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text %>
    点券:<%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text%>
    金钱:<%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text%>
    文章:<%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text%>
    经验:<%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text%>
    魅力:<%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text%>
    威望:<%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text%>
    <% End Sub '-------------------------------------------------------------------------------- '金币转换 '-------------------------------------------------------------------------------- Sub UserCenter() If Request("react") = "Savechange" Then If Not Dvbbs.ChkPost() Then Dvbbs.AddErrCode(16):Dvbbs.Showerr() Dim userWealth,userep,usercp,userticket,UpUserMoney Dim Sql,Rs userWealth = Dvbbs.CheckNumeric(Request.Form("userWealth")) userep = Dvbbs.CheckNumeric(Request.Form("userep")) usercp = Dvbbs.CheckNumeric(Request.Form("usercp")) userticket = Dvbbs.CheckNumeric(Request.Form("userticket")) UpUserMoney = 0 If userWealth<0 or userep<0 or usercp<0 or userticket<0 Then Dvbbs.AddErrCode(35):Dvbbs.Showerr() If userWealth>=1 and userWealth<=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text) and cCur(Dvbbs.Forum_setting(93))<>0 Then If Cint(userWealth / cCur(Dvbbs.Forum_setting(93))) > 0 Then UpUserMoney = UpUserMoney + Cint(userWealth / cCur(Dvbbs.Forum_setting(93))) userWealth = Cint(userWealth / cCur(Dvbbs.Forum_setting(93))) * cCur(Dvbbs.Forum_setting(93)) Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text = cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text) - userWealth Else userWealth = 0 End If Else userWealth = 0 End If If userep>=1 and userep<=cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text) and cCur(Dvbbs.Forum_setting(94))<>0 Then If Cint(userep / cCur(Dvbbs.Forum_setting(94))) > 0 Then UpUserMoney = UpUserMoney + Cint(userep / cCur(Dvbbs.Forum_setting(94))) userep = Cint(userep / cCur(Dvbbs.Forum_setting(94))) * cCur(Dvbbs.Forum_setting(94)) Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text = cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text) - userep Else userep = 0 End If Else userep = 0 End If If usercp>=1 and usercp<=cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text) and cCur(Dvbbs.Forum_setting(95))<>0 Then If Cint(usercp / cCur(Dvbbs.Forum_setting(95))) > 0 Then UpUserMoney = UpUserMoney + Cint(usercp / cCur(Dvbbs.Forum_setting(95))) usercp = Cint(usercp / cCur(Dvbbs.Forum_setting(95))) * cCur(Dvbbs.Forum_setting(95)) Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text = cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text) - usercp Else usercp = 0 End If Else usercp = 0 End If If userticket>=1 and userticket<=cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) and Dvbbs.Forum_setting(96) <> 0 Then Userticket = Clng(Userticket) If Cint(userticket / Dvbbs.Forum_setting(96)) > 0 Then UpUserMoney = UpUserMoney + Cint(userticket / Dvbbs.Forum_setting(96)) userticket = Cint(userticket / Dvbbs.Forum_setting(96)) * Dvbbs.Forum_setting(96) Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text = cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) - userticket Else userticket = 0 End If Else userticket = 0 End If If UpUserMoney < 1 Then Response.redirect "showerr.asp?ErrCodes=
  • 请填写转换的数据或获得的金币数太少!&action=OtherErr" Else Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text = cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text ) + UpUserMoney Sql = "Update Dv_user set userWealth = "&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text&",userEP="&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text&",userCP="&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text&",UserMoney="&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &",UserTicket="&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text&" where UserID="&Dvbbs.UserID Dvbbs.Execute(Sql) Dim LogMsg LogMsg = "金币转换成功,获得总金币数为"&UpUserMoney&",金钱减少"&userWealth&",经验减少"&userep&",魅力减少"&usercp&",点券减少"&userticket&"。" 'Call Dvbbs.ToolsLog(0,0,0,0,0,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) Dvbbs.Dvbbs_Suc(LogMsg) End If Else %>
    论坛金币转换
  • 允许用户将金钱、经验、魅力、点券转换成金币。
  • 金币转换汇率 转换项目 转换信息 转换设置 转换所得金币
        前往购买论坛点券
        1 金币 = <%=Dvbbs.Forum_setting(93)%> 金钱
        1 金币 = <%=Dvbbs.Forum_setting(94)%> 经验
        1 金币 = <%=Dvbbs.Forum_setting(95)%> 魅力
        1 金币 = <%=Dvbbs.Forum_setting(96)%> 点券
    拥有金钱值: <%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text%> )"> 0
    拥有经验值: <%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text%> )"> 0
    拥有魅力值: <%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text%> )"> 0
    拥有点券值: <%=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text%> )"> 0
      
    <% End If End Sub '用户订单列表 Sub PayList() Dim Success Success = Dvbbs.CheckNumeric(Request("Suc")) Dim Page,MaxRows,Endpage,CountNum,PageSearch,SqlString PageSearch = "action=PayList&Suc=" & Success Endpage = 0 MaxRows = 20 Page = Request("Page") If IsNumeric(Page) = 0 or Page="" Then Page=1 Page = Clng(Page) Response.Write "" MainReadMe(1) %>
    <% Dim i Set Rs = server.CreateObject ("adodb.recordset") If Not IsObject(Conn) Then ConnectionDatabase Rs.Open Sql,Conn,1,1 If Rs.Eof And Rs.Bof Then Response.Write "" Response.Write "
    <% Dim Rs,Sql Select Case Success Case 0 Response.Write Dvbbs.MemberName & " 的所有论坛网络支付或短信点播交易订单" Sql = "Select O_Type,O_PayCode,O_PayMoney,O_IsSuc,O_AddTime,O_ID From Dv_ChanOrders Where O_UserName = '"&Dvbbs.MemberName&"' Order By O_AddTime Desc" Case 1 Response.Write Dvbbs.MemberName & " 的所有论坛网络支付或短信点播交易成功订单" Sql = "Select O_Type,O_PayCode,O_PayMoney,O_IsSuc,O_AddTime,O_ID From Dv_ChanOrders Where O_IsSuc = 1 And O_UserName = '"&Dvbbs.MemberName&"' Order By O_AddTime Desc" Case 2 Response.Write Dvbbs.MemberName & " 的所有论坛网络支付或短信点播交易失败订单" Sql = "Select O_Type,O_PayCode,O_PayMoney,O_IsSuc,O_AddTime,O_ID From Dv_ChanOrders Where O_IsSuc = 0 And O_UserName = '"&Dvbbs.MemberName&"' Order By O_AddTime Desc" End Select %>
    订单类型 订单号 支付金额 交易状态 交易时间 操作
    当前还没有订单。
    " Else CountNum = Rs.RecordCount If CountNum Mod MaxRows=0 Then Endpage = CountNum \ MaxRows Else Endpage = CountNum \ MaxRows+1 End If Rs.MoveFirst If Page > Endpage Then Page = Endpage If Page < 1 Then Page = 1 If Page >1 Then Rs.Move (Page-1) * MaxRows End if SQL=Rs.GetRows(MaxRows) 'O_Type,O_PayCode,O_PayMoney,O_IsSuc,O_AddTime,O_ID For i=0 To Ubound(SQL,2) %> <% Select Case SQL(0,i) Case 1 Response.Write "网络支付" Case 2 Response.Write "短信点播" Case Else Response.Write "未知" End Select %> <%=SQL(1,i)%> <%=SQL(2,i)%> <% Select Case SQL(3,i) Case 0 Response.Write "失败" Case 1 Response.Write "成功" Case Else Response.Write "未知" End Select %> <%=SQL(4,i)%>   <% Next Response.Write "" PageSearch=Replace(Replace(PageSearch,"\","\\"),"""","\""") Response.Write "" End If Rs.Close Set Rs=Nothing End Sub '重新获得交易状态 Sub AliPay_1() Dim ID,Rs Dim PayMoney,PayCode ID = Request("ID") If ID = "" Or Not IsNumeric(ID) Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,非法的订单参数。&action=OtherErr" Exit Sub Else ID = cCur(ID) End If Set Rs = Dvbbs.Execute("Select * From Dv_ChanOrders Where O_ID = "&ID&" And O_UserName = '"&Dvbbs.MemberName&"'") If Rs.Eof And Rs.Bof Then Response.redirect "showerr.asp?ErrCodes=
  • 错误,找不到相关的订单信息。&action=OtherErr" Exit Sub Else PayMoney = Rs("O_PayMoney") PayMoney = FormatNumber(PayMoney,2) PayCode = Rs("O_PayCode") End If Rs.Close Set Rs=Nothing '提交到动网官方主服务器 %> 正在提交数据,如果您的论坛地址设置了URL转发,将不能正确传输信息,请稍后……
    <% End Sub Sub UserToolsLog_List() Dim Rs,Sql,i,LogType Dim Page,MaxRows,Endpage,CountNum,PageSearch,SqlString LogType = "未知|使用|转让|充值|购买|奖励|VIP交易" LogType = Split(LogType,"|") PageSearch = "action=UserToolsLog_List" Endpage = 0 MaxRows = 20 Page = Request("Page") If IsNumeric(Page) = 0 or Page="" Then Page=1 Page = Clng(Page) Response.Write "" If Request.QueryString("UserID")<>"" and IsNumeric(Request.QueryString("UserID")) Then _ SqlString = "and UserID="&Dvbbs.CheckNumeric(Request.QueryString("UserID")) MainReadMe(1) %>
    <% Dim ToolsNames Dvbbs.forum_setting(90)=0 If Dvbbs.forum_setting(90)="1" Then Set Rs = Dvbbs.Plus_Execute("Select ID,ToolsName From Dv_Plus_Tools_Info Order By ID") If Not (Rs.Eof And Rs.Bof) Then Sql = Rs.GetRows(-1) End If Rs.Close Set ToolsNames = Server.Createobject("Scripting.Dictionary") For i=0 to Ubound(Sql,2) ToolsNames.add Sql(0,i),Sql(1,i) Next ToolsNames.add -88,"魔法表情或头像" '添加道具名魔法表情或头像,ID为-88 End If 'T.ToolsName=0,L.CountNum=1,L.Log_Money=2,L.Log_Ticket=3,L.Log_IP=4,L.Log_Time=5,L.Log_Type=6,L.Conect=7 Sql = "Select ToolsID,CountNum,Log_Money,Log_Ticket,Log_IP,Log_Time,Log_Type,Conect From Dv_MoneyLog Where AddUserID="&Dvbbs.UserID&" And Not BoardID=-1 Order By Log_Time Desc" 'Response.Write Sql Set Rs = server.CreateObject ("adodb.recordset") If Cint(Dvbbs.Forum_Setting(92))=1 Then If Not IsObject(Plus_Conn) Then Plus_ConnectionDatabase Rs.Open Sql,Plus_Conn,1,1 Else If Not IsObject(Conn) Then ConnectionDatabase Rs.Open Sql,conn,1,1 End If If Not (Rs.Eof And Rs.Bof) Then CountNum = Rs.RecordCount If CountNum Mod MaxRows=0 Then Endpage = CountNum \ MaxRows Else Endpage = CountNum \ MaxRows+1 End If Rs.MoveFirst If Page > Endpage Then Page = Endpage If Page < 1 Then Page = 1 If Page >1 Then Rs.Move (Page-1) * MaxRows End if SQL=Rs.GetRows(MaxRows) Else Response.Write "
    道具名称 操作 操作内容 金币 点券 数量 使用IP 时间
    道具还未添加!
    " Exit Sub End If Rs.close:Set Rs = Nothing '输出道具列表 For i=0 To Ubound(SQL,2) %> <% If Dvbbs.forum_setting(90)="1" Then Response.Write ToolsNames(SQL(0,i)) Else Response.Write "未知" End If %> <%=LogType(SQL(6,i))%> <%=SQL(7,i)%> <%=SQL(2,i)%> <%=SQL(3,i)%> <%=SQL(1,i)%> <%=SQL(4,i)%> <%=SQL(5,i)%> <% Next Set ToolsNames = Nothing Response.Write "" PageSearch=Replace(Replace(PageSearch,"\","\\"),"""","\""") Response.Write "" End Sub Sub MainReadMe(str) %> <% If Str = 1 Then Response.Write "
    购买论坛点券
    所有交易记录 | 已成功订单 | 未成功订单 | 金币或点券使用记录 | 兑换论坛金币 | 购买论坛点券
    说明
    ① 通过网络支付或手机点播论坛短信资讯可获奖励相应的论坛点券
    ② 每通过网络支付或点播手机短信 1 元可获奖励 <%=Dvbbs.Forum_ChanSetting(14)%> 张论坛点券
    ③ 论坛点券的作用:可购买论坛中各种趣味道具,享受更多有趣的论坛功能
    ④ 点券的获取流程:根据下面提示选择网络支付或手机点播短信后,通过网络支付成功的将会直接对您论坛账号奖励相应的点券
        通过手机点播您的手机会收到您点播的短信资讯和对应奖励的论坛点券序列号,收到序列号后,返回此页面在相应的位置输入,当系统确认后您就可以获取相应的论坛点券
    " End Sub Function URLDecode(enStr) dim deStr dim c,i,v deStr="" for i=1 to len(enStr) c=Mid(enStr,i,1) if c="%" then v=eval("&h"+Mid(enStr,i+1,2)) if v<128 then deStr=deStr&chr(v) i=i+2 else if isvalidhex(mid(enstr,i,3)) then if isvalidhex(mid(enstr,i+3,3)) then v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2)) deStr=deStr&chr(v) i=i+5 else v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1))))) deStr=deStr&chr(v) i=i+3 end if else destr=destr&c end if end if else if c="+" then deStr=deStr&" " else deStr=deStr&c end if end if next URLDecode=deStr End Function function isvalidhex(str) dim c isvalidhex=true str=ucase(str) if len(str)<>3 then isvalidhex=false:exit function if left(str,1)<>"%" then isvalidhex=false:exit function c=mid(str,2,1) if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function c=mid(str,3,1) if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function end function %>