📄 saysave.asp

📁 BBS源码利用ASP的一个功能齐全的BBS论坛源码
💻 ASP
字号:
<!--#include file="Inc.asp"-->
<!--#include file="Inc/md5.asp"-->
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<%
Dim Action,Caption,Content,Face,Page,TmpUbbString
If Not BBS94KK.Founduser then BBS94KK.GoToerr(10)
IF (Session(BBS94KK.CacheName&"SayTime")+Int(BBS94KK.BbsCache(35))/86400)>Now() Then BBS94KK.GoToErr(17)
BBS94KK.Fun.CheckMake'禁止外部提交
BBS94KK.CheckBoard()

Face=BBS94KK.CheckNum(Request.form("face"))
Caption=BBS94KK.Fun.GetStr("caption")
Content=BBS94KK.Fun.Checkbad(BBS94KK.Fun.GetStr("content"))
If Caption="" Or Content="" then BBS94KK.GoToErr(20)
Caption=jap(Caption)
Content=jap(Content)
IF Len(Caption)>250 Then BBS94KK.GoToErr(21)
IF Len(Content)>30720 Then BBS94KK.GoToErr(18)
IF Session("CheckCode")<>request.form("CheckCode") And BBS94KK.BbsCache(11)=0 then BBS94KK.GoToErr(19)

BBS94KK.Head("")
Page=BBS94KK.CheckNum(request.querystring("page"))
Action=lcase(request.querystring("action"))
IF Action="reply" Then
 	Reply()
ElseIf Action="edit" Then
	Edit()
Else
	Say()
End if

If BBS94KK.BbsCache(11)=0 then Session("CheckCode")=""
Content="<div style='margin:15;line-height: 150%'>"&Content&"</div>"
Call BBS94KK.ShowTable(Caption,Content)
Session(BBS94KK.CacheName & "SayTime")=Now()
BBS94KK.Footer()
Set BBS94KK=Nothing

Function jap(Istr)
	Dim japArr,ArrNum
	japArr=Array("ゴ","ガ","ギ","グ","ゲ","ザ","ジ","ズ","ヅ","デ","ド","ポ","ベ","プ","ビ","パ","ヴ","ボ","ペ","ブ","ピ","バ","ヂ","ダ","ゾ","ゼ")
	For ArrNum=0 to Ubound(japArr)
		Istr=Replace(Istr,japArr(ArrNum),"&#"&AscW(japArr(ArrNum))&";")
	Next
	jap=Istr
End Function

Function CheckUploadType(byval Str)
	Dim pos
	Str=split(Str,"[UPLOAD=")
	If ubound(Str)>=1 then
		pos=instr(str(1),"[/UPLOAD]")
		If pos=0 then exit function
		CheckUploadType=left(str(1),3)
	End if
End function

Function UpdateGrade()
	IF BBS94KK.MyAdmin=1 Then
		UpdateGrade=20
	ElseIF BBS94KK.MyAdmin=2 Then
		UpdateGrade=19
	ElseIf BBS94KK.MyAdmin=3 Then
		UpdateGrade=18
	Else
		UpdateGrade=BBS94KK.MyEssayNum
		UpdateGrade=UpdateGrade\80
		IF UpdateGrade>17 Then UpdateGrade=17
	End if
End Function

