buypost.asp

现在好了

	<tr>
	<td class=tablebody1 align=right>赠送目标用户：</td>
	<td class=tablebody1><%=Server.HtmlEncode(ToUserName)%> <%=IsSendUser%></td>
	</tr>
	<tr>
	<td class=tablebody1 align=right>设置送出金币个数：</td>
	<td class=tablebody1><INPUT TYPE="text" NAME="SendMoney" value=""> 剩余<b><font class="Redfont"><%=(GetMoney-TempStr(0))%></font></b>金币。</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="SaveMoney">
	<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 Buy()
		Dim PostBuyUser,ToUserName,PostUserID,GetMoney,GetMoneyType,IsUpdate,LogMsg,Topic,TempStr
		IsUpdate = False
		Sql = "Select PostBuyUser,username,PostUserID,GetMoney,GetMoneyType,Topic From "&PostTable&" where RootID="&Rootid&" and ParentID=0 and GetMoneyType=3"
		If Not IsObject(Conn) Then ConnectionDatabase
		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
			PostBuyUser = Rs(0)
			ToUserName = Rs(1)
			PostUserID = Rs(2)
			GetMoney = Rs(3)
			GetMoneyType = Rs(4)
			Topic = Rs(5)
			If Not IsNumeric(GetMoney) Then GetMoney=0
			If GetMoney < 0 Then Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>错误的金币数目。&action=OtherErr"
			Dvbbs.MyUserInfo(37) = cCur(Dvbbs.MyUserInfo(37))	'用户金币数量
			If Instr(PostBuyUser,"|||$PayMoney|||") AND Dvbbs.UserID<>PostUserID AND GetMoney<>0 and InStr(PostBuyUser,"|||"&Dvbbs.Membername&"|||")=0 Then
				TempStr = Split(Rs(0),"|||",2)
				Dim BuyMoneyInfo
				BuyMoneyInfo = Split(TempStr(0),"@@@")
				BuyMoneyInfo(1) = cCur(BuyMoneyInfo(1))
				BuyMoneyInfo(2) = Clng(BuyMoneyInfo(2))
				'购买数量限制(设置为“-1”则不限制)
				If BuyMoneyInfo(1)=0 Then
					Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>本帖子已售完。&action=OtherErr"
					Exit Sub
				ElseIf BuyMoneyInfo(1)>0 Then
					BuyMoneyInfo(1) = BuyMoneyInfo(1) - 1 
				End If
				'当VIP不需要付费时将GetMoney清为0
				'If BuyMoneyInfo(2)=0 and Dvbbs.VipGroupUser Then
					'GetMoney = 0
				'End If
				'可购买用户名单限制(每个用户名用英文逗号“,”分隔符分开，注意区分大小写)
				If BuyMoneyInfo(3)<>"" Then
					If Instr(","&BuyMoneyInfo(3)&",",","&Dvbbs.Membername&",")=0 Then
						Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>购买失败，非作者指定的用户不能购买该帖。&action=OtherErr"
						Exit Sub
					End If
				End If
				If GetMoney>Dvbbs.MyUserInfo(37) Then 
					Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>你的用户金币不足，购买该帖失败。&action=OtherErr"
					Exit Sub
				End If
				BuyMoneyInfo(0) = cCur(BuyMoneyInfo(0)) + GetMoney '*ToolsSetting(4)
				TempStr(0) = BuyMoneyInfo(0) & "@@@" & BuyMoneyInfo(1) & "@@@" & BuyMoneyInfo(2) & "@@@" & BuyMoneyInfo(3)
				Rs(0) = TempStr(0) & "|||" & TempStr(1) & Dvbbs.Membername & "|||"
				Rs.Update

				Dvbbs.MyUserInfo(37) = Dvbbs.MyUserInfo(37)-GetMoney
				Dvbbs.Execute("update [Dv_user] set UserMoney="&Dvbbs.MyUserInfo(37)&" where userid="&Dvbbs.userid)
				Dvbbs.Execute("update [Dv_user] set UserMoney=UserMoney+"&GetMoney&" where userid="&PostUserID)
				IsUpdate = True
			Else
				Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>你不能重复购买或者不能购买自已的金币帖子。&action=OtherErr"
				Exit Sub
			End If
		End If
		Rs.Close : Set Rs=Nothing
		If IsUpdate Then
			LogMsg = "购买金币帖《<a href=""Dispbbs.asp?boardid="&Dvbbs.BoardID&"&id="&Rootid&""" target=_blank><b>"&Topic&"</b></a>》成功，支付金币数为：<b>"&GetMoney&"</b>，<b>"&ToUserName&"</b>得到金币为："&GetMoney
			Session(Dvbbs.CacheName & "UserID")=Dvbbs.MyUserInfo
			Dvbbs.Dvbbs_Suc(LogMsg)
		End If
	End Sub

	Sub Main()
		dim re
		dim po,ii
		dim reContent
		dim strContent
		dim PostBuyUser
		po=0
		ii=0
		dim usermoney
		If Rootid_a="" Or Not IsNumeric(Rootid_a) Then Dvbbs.AddErrCode(35)
		set rs=Dvbbs.Execute("select userWealth from [Dv_user] where userid="&Dvbbs.Userid)
		usermoney=rs(0)
		Dvbbs.SqlQueryNum=Dvbbs.SqlQueryNum+1
		set rs=server.createobject("adodb.recordset")
		sql="select body,PostBuyUser,username,PostUserID,GetMoneyType From "&PostTable&" where Announceid="&Announceid
		rs.open sql,conn,1,3
		If rs.eof and rs.bof Then
			Dvbbs.AddErrCode(32)
			Dvbbs.ShowErr()
		Else
			If rs(4)>0 Then
				Response.redirect "showerr.asp?ErrCodes=<Br>"+"<li>由于帖子使用了特殊类型，所以不能采用金钱购买帖。&action=OtherErr"
				Exit Sub
			End If
			strContent=Dvbbs.HTMLEncode(rs(0))
			PostBuyUser=Trim(rs(1))
			'Response.Write PostBuyUser
			'Response.End
			Set re=new RegExp
			re.IgnoreCase =true
			re.Global=True
			re.Pattern="(^.*)(\[UseMoney=*([0-9]*)\])(.*)(\[\/UseMoney\])(.*)"
			po=re.Replace(strContent,"$3")
			If IsNumeric(po) Then 
				ii=int(po) 
			Else
				ii=0
			End If
			Set re=Nothing
					
			If Dvbbs.membername=rs(2) Then
				response.write "<script>alert('呵呵，您要花钱购买自己发布的帖子吗？');</script>"
			ElseIf  usermoney >ii then
				If (not isnull(PostBuyUser)) Or  PostBuyUser<>"" Then
					If InStr("|"&PostBuyUser&"|","|"&Dvbbs.membername&"|")>0 Then
						response.write "<script>alert('呵呵，您已经购买过了呀？');</script>"
					Else
						Dvbbs.Execute("update [Dv_user] set userWealth=userWealth-"&ii&" where userid="&Dvbbs.userid)
						Dvbbs.Execute("update [Dv_user] set userWealth=userWealth+"&ii&" where userid="&rs(3))
						If IsNull(Rs(1)) or  Rs(1)="" Then 
							rs(1)=Dvbbs.membername
						Else
							rs(1)=rs(1) & "|" & Dvbbs.membername
						End If
						Rs.Update 
						response.write "<script>alert('购买成功！');</script>"
					End If
				Else 
					Dvbbs.Execute("update [Dv_user] set userWealth=userWealth-"&ii&" where userid="&Dvbbs.userid)
					Dvbbs.Execute("update [Dv_user] set userWealth=userWealth+"&ii&" where userid="&rs(3))
					rs(1)=Dvbbs.membername
					Rs.Update
					response.write "<script>alert('购买成功！');</script>"
				End If
			Else
				response.write "<script>alert('您都没有钱呀？');</script>"
			End If
			
		End If
		Rs.Close 
		Set  Rs=Nothing
		Response.Write "<script language=""javascript"">"
		Response.Write "parent.location.href='"
		Response.Write "dispbbs.asp?boardid="&request("boardid")&"&ID="&RootID_a&"&replyID="&AnnounceID&"&star=1&skin=1#"&AnnounceID
		Response.Write "';"
		Response.Write "</script>"
	End Sub
	Sub view()
		Dim PostBuyUser
		sql="select PostBuyUser from "&PostTable&" where Announceid="&Announceid
		Set rs=Dvbbs.Execute(sql)
		PostBuyUser=Trim(rs(0))
		Response.Write "<table cellpadding=3 cellspacing=1 align=center class=tableborder1>"
		Response.Write "<TBODY><TR>"
		Response.Write "<Th height=24 colspan=1>查看购买贴子的用户</Th>"
		Response.Write "</TR>"
		Response.Write "<tr><TD class=tablebody2>"
		If (not isnull(PostBuyUser)) Or  PostBuyUser<>"" Then
			PostBuyUser=Replace(PostBuyUser,"|","<li>")
			Response.Write "<li>"&PostBuyUser		
		Else
			Response.Write "<br><li>还未有人购买！"
		End If
		Response.Write "</td></tr>"
		Response.Write "</table>"
		Set rs=Nothing
	End Sub
	Function checktable(Table)
		Table=Right(Trim(Table),2)
		If Not IsNumeric(table) Then Table=Right(Trim(Table),1)
		If Not IsNumeric(table) Then Dvbbs.AddErrCode(35)
		checktable="Dv_bbs"&table
	End Function 
%>