gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\BuyPost.asp
<!-- #include file="conn.asp" --> <!-- #include file="inc/const.asp" --> <!--#include file="inc/dv_clsother.asp"--> <% Mybbs.LoadTemplates("dispbbs") Dim rootid,PostTable Dim AnnounceID,Rs,SQL,i PostTable=request("PostTable") PostTable=checktable(PostTable) If request("action")="view" Then Mybbs.stats="查看购买贴子的用户" Else Mybbs.stats="购买帖子" End If Mybbs.Nav Mybbs.Head_var 1,Mybbs.Board_Data(4,0),"","" rootid=Request("ID") If rootid="" Or Not IsNumeric(rootid) Then Mybbs.AddErrCode(30) AnnounceID=request("replyID") If AnnounceID="" Then Mybbs.AddErrCode(30) ElseIf Not IsNumeric(AnnounceID) Then Mybbs.AddErrCode(30) End If If Mybbs.UserID=0 Then Mybbs.AddErrCode(30) End If Mybbs.ShowErr() If request("action")="view" Then Call view() Else Call main() End If Mybbs.ShowErr() Mybbs.activeonline() Mybbs.footer Sub main() dim re dim po,ii dim reContent dim strContent dim PostBuyUser po=0 ii=0 dim usermoney set rs=Mybbs.Execute("select userWealth from [Dv_user] where userid="&Mybbs.Userid) usermoney=rs(0) set rs=server.createobject("adodb.recordset") sql="select body,PostBuyUser,username,PostUserID from "&PostTable&" where Announceid="&Announceid rs.open sql,conn,1,3 If rs.eof and rs.bof Then Mybbs.AddErrCode(30) Mybbs.ShowErr() Else strContent=Mybbs.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 Mybbs.membername=rs(2) Then response.write "<script>alert('呵呵,您要花钱购买自己发布的帖子嘛?');</script>" ElseIf usermoney >ii then If (not isnull(PostBuyUser)) Or PostBuyUser<>"" Then If InStr("|"&PostBuyUser&"|","|"&Mybbs.membername&"|")>0 Then response.write "<script>alert('呵呵,您已经购买过了呀?');</script>" Else Mybbs.Execute("update [Dv_user] set userWealth=userWealth-"&ii&" where userid="&Mybbs.userid) Mybbs.Execute("update [Dv_user] set userWealth=userWealth+"&ii&" where userid="&rs(3)) If IsNull(Rs(1)) or Rs(1)="" Then rs(1)=Mybbs.membername Else rs(1)=rs(1) & "|" & Mybbs.membername End If Rs.Update response.write "<script>alert('购买成功!');</script>" End If Else Mybbs.Execute("update [Dv_user] set userWealth=userWealth-"&ii&" where userid="&Mybbs.userid) Mybbs.Execute("update [Dv_user] set userWealth=userWealth+"&ii&" where userid="&rs(3)) rs(1)=Mybbs.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&"&replyID="&AnnounceID&"&skin=1" Response.Write "';" Response.Write "</script>" End Sub Sub view() Dim PostBuyUser sql="select PostBuyUser from "&PostTable&" where Announceid="&Announceid Set rs=Mybbs.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 Mybbs.AddErrCode(30) checktable="Dv_bbs"&table End Function %>