Sub Say()
	Dim Temp,I,ISvote,VoteType,VoteAutoValue,Votes,VoteNum,Outtime,UploadType,TopicLastReply,BoardLastReply,MaxID,Coin,GameCoin
	TmpUbbString=BBS94KK.Fun.UbbString(Content)
	IsVote=false
	If instr(","&Join(BBS94KK.UploadType,",")&",",","&CheckUploadType(Content)&",")>0 then
		UploadType=CheckUploadType(Content)
	Else
		UploadType=""
	End if
	VoteType=BBS94KK.CheckNum(request.Form("VoteType"))
	If VoteType<>2 Then VoteType=1
	VoteAutoValue=BBS94KK.CheckNum(request.Form("AutoValue"))
	For i=1 to VoteAutoValue
	Temp=Left(BBS94KK.Fun.Checkbad(Trim(BBS94KK.Fun.GetStr("Votes"&I))),250)
	IF not Temp="" Then
		Votes=Votes&"|"&Temp
		VoteNum=VoteNum&"|0"
	End If
	Next
	Outtime=cDate(BBS94KK.NowBbsTime)+int(request.form("OutTime"))
	If Votes<>"" Then IsVote=True
	Coin=80:GameCoin=3
	If Session(BBS94KK.CacheName&"SayContent")<>Md5(Caption&Content) Then
	'插入主题表
	TopicLastReply="——|"&BBS94KK.Fun.StrLeft(BBS94KK.Fun.FixReply(Content),40)
	BBS94KK.Execute("Insert into [KK_Topic](Caption,Name,Face,IsVote,AddTime,LastTime,Lastreply,UploadType,BoardID,SqlTableID)Values('"&Caption&"','"&BBS94KK.Myname&"',"&Face&","&IsVote&",'"&BBS94KK.NowBbsTime&"','"&BBS94KK.NowBbsTime&"','"&TopicLastReply&"','"&UploadType&"',"&BBS94KK.BoardID&","&BBS94KK.TB&")")
	'得到新发表主题的ID	
	MaxID=BBS94KK.Execute("select Max(TopicID) from [KK_Topic]")(0)
	'插入投票
	IF IsVote Then BBS94KK.Execute("insert into[KK_TopicVote](TopicID,Vote,VoteNum,VoteType,OutTime)values("&MaxID&",'"&votes&"','"&VoteNum&"',"&votetype&",'"&Outtime&"')")
	'插入帖子
	BBS94KK.Execute("Insert into [KK_bbs"&BBS94KK.TB&"](TopicID,Caption,name,Content,AddTime,LastTime,Face,BoardID,UbbString,IP)VALUES("&MaxID&",'"&Caption&"','"&BBS94KK.MyName&"','"&Content&"','"&BBS94KK.NowBbsTime&"','"&BBS94KK.NowBbsTime&"',"&Face&","&BBS94KK.BoardID&",'"&TmpUbbString&"','"&BBS94KK.MyIP&"')")
	'更新用户信息
	If Len(Content)<10 Then Coin=0:GameCoin=0
	Temp=UpdateGrade()
	BBS94KK.execute("Update [KK_user] set Coin=Coin+"&Coin&",GameCoin=GameCoin+"&GameCoin&",EssayNum=EssayNum+1,Grade="&Temp&" WHERE Name='"&BBS94KK.MyName&"'")
	'更新版块
	BoardLastReply=BBS94KK.MyName&"|"&BBS94KK.Fun.StrLeft(Caption,20)&"|"&BBS94KK.NowBbsTime&"|"&Face&"|"&MaxID&"|"&BBS94KK.BoardID&"|"&BBS94KK.TB
	BBS94KK.Execute("Update [KK_Board] set TopicNum=TopicNum+1,TodayNum=TodayNum+1,EssayNum=EssayNum+1,LastReply='"&BoardLastReply&"' where BoardID="&BBS94KK.BoardID&" And Depth>0")
	'更新上级版块
	If BBS94KK.BoardDepth>1 Then
		BBS94KK.Execute("Update [KK_Board] set TopicNum=TopicNum+1,TodayNum=TodayNum+1,EssayNum=EssayNum+1,LastReply='"&BoardLastReply&"' where BoardID In ("&BBS94KK.BoardParentStr&") And Depth>0")
	End If
	'更新系统
	BBS94KK.Execute("Update [KK_config] set Topicnum=Topicnum+1,allEssayNum=AllEssayNum+1,TodayNum=TodayNum+1")
	UpdateCache()
	Session(BBS94KK.CacheName&"SayContent")=Md5(Caption&Content)
	End If 
	Caption="发 帖 成 功 ！"
	Content="<meta http-equiv=refresh content=3;url=list.asp?Boardid="&BBS94KK.Boardid&"><li><b>发表成功----如果你不点击下面的连接，将在 3 秒后自动跳转到 "&BBS94KK.Boardname&"！</b></font><li>本次发帖获得：金钱<font color=red>"&Coin&"</font>元、 游戏币<font color=red>"&GameCoin&"</font>枚<li><a href=show.asp?id="&MaxId&"&BoardID="&BBS94KK.BoardID&"&TB="&BBS94KK.TB&">回到你所发的帖的页面！</a><li><a href=list.asp?BoardID="&BBS94KK.BoardID&">"&BBS94KK.Boardname&"</a><li><a href=index.asp>"&BBS94KK.BbsCache(0)&" 首页</a>"
End Sub

