show.asp

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

	Set pages = nothing
	Template=BBS94KK.Template.ReadTemplate("帖子信息")
  If IsArray(Arr_Rs) Then
	Lou = (Page-1)*10
	For i = 0 to UBound(Arr_Rs, 2)
	UserName=Arr_Rs(11,i)
	BBSID=Arr_Rs(0,i)
	BBS94KK_ubb.UbbString=Arr_Rs(8,i)
	Temp=Replace(Template,"{数据表ID}",BBS94KK.TB)
	Temp=Replace(Temp,"{版块ID}",BBS94KK.BoardID)
	Temp=Replace(Temp,"{主题ID}",ID)
	Temp=Replace(Temp,"{页次}",page)
	Temp=Replace(Temp,"{帖子ID}",Arr_Rs(0,i))
	Temp=Replace(Temp,"{用户名称}",Arr_Rs(11,i))
	Temp=Replace(Temp,"{发帖时间}",Arr_Rs(6,i))
	IF BBS94KK.MyAdmin<>1 and BBS94KK.MyAdmin<>2 then
		Temp=Replace(Temp,"{用户IP}","*.*.*.*")
	Else
		Temp=Replace(Temp,"{用户IP}",BBS94KK.Fun.GetSqlStr(Arr_Rs(9,i)))
	End If
	Temp=Replace(Temp,"{QQ}",BBS94KK.Fun.GetSqlStr(Arr_Rs(13,i)))
	Temp=Replace(Temp,"{邮箱}",BBS94KK.Fun.GetSqlStr(Arr_Rs(19,i)))
	Temp=Replace(Temp,"{主页}",BBS94KK.Fun.GetSqlStr(Arr_Rs(20,i)))
	Temp=Replace(Temp,"{性别}",BBS94KK.Fun.GetSqlStr(Arr_Rs(21,i)))
	Temp=Replace(Temp,"{积分数}",BBS94KK.Fun.GetSqlStr(Arr_Rs(22,i)))
	Temp=Replace(Temp,"{金钱数}",BBS94KK.Fun.GetSqlStr(Arr_Rs(23,i)))
	Temp=Replace(Temp,"{头衔}",BBS94KK.Fun.GetSqlStr(Arr_Rs(32,i)))
	Temp=Replace(Temp,"{等级图片}","<img src='pic/grade/"&Arr_Rs(17,i)&".gif'>")
	Temp=Replace(Temp,"{等级}","<b>"&Arr_Rs(17,i)&"</b> "&BBS94KK.GradeName(int(Arr_Rs(17,i))))
	Temp=Replace(Temp,"{帖数}",Arr_Rs(18,i))
	Temp=Replace(Temp,"{注册时间}",formatdatetime(Arr_Rs(25,i),2))
	Temp=Replace(Temp,"{在线状态}",IsOnline(Arr_Rs(11,i)))
	If Arr_Rs(27,i) then
		Temp=Replace(Temp,"{用户头像}","<Font Color=Red><b>系统警告<br>此用户已被<br>暂时删除！</b></font>")
	Else
		IF Arr_Rs(12,i) then
			Temp=Replace(Temp,"{用户头像}","<img src='http://qqshow-user.tencent.com/"&Arr_Rs(13,i)&"/10/'>")
		else
			Temp=Replace(Temp,"{用户头像}","<img border='0' src='"&Arr_Rs(14,i)&"' width="&Arr_Rs(15,i)&" height="&Arr_Rs(16,i)&">")
		End If
	End If
	If Arr_Rs(1,i)=ID Then
		Temp=Replace(Temp,"{删除}","")
		ShowCaption=TopicCaption
		ShowMood=TopicMood()
		Temp=Replace(Temp,"{楼号}","楼 主")
	Else
		ShowCaption="":ShowMood=""
		Temp=Replace(Temp,"{楼号}","第 "&Lou+i&" 楼")
		Temp=Replace(Temp,"{删除}",BBS94KK.Template.ReadTemplate("删除回复"))
	End If
	AppraiseInfo=""
	If Arr_Rs(34,i) Then AppraiseInfo=Appraise(Arr_Rs(0,i))
	Sign=Arr_Rs(24,i)
	IF Arr_Rs(26,i) then
		Temp=Replace(Temp,"{帖子内容}","<Hr Size=1><Font Color=red>该用户帖子已被管理员屏蔽，请和管理员联系</Font><Hr Size=1>"&AppraiseInfo)
		Temp=Replace(Temp,"{签名}","【签名档被已管理员屏蔽】")
	Else
		IF BBS94KK.BbsCache(17)="1" then Sign="" 
		IF Arr_Rs(28,i) Then Sign="【签名档已被管理员屏蔽】"
		IF isNull(sign) or sign="" then
			Temp=Replace(Temp,"{签名}",BBS94KK.BbsCache(0)&"欢迎您！")
		Else
			Temp=Replace(Temp,"{签名}",BBS94KK_ubb.Sign_Code(Sign))
		End IF
		Temp=Replace(Temp,"{帖子内容}",ShowMood&"<SPAN style='line-height:150%;font-size:"&FontSize&"pt;table-layout:fixed;word-wrap:break-word;word-break:break-all;width:100%'><img src='pic/Face/"&Arr_rs(2,i)&".gif'> <b>"&ShowCaption&"</b><br>"&BBS94KK_ubb.UBB(Arr_Rs(4,i),1)&"</SPAN>"&AppraiseInfo)
	End IF
	TempStr=TempStr&Temp
	Next
	Response.Write(TempStr)
  End If
