post.asp

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

				ismaste = "<INPUT name=""istop"" type=""checkbox"" value=""1"" class=""checkbox"" /> 置顶主题<br/><INPUT name=""isgood"" type=""checkbox"" value=""1"" class=""checkbox"" />  加为精华<br><INPUT name=""islocks"" type=""checkbox"" value=""1"" class=""checkbox"" />  锁定主题<br>"
			End if
			If team.UserLoginED=True Then
				ismaste = "<input class=""checkbox"" type=""checkbox"" name=""todiary"" value=""1""> 加入文集<br>"
			End If
			If Rs(7) = 1 Then
				ismaste = ismaste & "<input name=""creatactivity"" type=""checkbox"" id=""creatactivity"" value=""1"" class=""checkbox"" CHECKED/> 发起活动</label> "
			End if
			tmp = Replace(tmp,"{$managesif}",ismaste)
			If CID(Rs(5))=1 Then
				Set Rs1 = team.execute("Select PollClose,Pollday,PollMax,Polltime,Pollmult,Polltopic From   ["&Isforum&"FVote] Where Rootid="& tID)
				If Not Rs1.Eof Then
					Dim Vomp,Vimp,i
					tmp = Replace(tmp,"{$enddatetime}",Rs1(1))
					tmp = Replace(tmp,"{$maxchoices}",Rs1(2))
					tmp = Replace(tmp,"{$pollaction}","Display:None")
					tmp = Replace(tmp,"{$pollcheck}",iif(Rs1(4)=1,"checked",""))
					tmp = Replace(tmp,"{$ischenks}",iif(Rs1(4)=1,"","display:none"))
					tmp = Replace(tmp,"{$closepoll}","<input class=""checkbox"" type=""checkbox"" name=""closevote"" value=""1""> 关闭投票<br>")
					If Instr(Rs1(5),"|")>0 Then
						Vomp = Split(Rs1(5),"|")
						for i = 0 to Ubound(Vomp)
							Vimp = Vimp &" <input type=""text"" size=""70"" name=""pollitemid"" value="""&Vomp(i)&""" class=""colorblur"" onfocus=""this.className='colorfocus';"" onblur=""this.className='colorblur';"" /> "
						next
					End if
					tmp = Replace(tmp,"{$editpoll}",iif(Rs1(0)=1,"投票已关闭",Vimp))
				End if
				Rs1.Close:Set Rs1=Nothing
			End if
			If CID(Rs(7))=1 Then
				Set Rs1 = team.execute("Select PlayName,PlayCity,Playplace,PlayClass,PlayFrom,Playto,PlayCost,PlayGender,PlayNum,PlayStop,PlayUserNum From   ["&Isforum&"Activity] Where Rootid="& tID)
				If Not Rs1.Eof Then
					tmp = Replace(tmp,"{$activityname}",Rs1(0)&"")
					tmp = Replace(tmp,"{$activitycity}",Rs1(1)&"")
					tmp = Replace(tmp,"{$activityplace}",Rs1(2)&"")
					tmp = Replace(tmp,"{$activityclass}",Rs1(3)&"")
					tmp = Replace(tmp,"{$starttimefrom}",Rs1(4))
					tmp = Replace(tmp,"{$starttimeto}",Rs1(5)&"")
					tmp = Replace(tmp,"{$cost}",Rs1(6))
					tmp = Replace(tmp,"{$activitynumber}",Rs1(8))
					tmp = Replace(tmp,"{$activityexpiration}",Rs1(9))
				End if
				Rs1.Close:Set Rs1=Nothing
			End if
			If CID(Rs(8))=1 Then
				tmp = Replace(tmp,"{$rewardprice}",Rs(9))
			End if
		End If
		tmp = Replace(tmp,"{$mycolor}",IIf(team.ManageUser,"","None"))
		tmp = Replace(tmp,"{$postcolor}","")
		tmp = Replace(tmp,"{$maxupfile}",team.Forum_setting(71))
		Dim PostRanNum
		Randomize
		PostRanNum = Int(900*rnd)+1000
		Session("UploadCode") = Cstr(PostRanNum)
		tmp = Replace(tmp,"{$filetype}",Replace(team.Forum_setting(73),"|",","))
		tmp = Replace(tmp,"{$postrannum}",PostRanNum)
		tmp = Replace(tmp,"{$tid}",tID)
		tmp = Replace(tmp,"{$oneups}",CID(team.Group_Browse(26)))
		Echo tmp
	End if
End Sub

Sub replays
	Dim tmp,ismaste
	Dim ExtCredits
	Titles = "回复帖子"
	ConfigSet()
	X1="回复帖子"
	X2 = Boards(2,0)
	Call NewUserpostTime()
	ExtCredits = Split(team.Club_Class(21),"|")
	tmp = iHtmlEncode(TempCode(HtmlEncode(Team.PostHtml (8)),"postaction"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"postinfo"))
	tmp = Replace(tmp,"{$weburl}",team.MenuTitle)
	tmp = Replace(tmp,"{$username}",TK_UserName)
	tmp = Replace(tmp,"{$posttime}",Now())
	tmp = Replace(tmp,"{$readperm}","0")
	tmp = Replace(tmp,"{$topics}","")
	tmp = Replace(tmp,"{$ischecked}","")
	tmp = Replace(tmp,"{$mycolor}","None")
	tmp = Replace(tmp,"{$resubjet}","<tr><td class=""altbg1"" class=""bold""> 标题 </td><td class=""altbg2"">  <input type=""text"" name=""subject"" id=""subject"" size=""45"" value="""" tabindex=""103"" onBlur=""this.className='colorblur';"" onfocus=""this.className='colorfocus';"" class=""colorblur""> (选填)</td></tr>")
	tmp = Replace(tmp,"{$postmax}",Cid(team.Forum_setting(67)))
	tmp = Replace(tmp,"{$postmin}",cid(team.Forum_setting(64)))
	tmp = Replace(tmp,"{$topicmax}",cid(team.Forum_setting(89)))
	tmp = Replace(tmp,"{$display}",iif(Cid(team.Forum_setting(48))=2,"","display:none"))
	tmp = Replace(tmp,"{$pollmaxto}",cid(team.Forum_setting(68)))
	tmp = Replace(tmp,"{$msgcache}","0")
	If Request("quote") = 1 Then
		Dim Rs
		Set Rs = team.execute("select Content,ReList From ["&IsForum&"Forum] Where Deltopic = 0 and CloseTopic = 0 and ID="&tID)
		If Rs.Eof Then
			team.Error "您回复的帖子ID错误。"
		Else
			If Request("isrept") = "TOPS" Or Not IsNumeric(Request("isrept")) then	
				tmp = Replace(tmp,"{$messages}","[quote]"& EditConts(ReCode(Rs(0))) &"[/quote]")
			Else
				Set Rs = team.execute("select content from ["&IsForum & RS(1) &"] Where ID="& HRF(2,2,"isrept") )
				If Rs.Eof Then
					team.Error "您引用的帖子ID错误。"
				Else
					tmp = Replace(tmp,"{$messages}","[quote]"& EditConts(ReCode(Rs(0))) &"[/quote]")
				End if
			End if
		End If
		Rs.Close:Set Rs=Nothing
	Else
		tmp = Replace(tmp,"{$messages}","")
	End if
	tmp = Replace(tmp,"{$postcolor}","")
	tmp = Replace(tmp,"{$dispoll}","display:none")
	tmp = Replace(tmp,"{$disactivity}","display:none")
	tmp = Replace(tmp,"{$disreward}","display:none")
	tmp = Replace(tmp,"{$enddatetime}","0")
	tmp = Replace(tmp,"{$maxchoices}","10")
	tmp = Replace(tmp,"{$pollaction}","")
	tmp = Replace(tmp,"{$editpoll}","")
	tmp = Replace(tmp,"{$activityname}","")
	tmp = Replace(tmp,"{$activitycity}","")
	tmp = Replace(tmp,"{$activityplace}","")
	tmp = Replace(tmp,"{$activityclass}","")
	tmp = Replace(tmp,"{$starttimefrom}","")
	tmp = Replace(tmp,"{$starttimeto}","")
	tmp = Replace(tmp,"{$cost}","0")
	tmp = Replace(tmp,"{$activitynumber}","")
	tmp = Replace(tmp,"{$activityexpiration}","")
	tmp = Replace(tmp,"{$rewardprice}","1")
	tmp = Replace(tmp,"{$pollcheck}","")
	tmp = Replace(tmp,"{$closepoll}","")
	tmp = Replace(tmp,"{$ischenks}","display:none")
	tmp = Replace(tmp,"{$distag}","")
	tmp = Replace(tmp,"{$tags}","")
	tmp = Replace(tmp,"{$fid}",Fid)
	tmp = Replace(tmp,"{$actions}","resaves&amp;tid="&tid&"")
	tmp = Replace(tmp,"{$revenue}",team.Forum_setting(11))
	tmp = Replace(tmp,"{$wrname}",IIF(Split(ExtCredits(Cid(team.Forum_setting(99))),",")(3)=1,  " ( "& Split(ExtCredits(Cid(team.Forum_setting(99))),",")(0)&" ) "," (本积分未启用) "))
	tmp = Replace(tmp,"{$setmode}",Cid(team.Forum_setting(98)))
	tmp = Replace(tmp,"{$maxsml}",iif(Request("seesmile")="yes",Cid(team.Forum_setting(87)),15))
	tmp = Replace(tmp,"{$surl}",team.ActUrl)
	tmp = Replace(tmp,"{$postaction}","回复帖子")
	tmp = Replace(tmp,"{$managesif}","")
	tmp = Replace(tmp,"{$maxupfile}",team.Forum_setting(71))
	Dim PostRanNum
	Randomize
	PostRanNum = Int(900*rnd)+1000
	Session("UploadCode") = Cstr(PostRanNum)
	tmp = Replace(tmp,"{$filetype}",Replace(team.Forum_setting(73),"|",","))
	tmp = Replace(tmp,"{$postrannum}",PostRanNum)
	tmp = Replace(tmp,"{$tid}",tID)
	tmp = Replace(tmp,"{$oneups}",CID(team.Group_Browse(26)))
	Echo tmp
