⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 userpay.asp

📁 公司企业网站管理系统全站源码,用于企业内部对网站的管理
💻 ASP
📖 第 1 页 / 共 3 页
字号:
	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>&nbsp;
	</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 + -