End Function

		
Function IsOnline(TUserName)
	Dim Temp,Rs,Ary_Rs,i
	IsOnline="Offline"
 		Cache.Name="UserOnline"
	If Cache.valid Then
	   Temp=Cache.Value
	Else
		Set Rs=BBS94KK.Execute("Select Name From [KK_online] where Admin >0")
		If Rs.Eof Or Rs.Bof Then Exit Function
		Ary_Rs=Rs.GetRows(-1)
		Rs.Close
		For i=0 To Ubound(Ary_Rs,2)
			Temp=Temp & Ary_Rs(0,i)&","
		Next
		Temp=","&Temp
		Cache.add Temp,dateadd("n",5,BBS94KK.NowBBSTime)'5分钟
	End If
	If InStr(Lcase(Temp),","&Lcase(TUserName)&",")>0 Then IsOnline="Online"
End Function

Function GetUrl(Str)
	GetUrl="<a href='SetTopic.asp?BoardID="&BBS94KK.BoardID&"&ID="&ID&"&TB="&BBS94KK.TB&"&Action="&Str&"'>"&Str&"</a> ┋ "
End Function

Function SetTopic()
	Dim Temp
	If Not BBS94KK.FoundUser Then Exit Function
	IF BBS94KK.MyAdmin=1 or BBS94KK.MyAdmin=2 or BBS94KK.IsBoardAdmin Then
		Temp="主题管理："
		IF TopicTopType=5 then Temp=Temp&GetUrl("取消总置顶") Else Temp=Temp&GetUrl("总置顶")
		IF TopicTopType=4 Then Temp=Temp&GetUrl("取消区置顶") ELse Temp=Temp&GetUrl("区置顶")
		IF TopicTopType=3 Then Temp=Temp&GetUrl("取消置顶") ELse Temp=Temp&GetUrl("置顶")
		IF TopicIsGood Then Temp=Temp&GetUrl("取消精华") Else Temp=Temp&GetUrl("精华")
		IF TopicIsLock Then Temp=Temp&GetUrl("解锁") Else Temp=Temp&GetUrl("锁定")
		Temp=Temp&GetUrl("删除主题")&GetUrl("移动")&GetUrl("提升")&GetUrl("沉底")&GetUrl("已解决")
		SetTopic=Temp
	End If
End Function