Sub Reply()
	Dim Rs,ID,TopicUserName,TopicLastReply,BoardLastReply,Temp,Quote,QuoteName,Coin,GameCoin
	ID=BBS94KK.Checknum(request.querystring("Id"))
	Quote=BBS94KK.Fun.GetStr("Quote")
	If Trim(Quote)<>"" Then Content=BBS94KK.Fun.GetStr("QuoteName") & Quote & "[/quote]" & Content
	If Id=0 or BBS94KK.BoardID=0 Then BBS94KK.GoToErr(1)
	TmpUbbString=BBS94KK.Fun.UbbString(content)
	Set Rs=BBS94KK.Execute("Select Name,IsLock,SqlTableID,BoardID From [KK_Topic] where TopicID="&ID&" And (BoardID="&BBS94KK.BoardID&" Or TopType=4 or TopType=5) And SqlTableID="&BBS94KK.TB&" And IsDel=False ")
	IF Rs.Eof Then BBS94KK.GoToErr(11)  
	IF Lcase(BBS94KK.MyName)=Lcase(Rs("Name")) Then
		IF Rs(1) Then BBS94KK.GoToErr(12)
	End If
	TopicUserName=Rs(0)
	BBS94KK.TB=Rs(2)
	BBS94KK.BoardID=Rs(3)
	RS.Close
	Coin=30:GameCoin=2
	If Session(BBS94KK.CacheName&"SayContent")<>Md5(Caption&Content) Then 
	'插入帖子
	BBS94KK.execute("insert into [KK_bbs"&BBS94KK.TB&"](ReplyTopicID,name,Caption,Content,AddTime,LastTime,Face,Boardid,UbbString,ip)VALUES("&ID&",'"&BBS94KK.MyName&"','"&Caption&"','"&Content&"','"&BBS94KK.NowBbsTime&"','"&BBS94KK.NowBbsTime&"',"&face&","&BBS94KK.BoardID&",'"&TmpUbbString&"','"&BBS94KK.MyIp&"')")
	'更新主题帖子
	BBS94KK.execute("Update [KK_bbs"&BBS94KK.TB&"] Set LastTime='"&BBS94KK.NowBbsTime&"' where TopicId="&ID&"")
	'更新主题
	TopicLastReply=""&BBS94KK.MyName&"|"&BBS94KK.Fun.StrLeft(BBS94KK.Fun.FixReply(Content),40)
	BBS94KK.execute("Update [KK_Topic] set ReplyNum=ReplyNum+1,LastTime='"&BBS94KK.NowBbsTime&"',LastReply='"&TopicLastReply&"' where TopicId="&ID&"")
	'更新版块
	BoardLastReply=""&BBS94KK.MyName&"|"&BBS94KK.Fun.StrLeft(BBS94KK.Fun.FixReply(Content),20)&"|"&BBS94KK.NowBbsTime&"|"&Face&"|"&ID&"|"&BBS94KK.BoardID&"|"&BBS94KK.TB
	BBS94KK.execute("Update [KK_Board] set lastReply='"&BoardLastReply&"',TodayNum=TodayNum+1,EssayNum=EssayNum+1 where BoardID="&BBS94KK.BoardID&" and Depth<>0")
	If BBS94KK.BoardDepth>1 Then
		BBS94KK.Execute("Update [KK_Board] set TopicNum=TopicNum+1,TodayNum=TodayNum+1,EssayNum=EssayNum+1,LastReply='"&BoardLastReply&"' where BoardID In ("&BBS94KK.BoardParentStr&") And Depth>0")
	End If
	'更新用户
	Temp=UpdateGrade()
	If Len(Content)<10 Then Coin=0:GameCoin=0
	BBS94KK.execute("Update [KK_user] set Coin=Coin+"&Coin&",GameCoin=GameCoin+2,EssayNum=EssayNum+1,Grade="&Temp&" WHERE Name='"&BBS94KK.Myname&"'")
	'更新楼主
	If Lcase(BBS94KK.MyName)<>Lcase(TopicUserName) Then
	BBS94KK.execute("Update [KK_user] set Coin=Coin+"&Coin&" WHERE Name='"&TopicUserName&"'")
	End If
	'更新系统
	BBS94KK.execute("Update [KK_Config] set TodayNum=TodayNum+1,AllEssayNum=AllEssayNum+1")
	UpdateCache()
	Session(BBS94KK.CacheName&"SayContent")=Md5(Caption&Content)
	End If
	Caption="回 复 成 功 ！"
	Content="<meta http-equiv=refresh content=3;url='list.asp?BoardID="&BBS94KK.BoardID&"'><b>回复成功----如果你不点击下面的连接，将在 3 秒后自动跳转到 "&BBS94KK.BoardName&"！</b></font><li>本次发帖获得：金钱<font color=red>"&Coin&"</font>元、游戏币<font color=red>"&GameCoin&"</font>枚<li><a href=show.asp?id="&ID&"&BoardID="&BBS94KK.BoardID&"&TB="&BBS94KK.TB&"&page="&page&">回到你所回复的帖的页面！</a><li><a href=list.asp?BoardID="&BBS94KK.BoardID&">"&BBS94KK.BoardName&"</a><li><a href=index.asp>"&BBS94KK.BbsCache(0)&"</a><br>"