End Sub



Sub ConfigSet()
	Dim Rs
	Cache.Name = "Boards_"&Fid
	Cache.Reloadtime = Cid(team.Forum_setting(44))
	If Not Cache.ObjIsEmpty() Then
		Boards = Cache.Value
	Else
		Set Rs=team.Execute("Select ID,Followid,bbsname,Board_Setting,Hide,Pass,Icon,Ismaster,Board_Key,Board_URL,toltopic,tolrestore,Board_Code From ["&IsForum&"Bbsconfig] Where  ID = "& Fid)
		If Rs.Eof Then 
			Team.Error "你查询的版面ID错误。"
			Exit Sub
		Else
			Boards = Rs.GetRows(-1)
			Cache.Value = Boards
		End If
		RS.Close:Set RS=Nothing
	End If
	If isarray(Boards) Then
		Board_Setting = Split(Boards(3,0),"$$$")
	End if
	team.Headers(Boards(2,0) & " - " & Titles)
	team.ChkPost()
	'If CID(team.Forum_setting(107)) = 0 Then
		If Not team.UserLoginED Then team.Error " 您所在的组没有此动作的权限。"
	'End If
End Sub

Function EditConts(Str)
	If Str="" Or IsNull(Str) Then Exit Function
	Dim s,re
	s = Str
	EditConts = EdContent(UBB_Code(s))
End Function

'过虑多余的引用代码
Function ReCode(strContent)
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="\[quote\](.*?)\[\/quote\]"
	strContent=re.Replace(strContent,"")
	set re=Nothing
	ReCode=strContent
End Function

'过虑多余的编辑代码
Function EdContent(strContent)
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="<p align=right><font color=#000066>(.*?)<\/font><\/p>"
	strContent=re.Replace(strContent,"")
	set re=Nothing
	EdContent = Server.HtmlEncode(strContent)
End Function

Sub NewUserpostTime()
	'If CID(team.Forum_setting(107)) = 1 Then Exit Sub
	If Cid(team.Forum_setting(14))>0 And team.UserLoginED And Not team.ManageUser Then
		If Not IsDate(team.User_SysTem(9)) Then team.User_SysTem(9) = Now()
		If DateDiff("n",CDate(team.User_SysTem(9)),Now()) < Cid(team.Forum_setting(14)) Then 
			team.error "新注册用户必须停留 <font color=red> "&team.Forum_setting(14)&" </font> 分钟以上才可发表帖子。"
		End if
	End If
End Sub
team.footer
%>