📄 userpay.asp
字号:
Page = Clng(Page)
Response.Write "<script language=""JavaScript"" src=""inc/Pagination.js""></script>"
MainReadMe(1)
%>
</td>
</tr>
<tr><td colspan=3><hr style="BORDER: #807d76 1px dotted;height:1px;">
<table border="0" cellpadding=3 cellspacing=1 align=center class=Tableborder1>
<tr><td height=23 class=Tablebody2 colspan=6 style="line-height: 18px">
<%
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
%>
</td></tr>
<tr>
<th height=23 width="15%">订单类型</th>
<th width="20%">订单号</th>
<th width="15%">支付金额</th>
<th width="15%">交易状态</th>
<th width="15%">交易时间</th>
<th width="20%">操作</th>
</tr>
<%
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 "<tr><td height=23 class=Tablebody1 colspan=6>当前还没有订单。</td></tr>"
Response.Write "</table>"
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)
%>
<tr align=center>
<td height=23 class=Tablebody1>
<%
Select Case SQL(0,i)
Case 1
Response.Write "网络支付"
Case Else
Response.Write "<font color=gray>未知</font>"
End Select
%>
</td>
<td class=Tablebody1><%=SQL(1,i)%></td>
<td class=Tablebody1><%=SQL(2,i)%></td>
<td class=Tablebody1>
<%
Select Case SQL(3,i)
Case 0
Response.Write "<font color=gray>失败</font>"
Case 1
Response.Write "成功"
Case Else
Response.Write "<font color=gray>未知</font>"
End Select
%>
</td>
<td class=Tablebody1><%=SQL(4,i)%></td>
<td class=Tablebody1>
</td>
</tr>
<%
Next
Response.Write "</table>"
PageSearch=Replace(Replace(PageSearch,"\","\\"),"""","\""")
Response.Write "<SCRIPT>PageList("&Page&",3,"&MaxRows&","&CountNum&","""&PageSearch&""",1);</SCRIPT>"
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=<li>错误,非法的订单参数。&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=<li>错误,找不到相关的订单信息。&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转发,将不能正确传输信息,请稍后……
<form name="redir" action="<%=Dvbbs_Server_Url%>alipay_t1.aspx?action=pay_1" method="post">
<INPUT type=hidden name="username" value="<%=Dvbbs.MemberName%>">
<INPUT type=hidden name="paycode" value="<%=PayCode%>">
<INPUT type=hidden name="returnurl" value="<%=Dvbbs.Get_ScriptNameUrl%>UserPay.asp?action=alipay_return">
<INPUT type=hidden name="paymoney" value="<%=PayMoney%>">
</form>
<script LANGUAGE=javascript>
<!--
redir.submit();
//-->
</script>
<%
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 "<script language=""JavaScript"" src=""inc/Pagination.js""></script>"
If Request.QueryString("UserID")<>"" and IsNumeric(Request.QueryString("UserID")) Then _
SqlString = "and UserID="&Dvbbs.CheckNumeric(Request.QueryString("UserID"))
MainReadMe(1)
%>
</td>
</tr>
<tr><td colspan=3><hr style="BORDER: #807d76 1px dotted;height:1px;">
<table border="0" cellpadding=3 cellspacing=1 align=center class=Tableborder1 Style="Width:98%">
<tr>
<th height=23 width="15%">道具名称</th>
<th width="10%">操作</th>
<th width="*%">操作内容</th>
<th width="5%">金币</th>
<th width="5%">点券</th>
<th width="5%">数量</th>
<th width="13%">使用IP</th>
<th width="12%">时间</th>
</tr>
<%
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 "<tr><td class=""Tablebody1"" colspan=""8"" align=center>道具还未添加!</td></tr></table>"
Exit Sub
End If
Rs.close:Set Rs = Nothing
'输出道具列表
For i=0 To Ubound(SQL,2)
%>
<tr>
<td class="Tablebody1" align=center height=24>
<%
If Dvbbs.forum_setting(90)="1" Then
Response.Write ToolsNames(SQL(0,i))
Else
Response.Write "<font color=gray>未知</font>"
End If
%>
</td>
<td class="Tablebody1" align=center><%=LogType(SQL(6,i))%></td>
<td class="Tablebody1"><%=SQL(7,i)%></td>
<td class="Tablebody1" align=center><%=SQL(2,i)%></td>
<td class="Tablebody1" align=center><%=SQL(3,i)%></td>
<td class="Tablebody1" align=center><%=SQL(1,i)%></td>
<td class="Tablebody1" align=center><%=SQL(4,i)%></td>
<td class="Tablebody1" align=center><%=SQL(5,i)%></td>
</tr>
<%
Next
Set ToolsNames = Nothing
Response.Write "</table>"
PageSearch=Replace(Replace(PageSearch,"\","\\"),"""","\""")
Response.Write "<SCRIPT>PageList("&Page&",3,"&MaxRows&","&CountNum&","""&PageSearch&""",1);</SCRIPT>"
End Sub
Sub MainReadMe(str)
%>
<table border="0" cellpadding=3 cellspacing=1 align=center class=Tableborder1 Style="Width:98%">
<tr>
<th height=23>购买论坛点券</th></tr>
<tr><td height=24 class=Tablebody2 align=center><a href="?action=PayList">所有交易记录</a> | <a href="?action=PayList&Suc=1">已成功订单</a> | <a href="?action=PayList&Suc=2">未成功订单</a> | <a href="?action=UserToolsLog_List">金币或点券使用记录</a> | <a href="?action=UserCenter"><font color=red>兑换论坛金币</font></a> | <a href="UserPay.asp"><font color=red>购买论坛点券</font></a></td>
</tr>
<tr><td height=23 class=Tablebody1 style="line-height: 18px"><B>说明</B>:<BR>
① 通过网络支付可获<font color=red>奖励</font>相应的论坛点券<BR>
② 每通过网络支付 <font color=red><B>1</B></font> 元可获奖励 <font color=red><B><%=Dvbbs.Forum_ChanSetting(14)%></B></font> 张论坛点券<BR>
③ 论坛点券的作用:可购买论坛中各种趣味道具,享受更多有趣的论坛功能<BR>
④ 点券的获取流程:根据下面提示选择网络支付后,通过网络支付成功的将会直接对您论坛账号奖励相应的点券<BR>
</td>
</tr>
<%
If Str = 1 Then Response.Write "</table>"
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
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -