buypost.asp

现在好了

<!-- #include file="conn.asp" -->
<!-- #include file="inc/const.asp" -->
<!--#include file="inc/dv_clsother.asp"-->
<%
	Dvbbs.LoadTemplates("dispbbs")
	Dim Rootid,PostTable,Action,RootID_a
	Dim AnnounceID,Rs,SQL,i
	Action = Request("action")
	PostTable=Request("PostTable")
	PostTable=Checktable(PostTable)
	Rootid=Request("ID")
	RootID_a=Request("rootid")
	AnnounceID=Request("ReplyID")
	Select Case Action
		Case "view" : Dvbbs.stats="查看购买贴子的用户"
		Case "buy" : Dvbbs.stats="金币购买帖子"
		Case "Send" : Dvbbs.stats="赠送金币"
		Case "Close" : Dvbbs.stats="结帖操作"
		Case Else
		Dvbbs.stats="购买帖子"
	End Select
	Dvbbs.Nav
	Dvbbs.Head_var 1,Dvbbs.BoardNode.attributes.getNamedItem("depth").text,"",""
	If Rootid="" Or Not IsNumeric(Rootid) Then Dvbbs.AddErrCode(35)
	If AnnounceID="" or Not IsNumeric(AnnounceID) Then Dvbbs.AddErrCode(35)
	If Dvbbs.UserID=0 Then Dvbbs.AddErrCode(6)
	Dvbbs.ShowErr()
	Select Case Action
		Case "view" : view()
		Case "buy" : Buy()
		Case "Send" : SendMoney()
		Case "Close" : Close()
		Case Else
		main()
	End Select
	Dvbbs.ShowErr()
	Dvbbs.Activeonline()
	Dvbbs.Footer

	'结帖操作
	Sub Close()
		Dim PostBuyUser,ToUserName,PostUserID,GetMoney,Topic,TopAnnounceID,LogMsg
		Dim TempStr
		Sql = "Select Top 1 PostBuyUser,GetMoney,Topic,AnnounceID From "&PostTable&" where RootID="&Rootid&" and ParentID=0 and GetMoneyType=1 and PostUserID="&Dvbbs.UserID
		Set Rs=Dvbbs.Execute(Sql)
		If Rs.eof and Rs.bof Then
			Dvbbs.AddErrCode(32)
			Exit Sub
		Else
			PostBuyUser = Rs(0)
			GetMoney = Rs(1)
			Topic = Rs(2)
			TopAnnounceID = Rs(3)
		End If
		Rs.Close
		TempStr = Split(PostBuyUser,"|||",2)
		TempStr(0) = cCur(TempStr(0))
		If Request.Form("ReAct")="SaveClose" Then
			Dim SendMoney
			If Not Dvbbs.ChkPost Then
				Dvbbs.AddErrCode(16)
				Exit Sub
			End If
			SendMoney = GetMoney-TempStr(0)
			If SendMoney<0 Then SendMoney = 0
			'更新用户，返还金币
			If SendMoney>0 Then
				Dvbbs.Execute("update [Dv_user] set UserMoney=UserMoney+"&SendMoney&" where userid="&Dvbbs.UserID)
				Dvbbs.MyUserInfo(37) = cCur(Dvbbs.MyUserInfo(37))+SendMoney	'用户金币数量
				Session(Dvbbs.CacheName & "UserID") = Dvbbs.MyUserInfo
			End If
			'更新帖子类型
			Dvbbs.Execute("update Dv_Topic set GetMoneyType=5 where TopicID="&Rootid)
			Dvbbs.Execute("update "&PostTable&" set GetMoneyType=5 where AnnounceID="&TopAnnounceID)

			LogMsg = "<b>结帖操作</b>：赠送金币帖主题《<a href=""Dispbbs.asp?boardid="&Dvbbs.BoardID&"&id="&Rootid&""" target=_blank><b>"&Topic&"</b></a>》结帖成功，还返金币数为：<b>"&SendMoney&"</b>"
			Dim Dv_LogMsg
			Dv_LogMsg = "结帖操作：赠送金币帖主题《"&Topic&"》结帖成功，还返金币数为："&SendMoney
			Dvbbs.Execute("Insert Into Dv_Log (l_AnnounceID,l_BoardID,l_touser,l_username,l_content,l_ip,l_type) values (" & Rootid & "," & Dvbbs.BoardID & ",'" & Dvbbs.MemberName & "','" & Dvbbs.MemberName & "','" & Dvbbs.CheckStr(Dv_LogMsg) & "','" & Dvbbs.UserTrueIP & "',5)")
			Dvbbs.Dvbbs_Suc(LogMsg)
		Else
	%>
	<FORM METHOD=POST ACTION="buypost.asp?action=Close">
	<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
	<tr><th colspan=2>《 <%=Topic%> 》 赠送金币结帖操作</th></tr>
	<tr>
	<td class=tablebody1 colspan=2><li>执行结帖后，帖子关闭，不允许其他会员回复。</td>
	</tr>
	<tr>
	<td class=tablebody2 align=right width="30%">赠送金币总数：</td>
	<td class=tablebody1 width="70%"><%=GetMoney%></td>
	</tr>
	<tr>
	<td class=tablebody2 align=right>已送出金币总数：</td>
	<td class=tablebody1><%=TempStr(0)%></td>
	</tr>
	<tr>
	<td class=tablebody2 align=right>返还用户金币数：</td>
	<td class=tablebody1><%=GetMoney-TempStr(0)%></td>
	</tr>
	<tr><td class=tablebody2 colspan=2 align=center>
	<INPUT TYPE="submit" value="确定结帖"> <INPUT TYPE="button" value="取消" onclick="history.go(-1)">
	</td></tr>
	<INPUT TYPE="hidden" NAME="react" value="SaveClose">
	<INPUT TYPE="hidden" NAME="PostTable" value="<%=PostTable%>">
	<INPUT TYPE="hidden" NAME="ID" value="<%=Rootid%>">
	<INPUT TYPE="hidden" NAME="ReplyID" value="<%=AnnounceID%>">
	<INPUT TYPE="hidden" NAME="BoardID" value="<%=Dvbbs.BoardID%>">
	</table>
	<%
		End If
	End Sub

	'赠送金币帖
	Sub SendMoney()
		Dim PostBuyUser,ToUserName,PostUserID,GetMoney,Topic,TopAnnounceID,LogMsg
		Dim TempStr,IsSendUser
		Sql = "Select Top 1 PostBuyUser,GetMoney,Topic,AnnounceID From "&PostTable&" where RootID="&Rootid&" and ParentID=0 and GetMoneyType=1 and PostUserID="&Dvbbs.UserID
		Set Rs=Dvbbs.Execute(Sql)
		If Rs.eof and Rs.bof Then
			Dvbbs.AddErrCode(32)
			Exit Sub
		Else
			PostBuyUser = Rs(0)
			GetMoney = Rs(1)
			Topic = Rs(2)
			TopAnnounceID = Rs(3) 
		End If
		Rs.Close
		ToUserName = Request("UserName")
		TempStr = Split(PostBuyUser,"|||",2)
		TempStr(0) = cCur(TempStr(0))
		If Instr(PostBuyUser,"|||"&ToUserName&",")>0 Then
			IsSendUser = "<font class=Redfont>[已赠送]</font>"
		Else
			IsSendUser = "<font color=gray>[未赠送]</font>"
		End If
		If Request.Form("ReAct")="SaveMoney" Then
			If Not Dvbbs.ChkPost Then
				Dvbbs.AddErrCode(16)
				Exit Sub
			End If
			Dim SendMoney
			SendMoney = Request.Form("SendMoney")
			If Not Isnumeric(SendMoney) Then 
				Dvbbs.AddErrCode(35)
				Exit Sub
			Else
				SendMoney = cCur(SendMoney)
			End If
			If TempStr(0) < 0 Then Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>赠送的金币数太少或已超出了剩余金币数。&action=OtherErr"
			TempStr(0) = TempStr(0)+SendMoney

			If SendMoney<1 or TempStr(0)>GetMoney  Then
				Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>赠送的金币数太少或已超出了剩余金币数。&action=OtherErr"
				Exit Sub
			End If

			'读取回复用户信息，更新GetMoney数值
			Sql = "Select username,PostUserID,GetMoney From "&PostTable&" where AnnounceID="&AnnounceID
			Dvbbs.SqlQueryNum=Dvbbs.SqlQueryNum+1
			set Rs=server.createobject("adodb.recordset")
			Rs.open sql,conn,1,3
			If Rs.eof and Rs.bof Then
				Dvbbs.AddErrCode(32)
				Dvbbs.ShowErr()
			Else
				ToUserName = Rs(0)
				PostUserID = Rs(1)
				If PostUserID=Dvbbs.UserID Then
					Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>赠送金币帖不能对自已赠送金币。&action=OtherErr"
					Exit Sub
				End If
				Rs(2) = Rs(2)+SendMoney
				Rs.Update
			End If
			Rs.close
			TempStr(1) = TempStr(1) & "|||" &ToUserName&","&SendMoney
			PostBuyUser = TempStr(0) & "|||" & TempStr(1)
			'更新目标用户，增加金币
			Dvbbs.Execute("update [Dv_user] set UserMoney=UserMoney+"&SendMoney&" where userid="&PostUserID)
			'更新分表中主题行PostBuyUser数据
			Dvbbs.Execute("update "&PostTable&" set PostBuyUser = '"&PostBuyUser&"' where AnnounceID="&TopAnnounceID)
			LogMsg = "关于回复主题《<a href=""Dispbbs.asp?BoardID="&Dvbbs.BoardID&"&ID="&Rootid&"&ReplyID="&Announceid&"&Skin=1"" target=_blank><b>"&Topic&"</b></a>》的帖子赠送金币成功，<b>"&ToUserName&"</b>获得金币数为：<b>"&SendMoney&"</b>，剩余赠送金币数为：<b>"& GetMoney-TempStr(0) &"</b>。"
			Dvbbs.Dvbbs_Suc(LogMsg)
		Else
	%>
	<FORM METHOD=POST ACTION="buypost.asp?action=Send">
	<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
	<tr><th colspan=2>《 <%=Topic%> 》 赠送金币操作</th></tr>
	<tr>
	<td class=tablebody1 align=right width="30%">赠送金币总数：</td>
	<td class=tablebody1 width="70%"><%=GetMoney%></td>
	</tr>
	<tr>
	<td class=tablebody1 align=right>已送出金币总数：</td>
	<td class=tablebody1><%=TempStr(0)%></td>
	</tr>