thread.asp

一个asp写的论坛源代码,论坛所需要的功能都有

<!-- #include file="CONN.asp" -->
<!-- #include file="INC/Const.asp" -->
<%
Dim tID,Page,MyThread,x1,x2,fID
tID = HRF(2,2,"tid")
Page = HRF(2,2,"Page")
Set MyThread = New PostClass
MyThread.ShowThread
team.footer

Class PostClass
	Private Board_Setting,Boards,ExtCredits,UClass,UserOnlineinfos,tmp,PageNum,GetNoName

	Private Sub Class_Initialize()
		Dim Rs,Title
		Set Rs=team.Execute("Select forumid,Topic From ["&IsForum&"forum] Where  ID = "& tID)
		If Rs.Eof And Rs.Bof Then
			Team.Error "你查询的版面ID错误。"
		Else
			fID = Rs(0)
			Title = Rs(1)
		End If
		Rs.Close:Set Rs=Nothing
		Cache.Name = "ThreadBoards_"&fid
		Cache.Reloadtime = Cid(team.Forum_setting(44))
		If Cache.ObjIsEmpty() Then
			Set Rs=team.Execute("Select bbsname,Board_Setting,Board_Code,lookperm,Pass From ["&IsForum&"Bbsconfig] Where ID = "& fID)
			If Rs.Eof And Rs.Bof Then 
				Team.Error "你查询的版面ID错误。"
				Exit Sub
				Response.End
			Else
				Boards = Rs.GetRows(-1)
				Cache.Value = Boards
			End If
			RS.Close:Set RS=Nothing
		End If
		Boards = Cache.Value
		If isarray(Boards) Then
			Board_Setting = Split(Boards(1,0),"$$$")
		Else
			team.error " 版块参数错误 。"
		End If
		ExtCredits = Split(team.Club_Class(21),"|")
		UserOnlineinfos = team.UserOnlineinfos
		team.ChooseName = Board_Setting(0)
		team.Headers(Title)
		If Not (Boards(3,0) = ",") Then
			If Instr(Boards(3,0),",") > 0 Then 
				If Not GetUserPower Then team.Error "您没有查看本版的权限"
			End If
		End If
		team.OnlinActions(fID&",查看帖子,"&tiTle)
		If Boards(4,0)<>"" And Not (team.IsMaster Or team.SuperMaster) Then
			If CID(Request.Cookies("Class")("LoginKey"& fid)) = 0 Then
				Response.Redirect "PassKey.asp?fid="&fid&""
			End if
		End If
	End Sub

	Private Function GetUserPower()
		GetUserPower = False
		Dim B_Lookperm,m
		B_Lookperm = Split(Boards(3,0),",")
		If Isarray(B_Lookperm) Then
			For m = 0 to Ubound(B_Lookperm)-1
				If Cid(B_Lookperm(m)) = Int(team.UserGroupID) Then GetUserPower = True
			Next 
		End  If
	End Function

	Public Sub ShowThread()
		Dim RS,Gs,i,emp
		GetNoName = 0

		SQL=" T.ID,T.Topic,T.Username,T.Views,T.Icon,T.Replies,T.Color,T.PostClass,T.Toptopic,T.Locktopic,T.CloseTopic,T.Goodtopic,T.Content,T.Posttime,T.Createpoll,T.Creatdiary,T.Creatactivity,T.Rewardprice,T.Readperm,T.ReList,T.Rewardpricetype,T.Tags,U.Levelname,U.Posttopic,U.Postrevert,U.Goodtopic,U.Regtime,U.Landtime,U.Birthday,U.UserSex,U.Sign,U.UserInfo,U.Honor,U.Userface,U.ID,U.Degree,U.Postblog,U.UserCity,U.UserUp,U.Extcredits0,U.Extcredits1,U.Extcredits2,U.Extcredits3,U.Extcredits4,U.Extcredits5,U.Extcredits6,U.Extcredits7,U.Members,U.Medals,T.Createreward"
		Set Rs = team.Execute("Select TOP 1 "&SQL&" From ["&IsForum&"Forum] T Inner Join ["&IsForum&"User] U On U.UserName=T.UserName Where T.deltopic=0 and T.ID="& tID )
		If Rs.EOF And Rs.BOF Then
			Set Rs = Nothing
			Set Rs = team.Execute("Select TOP 1  ID,Topic,Username,Views,Icon,Replies,Color,PostClass,Toptopic,Locktopic,CloseTopic,Goodtopic,Content,Posttime,Createpoll,Creatdiary,Creatactivity,Rewardprice,Readperm,ReList,Rewardpricetype,Tags From ["&IsForum&"Forum] Where deltopic=0 and ID="& tID )
			If Not (Rs.EOF And Rs.BOF) Then
				UClass = Rs.GetRows(1)
				GetNoName = 1
			End if
		Else
			UClass = Rs.GetRows(1)
		End If
		Rs.Close:Set Rs=Nothing
		If Not IsArray(UClass) Then
			team.Error "此帖子已经被删除或锁定。"
		End If
		X1=UClass(1,0)
		X2=Boards(0,0)
		If Page<2 Then
			tmp = Team.PostHtml (4) & Team.PostHtml (5)
		Else
			tmp = Team.PostHtml (4)
		End if
		tmp = Replace(tmp,"{$wensurl}",team.MenuTitle)
		tmp = Replace(tmp,"{$reid}","Frist")
		tmp = Replace(tmp,"{$showadv}","") '预留广告位
		if Not team.ManageUser and Cid(UClass(9,0)) = 1 Then 
			team.error "此主贴已经被管理员锁定!"
		End If
		If Not TestUserRead Then 
			Team.Error "你没有阅读此帖的权限。"
		End If
		If UClass(21,0)<>"" Then
			Dim TagsUrl,SQL,Tags
			TagsUrl = ""
			If Instr(UClass(21,0),"|")>=0 Then
				Tags = Split(UClass(21,0),"|")
				for i = 0 to Ubound(Tags)
					TagsUrl = TagsUrl & "<A href=""Search.asp?action=seachfile&searchclass=2&searchkey="&Tags(i)&""" target=""_blank""> "& Tags(i) &" </a>"
				Next
			Else
				TagsUrl = TagsUrl & "<A href=""Search.asp?action=seachfile&searchclass=2&searchkey="&UClass(21,0)&""" target=""_blank""> "& UClass(21,0) &" </a>"
			End if
		End If
		tmp = Replace(tmp,"{$istags}",IIf(UClass(21,0)<>"","<BR><BR>关键字："& TagsUrl &"",""))
		If Cid(UClass(14,0))=1 Then
			Call PollAction()	'投票主题
		End If
		If Cid(UClass(16,0))=1 Then
			Call ActionLive()	'活动
		End If
		tmp = Replace(tmp,"{$postactionsinfo}","") '贴间广告
		tmp = Replace(tmp,"{$views}",UClass(3,0))
		tmp = Replace(tmp,"{$forumid}",fid)
		tmp = Replace(tmp,"{$isrept}","TOPS")
		tmp = Replace(tmp,"{$isreid}",UClass(0,0))
		tmp = Replace(tmp,"{$setopic}",SerVer.UrlEncode(UClass(1,0)))
		tmp = Replace(tmp,"{$lasttime}",UClass(13,0))
		tmp = Replace(tmp,"{$notshow}","")
		tmp = Replace(tmp,"{$ismanage}",IIf(team.ManageUser,"<input type=""checkbox"" name=""fismanage"" value="&UClass(0,0)&" class=""radio"">",""))
		tmp = Replace(tmp,"{$topic}",UClass(1,0))
		'没有回复处理
		'T.ID=0,T.Topic=1,T.Username=2,T.Views=3,T.Icon=4,T.Replies=5,T.Color=6,T.PostClass=7,T.Toptopic=8,T.Locktopic=9,T.CloseTopic=10,T.Goodtopic=11,T.Content=12,T.Lasttime=13,T.Createpoll=14,T.Creatdiary=15,T.Creatactivity=16,T.Rewardprice=17,T.Readperm=18,T.ReList=19,T.Rewardpricetype=20,T.Tags=21,U.Levelname=22,U.Posttopic=23,U.Postrevert=24,U.Goodtopic=25,U.Regtime=26,U.Landtime=27,U.Birthday=28,U.serSex=29,U.Sign=30,U.UserInfo=31,U.Honor=32,U.Userface=33,U.ID=34,U.Degree=35,U.Postblog=36,U.UserCity=37,U.UserUp=38,U.Extcredits0=39,U.Extcredits1=40,U.Extcredits2=41,U.Extcredits3=42,U.Extcredits4=43,U.Extcredits5=44,U.Extcredits6=45,U.Extcredits7=46,U.Members=47,U.Medals=48
		If Page<2 Then
			tmp = Replace(tmp,"{$maxi}","楼主&nbsp;&nbsp; [<span onclick='copyurls()' onmouseover=""javascript:this.style.cursor='hand'"" style=""color:red"">点击复制本网址，发给QQ/MSN/UC/POPO好友共享</span>] ")
			tmp = Replace(tmp,"{$rid}","0")
			tmp = Replace(tmp,"{$nameid}",UClass(0,0))
			tmp = Replace(tmp,"{$username}",UClass(2,0))
			tmp = Replace(tmp,"{$topic}",UClass(1,0))
			tmp = Replace(tmp,"{$mod}","a4")
			tmp = Replace(tmp,"{$reward}",iif(Cid(UClass(17,0))=0,"","<img Src="""&team.Styleurl&"/ico.gif"" Border=""0"" Align=""AbsMiddle"" alt=""开始悬赏咯。"">"))
			tmp = Replace(tmp,"{$reaction}","")
			tmp = Replace(tmp,"{$content}",Ubb_Code(UserBad(UClass(12,0),UClass(2,0))) & iif(team.ManageUser and Cid(UClass(9,0)) = 1,"<br /><font color=""red"">==此帖已被锁定==</font>","")) '简单处理
			tmp = Replace(tmp,"{$smallimg}",iif(Cid(UClass(4,0))>0,"<img src=""images/brow/icon"&UClass(4,0)&".gif"" border=""0"" align=""absmiddle"">",""))
			tmp = Replace(tmp,"{$fortopuser}","{$totop_1}{$totop_2}")
			Select Case UClass(8,0)
				Case 1
					tmp = Replace(tmp,"{$totop_1}","<B>本帖已被置顶</B>")
				Case 2
					tmp = Replace(tmp,"{$totop_1}","<B>本帖已被区置顶</B>")
				Case 3
					tmp = Replace(tmp,"{$totop_1}","<B>本帖已被总置顶</B>")
				Case Else
					tmp = Replace(tmp,"{$totop_1}","")
			End Select
			tmp = Replace(tmp,"{$totop_2}",IIf(Cid(UClass(20,0))=0,iif(Cid(UClass(17,0))>0,"[未解决] <img src="""&team.Styleurl&"/point.gif"" align=""absmiddle""> 本帖悬赏"& IIF(Split(ExtCredits(Cid(team.Forum_setting(99))),",")(3)=1," "& Split(ExtCredits(Cid(team.Forum_setting(99))),",")(0)&" "&UClass(17,0)&" "," 本积分未启用 ")&" ",""),iif(Cid(UClass(17,0))>0,"[已解决]本帖悬赏"& IIF(Split(ExtCredits(Cid(team.Forum_setting(99))),",")(3)=1,  " "& Split(ExtCredits(Cid(team.Forum_setting(99))),",")(0)&" "&UClass(17,0)&" "," 本积分未启用 ")&" ","")))
			If GetNoName = 1 Then
				tmp = Replace(tmp,"{$birthday}","")
				tmp = Replace(tmp,"{$usex}","")
				tmp = Replace(tmp,"{$sign}","")
				tmp = Replace(tmp,"{$userqq}","")
				tmp = Replace(tmp,"{$honor}","")
				tmp = Replace(tmp,"{$userimg}","")
				tmp = Replace(tmp,"{$uid}","0")
				tmp = Replace(tmp,"{$levelname}","游客")
				tmp = Replace(tmp,"{$regtime}","未注册")
				tmp = Replace(tmp,"{$postcount}","0")
				tmp = Replace(tmp,"{$online}","<img src="&team.Styleurl&"/offline.gif border='0' align='absmiddle' alt='此用户未登陆!'>")
				tmp = Replace(tmp,"{$masterimg}","")
				tmp = Replace(tmp,"{$userext}","")
				tmp = Replace(tmp,"{$mycity}","")	
				tmp = Replace(tmp,"{$userMedals}","")
			Else
				tmp=Replace(tmp,"{$birthday}",Astro(UClass(28,0)))
				tmp=Replace(tmp,"{$usex}",GetUseSex(UClass(29,0)))
				tmp=Replace(tmp,"{$sign}",iif(UClass(30,0)&""="","","<img src="""&team.Styleurl&"/line.gif"" border=""0""><br><div style=""overflow: hidden; max-height: 6em; maxHeight: 77px;"">"& Sign_Code(UClass(30,0),CID(Split(UClass(22,0),"||")(4)))&"</div>"))
				tmp = Replace(tmp,"{$userqq}",iif(Split(UClass(31,0),"|")(0)&""="","","<a target=blank href=http://wpa.qq.com/msgrd?V=1&Uin="&Split(UClass(31,0),"|")(0)&"&Site=team5.cn&Menu=yes><img border=""0"" SRC=http://wpa.qq.com/pa?p=1:"&Split(UClass(31,0),"|")(0)&":5 alt=""点击这里给我发消息"" onerror=""javascript:this.src='images/qqerr.gif'""></a>"))
				tmp=Replace(tmp,"{$honor}",IIf(UClass(32,0)<>"",UClass(32,0)&"<br>",""))
				tmp=Replace(tmp,"{$userimg}",iif(UClass(33,0)&""="","","<img src="""&UClass(33,0)&""" border=""0"" onload='javascript:if(this.width>100)this.width=100;if(this.height>100)this.height=100;'onerror='javascript:this.src=""images/face/error.gif""'><br>"))
				tmp=Replace(tmp,"{$uid}",UClass(34,0))
				tmp=Replace(tmp,"{$stylename}",Split(UClass(22,0),"||")(1))
				tmp=Replace(tmp,"{$levelname}",Split(UClass(22,0),"||")(0))
				tmp=Replace(tmp,"{$regtime}",FormatDateTime(UClass(26,0),1))
				tmp=Replace(tmp,"{$postcount}",UClass(23,0)+Cid(UClass(24,0)))
				tmp = Replace(tmp,"{$online}",Iif(InStr(UserOnlineinfos,"$$"&UClass(2,0)&"$$")>0, "<img src="&team.Styleurl&"/online.gif border='0' align='absmiddle' alt='此用户在线!&#xA;共计在线时长"&UClass(35,0)&"分钟'>","<img src="&team.Styleurl&"/offline.gif border='0' align='absmiddle' alt='此用户离线!&#xA;共计在线时长"&UClass(35,0)&"分钟'>"))
				tmp = Replace(tmp,"{$masterimg}",UserStar(Split(UClass(22,0),"||")(3))&"<br>"& IIF(Split(UClass(22,0),"||")(2)&""="","","<img src="""&Split(UClass(22,0),"||")(2)&""" border=""0"">") &"<br>")
				If CID(UClass(25,0))>0 Then
					emp = emp & "精华&nbsp;" & UClass(25,0) & "&nbsp;<br />"
				End if
				for i = 0 to ubound(ExtCredits)
					If Split(ExtCredits(i),",")(4) =1 Then
						emp = emp & ""& Split(ExtCredits(i),",")(0) & "&nbsp;"& UClass(39 + i,0) &"&nbsp;"& Split(ExtCredits(i),",")(1) &" <br />"
					End if
				Next
				tmp = Replace(tmp,"{$userext}",emp)
				tmp = Replace(tmp,"{$mycity}",iif(UClass(37,0)<>""," 来自 "&UClass(37,0)&" <br>",""))
				Dim UserMedals
				If UClass(48,0)<>"" Then
					UserMedals = "" : Emp = ""
					If Instr(UClass(48,0),"$$$")>0 Then
						UserMedals = Split(UClass(48,0),"$$$")
						For i = 0 to Ubound(UserMedals)-1
							Emp = Emp & "<img src=""images/plus/medal"&Split(UserMedals(i),"&&&")(0)&".gif"" align=""absmiddle"" alt="""&Split(UserMedals(i),"&&&")(1)&"""> "
						Next
						tmp = Replace(tmp,"{$userMedals}",Emp)
					End if
				Else
					tmp = Replace(tmp,"{$userMedals}","")
				End if
			End If
		End If
		If Cid(UClass(5,0))>0 Then
			tmp = tmp & ReMyTopic
		End If
		tmp =  tmp & Team.PostHtml (6)
		tmp = Replace(tmp,"{$istags}","")
		tmp = Replace(tmp,"{$closemanages}",IIF(team.ManageUser,"","None"))
		tmp = Replace(tmp,"{$tid}",tID)
		tmp = Replace(tmp,"{$surl}",IIF(Request("seesmile")="yes","Thread.asp?tid="& tID & "",team.ActUrl &"&seesmile=yes"))
		tmp = Replace(tmp,"{$surlalt}",IIF(Request("seesmile")="yes","显示关闭","显示更多"))
		tmp = Replace(tmp,"{$maxsml}",iif(Request("seesmile")="yes",Cid(team.Forum_setting(87)),15))
		tmp = IIF(team.Forum_setting(29) = 0 or UClass(10,0) = 1,iHtmlEncode(TempCode(HtmlEncode(tmp),"eazypost")),iHtmlEncode(BlackTmp(HtmlEncode(tmp),"eazypost")) )
		tmp = Replace(tmp,"{$eazys}",iif(team.Forum_setting(48)=2,"","display:None"))
		tmp = Replace(tmp,"{$fid}",fID)
		tmp = Replace(tmp,"{$rid}",tID)
		tmp = Replace(tmp,"{$TotalPage}",PageNum)
		tmp = Replace(tmp,"{$allPage}",UClass(5,0))
		tmp = Replace(tmp,"{$abouttags}",AboutTipoc)	'相关主题
		Echo tmp
		team.execute("Update ["&IsForum&"Forum] Set Views=Views+1  Where ID="& tID )
	End Sub

	Private Function AboutTipoc()
		Dim TagWhere,Gs,Tagtmp,Tags,i
		TagWhere = ""
		If UClass(21,0)&"" = "" Then
			Exit Function
		End if
		If Instr(UClass(21,0),"|")>=0 Then
			Tags = Split(UClass(21,0),"|")
			for i = 0 to Ubound(Tags)
				If i = 0 Then
					If IsSqlDataBase = 1 Then
						TagWhere = " Topic like '%"&HtmlEncode(Tags(i))&"%' "
					Else
						TagWhere = " InStr(1,LCase(Topic),LCase('"&HtmlEncode(Tags(i))&"'),0)<>0 "
					End if
				Else
					If IsSqlDataBase = 1 Then
						TagWhere = TagWhere & " or Topic like '%"&HtmlEncode(Tags(i))&"%' "
					Else
						TagWhere = TagWhere & " or InStr(1,LCase(Topic),LCase('"&HtmlEncode(Tags(i))&"'),0)<>0 "
					End if