Function FastReply()
	If Not BBS94KK.FoundUser Then Exit Function
	If BBS94KK.BoardType<>2 or BBS94KK.MyAdmin=1 or BBS94KK.MyAdmin=2 or (BBS94KK.MyAdmin=3 And BBS94KK.IsBoardAdmin) Then
	IF Not TopicIsLock Or BBS94KK.MyAdmin=1 or BBS94KK.MyAdmin=2 then
		Dim Caption,Content
		Caption="快速回复【<a href='say.asp?action=reply&BoardID="&BBS94KK.BoardID&"&id="&ID&"'>高级回复</a>】"
		Content="<div id='MaoDiv' style='position: absolute; width:570px; height:160px; display:none;'><iframe id='MView' name='MView' src='about:blank' frameborder='0' scrolling='no' valign='top' width='100%' height='100%'></iframe></div>"&_
		"<form style='margin: 8;' onSubmit='ok.disabled=true;ok.value=""正在发送""' method='POST' name='kk' action='SaySave.asp?action=Reply&BoardID="&BBS94KK.BoardID&"&TB="&BBS94KK.TB&"&ID="&ID&"&page="&Page&"'><table align='center' border='0' cellpadding='0' cellspacing='0' style='border-collapse: collapse' width='100%'></td></tr><tr><td width='24%' valign='top'><table width='100%' border='0' cellpadding='5' cellspacing='0'><tr><td align='center'><img onClick=Cbold() src='Pic/Ubb/u_1.gif' border=0 alt=粗体字> <img onClick=Cwmv() src=Pic/Ubb/U_14.gif border=0 alt='Media Player视频文件'> <img onClick=swf() src=Pic/Ubb/U_13.gif border=0 alt=Flash动画 > <img onClick=image() src='Pic/Ubb/U_12.gif' border=0 alt=图片> <img onClick=showpic() src='Pic/Ubb/U_11.gif' border='0' alt='心情图片'></td>"&_
		"</tr><tr><td align='center'><img src='Images/butreply.gif' onClick=Insert('[reply]内容[/reply]')> <img src='Images/butlogin.gif' onClick=Especial('[LOGIN]','[/LOGIN]')></td></tr>"&_
		"<tr><td align='center'><img src='Images/butgrade.gif' width='60' height='22' onClick=Grade()> <img src='Images/butcode.gif' onClick=Code()></td></tr></table>"&_
		"</td><td width='71%' valign='top'><input type=hidden name='caption' value='Re:"&TopicCaption&"'><textarea onkeydown=presskey(); rows=6 name=content Style='width:100%'></textarea><p style='margin-top: 10; margin-bottom: 0'>"
		IF BBS94KK.BbsCache(11)=0 then Content=Content&"验证码：<input type=text name='CheckCode' size=8><img align='absmiddle' src=Inc/code.asp> "
		Content=Content&"<input type=submit value='回复帖子' name='ok'> <input type=button value='预 览' onclick=openwin()> <input type='reset' value='重 写'> 快捷键 Ctrl+Enter </p></td><td width='5%' valign='top'><input type='button' style='BACKGROUND: url(Images/plus.gif); width:20;height:20;border:0;cursor:hand' onclick='textarea_Size(3,this.form.content)' ><br><br><input type='button' style='BACKGROUND: url(Images/minus.gif); width:20;height:20;border:0;cursor:hand' onclick='textarea_Size(-3,this.form.content)'></td></tr></table></form><form  style='margin:0;' name=preview action=See.asp?Action=preview method=post target=preview><input type=hidden name=caption value=><input type=hidden name=content value=''></form>"
	Call BBS94KK.ShowTable(Caption,Content)
	END IF
	End IF
End Function

Function Appraise(AstID)
	Dim Rs,Arr_Rs,i
	Set Rs=BBS94KK.Execute("Select BbsID,Cause,Mark,Coin,GameCoin,Adminname,AddTime From [KK_Appraise] where BBSID="&AstID&" And TopicID="&ID&" order by AddTime desc")
	If Rs.Eof Then
		Exit Function
	Else
		Arr_Rs=Rs.GetRows(-1)
		Rs.Close
		Appraise="<div style='border:2 ridge;background-color:#F5FAFC;padding:5px;margin:8px'>此帖被评"
		'2005-8-1增加站长可以删除评帖记录
		If BBS94KK.MyAdmin=1 Then Appraise=Appraise&"【<a href=Settopic.asp?action=delappraise&TB="&BBS94KK.TB&"&ID="&ID&"&BbsID="&AstID&"&BoardID="&BBS94KK.BoardID&">删除</a>】"
		'2005-8-1结束
		For i=0 To Ubound(Arr_Rs,2)
		Appraise=Appraise&"<li><font color=blue>"&Arr_Rs(1,i)&"</font> "
		If Arr_Rs(2,i)<>0 Then Appraise=Appraise&"积分:<font color=red>"&Arr_rs(2,i)&"</font>&nbsp;"
		If Arr_Rs(3,i)<>0 Then Appraise=Appraise&"金钱:<font color=red>"&Arr_rs(3,i)&"</font>&nbsp;"
		If Arr_Rs(4,i)<>0 Then Appraise=Appraise&"游戏币:<font color=red>"&Arr_rs(4,i)&"</font>&nbsp;"
		Appraise=Appraise&"<font color=#AAAAAA>"&Arr_rs(5,i)&"&nbsp;"&Arr_rs(6,i)&"</font>"
		Next
		Appraise=Appraise&"</div>"
	End If
End Function
%>