End Sub

Sub Edit()
	Dim Rs,ID,BbsID,TopicID,EditChalk,ReplyTopicID
	EditChalk=BBS94KK.Fun.GetStr("EditChalk")
	ID=BBS94KK.CheckNum(request.querystring("ID"))
	BbsID=BBS94KK.CheckNum(request.querystring("BbsID"))
	If BbsID=0 Or ID=0 Then BBS94KK.GoToErr(1)
	If EditChalk<>"No" Then
	Content=""&Content&vbcrlf&vbcrlf&vbcrlf&"[right][color=#0080FF]「该帖子被 "&BBS94KK.MyName&" 在 "&BBS94KK.NowBbsTime&" 编辑过」[/color][/right]"
	End If
	TmpUbbString=BBS94KK.Fun.UbbString(content)
	Set Rs=BBS94KK.Execute("select Name,TopicID,ReplyTopicID from [KK_bbs"&BBS94KK.TB&"] where BbsID="&BbsID&" and IsDel=False")
	If Not Rs.eof  Then
		If BBS94KK.MyAdmin<>1 And BBS94KK.MyAdmin<>2 And Not BBS94KK.IsBoardAdmin And Lcase(BBS94KK.MyName)<>Lcase(rs("name")) Then BBS94KK.GoToErr(13)
		TopicID=Rs("TopicID")
		ReplyTopicID=Rs("ReplyTopicID")
		Rs.Close
	Else
		BBS94KK.GoToErr(11)
	End if
	BBS94KK.execute("Update [KK_bbs"&BBS94KK.TB&"] set Caption='"&Caption&"',Content='"&Content&"',Face="&Face&",LastTime='"&BBS94KK.NowBbsTime&"',UbbString='"&TmpUbbString&"',IP='"&BBS94KK.MyIp&"' where BbsID="&BbsID&"")
	If ReplyTopicID=0 then
		BBS94KK.execute("Update [KK_Topic] set Caption='"&Caption&"',Face="&Face&",LastTime='"&BBS94KK.NowBbsTime&"' where TopicID="&TopicID&"")
	End If
	Dim ReRs,TopicLastReply
	Set ReRs=BBS94KK.execute("select top 1 Name,Content from [KK_bbs"&BBS94KK.TB&"] where BoardID="&BBS94KK.BoardID&" And ReplyTopicID="&ID&" And IsDel=False order by BbsID desc")
	If Not ReRs.Eof Then
		TopicLastReply=""&ReRs(0)&"|"&BBS94KK.Fun.StrLeft(ReRs(1),40)
	Else
		TopicLastReply="——|暂无回复"
	End If
	ReRs.CLose:Set ReRs=Nothing
	BBS94KK.execute("Update [KK_Topic] set LastReply='"&TopicLastReply&"' where TopicId="&ID&"")
	Caption="修 改 成 功 ！"
	Content="<li>修改成功！ <a href=Show.asp?ID="&ID&"&BoardID="&BBS94KK.BoardID&"&TB="&BBS94KK.TB&"&page="&page&">回到帖子页面</a><li> <a href=List.asp?BoardID="&BBS94KK.BoardID&">"&BBS94KK.BoardName&"</a><li> <a href=index.asp>"&BBS94KK.BbsCache(0)&"</a><br>"
End Sub

Sub UpdateCache()
	Dim Temp
	Session(BBS94KK.CacheName&"SayContent")=MD5(BBS94KK.Fun.Checkbad(BBS94KK.Fun.GetStr("caption"))&BBS94KK.Fun.Checkbad(BBS94KK.Fun.GetStr("content")))
	Temp=BBS94KK.TodayNum+1
	If Int(Temp)>Int(BBS94KK.MaxEssayNum) Then BBS94KK.Execute("Update [KK_Config] set MaxEssayNum="&Temp&"")
	Session(BBS94KK.CacheName & "MyInfo") = Empty
	'更新系统,版块,主题
	Cache.name="Config"
	Cache.clean()
	Cache.Name="BoardInfo"
	Cache.clean()
End Sub
%>
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -