submit.asp

BBS源码 利用ASP的一个功能齐全的BBS论坛源码

<!--#include file="Inc.asp"-->
<%Dim Action,ID
BBS94KK.Fun.CheckMake
If not BBS94KK.FoundUser Then BBS94KK.GoToErr(10)
ID=BBS94KK.CheckNum(request.querystring("Id"))
Action=Lcase(Request.querystring("Action"))
If Action="vote" Then
	SubmitVote()
Else
	SubmitBuyer()
End If
Set BBS94KK=Nothing
Response.redirect(Request.ServerVariables("HTTP_REFERER"))




Sub SubmitVote()
	Dim Temp,Rs,i,VoteType,Vote,VoteNum,TempVote,MyOpt,OutTime,AllVoteNum
	IF ID=0 Then BBS94KK.GoToErr(1)
	VoteType=BBS94KK.checknum(request.querystring("type"))
	Set Rs=BBS94KK.execute("select Vote,VoteNum,VoteType,OutTime From[KK_TopicVote] where TopicID="&ID&"")
	IF Not Rs.Eof Then
		Vote=split(Rs("vote"),"|")
		VoteNum=split(Rs("voteNum"),"|")
		OutTime=Rs("OutTime")
		IF VoteType<>Int(Rs("VoteType")) Then BBS94KK.GoToErr(1)
		TempVote=Vote
		if VoteType=1 then
			Temp=BBS94KK.CheckNum(Request.form("opt"))
			MyOpt=Temp
			For i=1 to ubound(Vote)
				If i=Temp then VoteNum(i)=VoteNum(i)+1
				AllVoteNum=AllVoteNum&"|"&VoteNum(i)
			Next
		ElseIf VoteType=2 Then
			Temp=0
			TempVote=Vote
			For i=1 to ubound(Vote)
				TempVote(i)=BBS94KK.Checknum(Request.form("opt"&i&""))
				Temp=TempVote(i)+Temp
				IF TempVote(i)=0 Then TempVote(i)=VoteNum(i)
				IF TempVote(i)=i Then
				 TempVote(i)=Votenum(i)+1
				 MyOpt=MyOpt&","&i
				End if
				AllVoteNum=AllVoteNum&"|"&TempVote(i)  
			Next
		Else
			BBS94KK.GoToErr(1)
		End if
		If Temp=0 Then Call alert("您还没有选择投票项目！")
		IF Temp<>0 or not BBS94KK.execute("select User From [KK_TopicVoteUser] where User='"&BBS94KK.MyName&"' and TopicID="&ID&"").Eof Then
			If DateDiff("s",BBS94KK.NowBbsTime,OutTime)>0 then
			BBS94KK.execute("update [KK_TopicVote] Set VoteNum='"&AllvoteNum&"' where TopicID="&ID&"")
			BBS94KK.execute("update [KK_Topic] Set LastTime='"&BBS94KK.NowBbsTime&"' where TopicID="&ID&"")
			BBS94KK.execute("update [KK_bbs"&BBS94KK.TB&"] Set LastTime='"&BBS94KK.NowBbsTime&"' where TopicID="&ID&"")
			BBS94KK.execute("Insert into [KK_TopicVoteUser](TopicID,[User],VoteNum)VALUES("&ID&",'"&BBS94KK.MyName&"','"&MyOpt&"')")
			End If
		End If
	End if
	Rs.Close
End Sub
Sub SubmitBuyer()
	If ID=0 Then BBS94KK.GoToErr(1)
	Dim Temp,Rs,Rss,Buyer,re,str
	Set Rs=BBS94KK.execute("Select Content,Name,Buyer From[KK_bbs"&BBS94KK.TB&"] where BbsID="&ID&"")
	IF Rs.eof Then BBS94KK.GoToErr(1)
	Rss=Rs.GetRows(1)
	Rs.Close
	Temp=Replace(Rss(0,0),chr(10),"")
	Temp=Replace(Temp,chr(10),"")
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	re.Pattern="(^.*)(\[BUYPOST=*([0-9]*)\])(.*)(\[\/BUYPOST\])(.*)"
	Str=re.Replace(Temp,"$3")
	Set re=Nothing
	If isnumeric(Str) Then
		Str=int(Str)
	Else
		Str=0
	End if
	If Lcase(Rss(1,0))=Lcase(BBS94KK.MyName) Then Call alert("您不能向自己购买！")
	If Int(BBS94KK.MyCoin)<Str Then Call alert("钱不够，请再努力发帖赚钱吧！")
	If Not isnull(Rss(2,0)) Then
		If instr("|"&Lcase(Rss(2,0))&"|","|"&Lcase(BBS94KK.MyName)&"|")>0 Then Call alert("您已经购买过了呀？")
	End IF
	Temp=Rss(2,0)&"|"&BBS94KK.MyName
	BBS94KK.execute("update [KK_user] set Coin=Coin-"&Str&" where name='"&BBS94KK.MyName&"'")
	BBS94KK.execute("update [KK_user] set Coin=Coin+"&Str&" where name='"&Rss(1,0)&"'")
	BBS94KK.execute("Update [KK_bbs"&BBS94KK.TB&"] Set Buyer='"&Trim(Temp)&"' Where BbsID="&ID&"")
	Session(BBS94KK.CacheName & "MyInfo")=""
End Sub
Sub Alert(message)
  message = replace(message,"'","\'")
  Response.Write ("<script LANGUAGE='javascript'>alert('" & message & "');history.go(-1);</script>")
  Response.End
End Sub
%>