show.asp

正版创力4.1SQL商业版!!!ASP版。

<!--#include file="Setting.asp"-->
<%
Response.Expires = -1
Response.CacheControl = "no-cache"
Dim Rs,SQL,InfoTitle,InfoUpdateTime
Dim LoopStr,ReplaceStr,ContentStr
Dim regEx,sTemp
Dim Matches,Match,TempValue,ArrayStr,DataStr
Dim TotalPut,CurrentPage,TotalPages,PageSize

Cl.Get_WebSetting
Cl.ChkUserLogin
PageSize	= 30
CommentID	= Cl.GetClng(Request("CommentID"))
if CommentID = 0 then Call Cl.OutMsg(0,"请指定回复评论ID！",ComeUrl)

Select Case Action
Case "save"
	Call SaveReply()
Case Else
	Call WriteReply()
End Select
Cl.Title = InfoTitle & "[回复评论]"
Response.write Template.ReplaceAllFlag(TempStr)

Sub WriteReply()
	if not Cl.ChkUserGroupID(Cl.Web_Setting(34),Cl.UserGroupID) then 
		Call Cl.OutErr(0,Cl.Language.SelectSingleNode("//NoLoginErr").text)
	end if
	SQL="Select * from Cl_Comment Where CommentID = " & CommentID & " and Status=1"
	Set Rs = Cl.Execute(SQL)
	If Rs.Eof Then
		Rs.Close : Set Rs = Nothing
		Call Cl.OutErr(0,"找不到指定评论！")
	End If
	ChannelID = Rs("ChannelID")
	InfoID = Rs("InfoID")
	Cl.Get_ChannelSetting(ChannelID)
	ModuleID = Cl.GetClng(Cl.Channel.selectSingleNode("@moduleid").text)
	Select Case ModuleID
	Case 1 : SQL="Select Title,UpdateTime from Cl_Article Where InfoID = "&InfoID
	Case 2 : SQL="Select SoftName,UpdateTime from Cl_Soft Where InfoID = "&InfoID
	Case 3 : SQL="Select PhotoName,UpdateTime from Cl_Photo Where InfoID = "&InfoID
	Case 4 : SQL="Select MovieName,UpdateTime from Cl_Movie Where InfoID = "&InfoID
	Case 5 : SQL="Select ProductName,UpdateTime from Cl_Product Where InfoID = "&InfoID
	Case Else : SQL="Select Title,UpdateTime from Cl_Article Where InfoID = "&InfoID
	End Select
	Dim tRs
	Set tRs = Cl.Execute(SQL)
	If tRs.Eof Then
		Call Cl.OutErr(0,replace(Cl.Language.SelectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.Channel.SelectSingleNode("@channelitemname").text))
	End if
	InfoTitle	= tRs(0)
	InfoUpdateTime= tRs(1)
	tRs.Close : Set tRs = Nothing
	TempStr = Template.Read(TemplateShow)
	Set regEx	= New RegExp
	regEx.IgnoreCase= True
	regEx.Global	= True
	regEx.Pattern	= "{\$.[^{\$}]*}"
	Rem 处理回复
	LoopStr = Template.GetPartContent(TempStr,"[Cl_Loop]","[/Cl_Loop]")
	ReplaceStr = "[Cl_Loop]" & LoopStr & "[/Cl_Loop]"
	SQL = "select * from Cl_Comment where ParentID=" & CommentID & " and Status=1 order by ParentID asc,CommentID desc"
	Dim RsReply
	Set RsReply = Server.CreateObject("ADODB.Recordset")
	OpenConn : RsReply.open SQL,Conn,1,1
	If RsReply.bof and RsReply.eof then
		TempStr = Replace(TempStr,ReplaceStr,"")
		TempStr = Replace(TempStr,"{$showpage}","")
	Else
		Dim tPageSize
		tPageSize = PageSize
		TotalPut = RsReply.recordcount + 1
		if (TotalPut mod PageSize)=0 then
			TotalPages = TotalPut \ PageSize
		else
			TotalPages = TotalPut \ PageSize + 1
		end if
		if CurrentPage > TotalPages then CurrentPage=TotalPages
		if CurrentPage < 2 then
			CurrentPage=1 : tPageSize = tPageSize - 1
		else
			RsReply.move (CurrentPage-1)*PageSize - 1
		end If

		For i=0 To tPageSize
			sTemp = LoopStr
			On Error Resume Next
			Set Matches		= regEx.Execute(sTemp)
			For Each Match in Matches
				ArrayStr	= Match.Value
				ArrayStr	= Replace(ArrayStr,"{$","")
				ArrayStr	= Replace(ArrayStr,"}","")
				Select Case ArrayStr
				Case "usergroupname"
					DataStr = Cl.GetUserGroupName(RsReply("UserGroupID"))
				Case "commentcontent"
					DataStr = Cl.UbbCode(RsReply("CommentContent"))
					if RsReply("IsReply")=1 then
						DataStr = DataStr & "<br />&nbsp;&nbsp;&nbsp;&nbsp;<font color=""#009900"">★</font>&nbsp;『<font color=""blue"">" & RsReply("ReplyUser") & "</font>』于 " & RsReply("ReplyTime") & " 回复道：&nbsp;&nbsp;&nbsp;&nbsp;" & ClUbb.UbbCode(Rs("ReplyContent"))
					end If
					If RsReply("ParentID")>0 And CommentID<>RsReply("ParentID") Then
						DataStr = DataStr & Cl.Language.SelectSingleNode("//Comment/ParentContent").text
						DataStr = Replace(DataStr,"{$parentid}",RsReply("ParentID"))
						DataStr = Replace(DataStr,"{$parentcontent}",RsReply("ParentContent"))
					End if
				Case "userip"
					If RsReply("Hidden")=1 Then
						DataStr = "隐藏"
					Else
						DataStr = RsReply("UserIP")
					End If
				Case "csspicurl","webdir","installdir"
					DataStr = Match.Value
				Case Else
					DataStr = RsReply(ArrayStr)
				End Select
				sTemp = Replace(sTemp,Match.Value,DataStr)
				ArrayStr = Empty
			Next
			Set Matches		= Nothing
			On Error Goto 0
			ContentStr = ContentStr & sTemp
			RsReply.MoveNext
			If RsReply.Eof Then Exit For
		Next
		TempStr = Replace(TempStr,ReplaceStr,ContentStr)
		TempStr = Replace(TempStr,"{$showpage}",Cl.ShowPage("Show.asp?CommentID=" & CommentID,TotalPut,PageSize,"条","评论"))
	End If
	RsReply.close : set RsReply=Nothing

	Rem 处理原贴
	LoopStr = Template.GetPartContent(TempStr,"[Cl_Topic]","[/Cl_Topic]")
	ReplaceStr = "[Cl_Topic]" & LoopStr & "[/Cl_Topic]"
	If CurrentPage>1 Then
		sTemp	= ""
	else
		'On Error Resume Next
		sTemp	= LoopStr
		Set Matches		= regEx.Execute(sTemp)
		For Each Match in Matches
			ArrayStr	= Match.Value
			ArrayStr	= Replace(ArrayStr,"{$","")
			ArrayStr	= Replace(ArrayStr,"}","")
			Select Case ArrayStr
			Case "usergroupname"
				DataStr = Cl.GetUserGroupName(Rs("UserGroupID"))
			Case "commentcontent"
				DataStr = Cl.UbbCode(Rs("CommentContent"))
				If Rs("ParentID")>0 And CommentID<>Rs("ParentID") Then
					DataStr = DataStr & Cl.Language.SelectSingleNode("//Comment/ParentContent").text
					DataStr = Replace(DataStr,"{$parentid}",Rs("ParentID"))
					DataStr = Replace(DataStr,"{$parentcontent}",Rs("ParentContent"))
				End if
			Case "userip"
				If Rs("Hidden")=1 Then
					DataStr = "隐藏"
				Else
					DataStr = Rs("UserIP")
				End If
			Case "csspicurl","webdir","installdir"
				DataStr = Match.Value
			Case Else
				DataStr = Rs(ArrayStr)
			End Select
			sTemp = Replace(sTemp,Match.Value,DataStr)
			ArrayStr = Empty
		Next
		Set Matches		= Nothing
		On Error Goto 0
	End If
	Rs.Close : Set Rs = Nothing
	TempStr = Replace(TempStr,ReplaceStr,sTemp)
	LoopStr = Empty
	ReplaceStr = Empty
	Set regEx	= Nothing
	Rem 其它处理
	TempStr = Replace(TempStr,"{$commentid}",CommentID)
	TempStr = Replace(TempStr,"{$infoid}",InfoID)
	TempStr = Replace(TempStr,"{$channelid}",ChannelID)
	TempStr = Replace(TempStr,"{$infotitle}",InfoTitle)
	TempStr = Replace(TempStr,"{$infoupdatetime}",InfoUpdateTime)
	TempStr = Replace(TempStr,"{$webdir}",InstallDir)
	If Cl.UserID>0 Then
	TempStr = Replace(TempStr,"{$username}",Cl.MemberName)
	TempStr = Replace(TempStr,"{$useremail}",Cl.User_Info(7))
	TempStr = Replace(TempStr,"{$isdisabled}"," disabled")
	Else
	TempStr = Replace(TempStr,"{$username}",Cl.GetUserGroupName(Cl.UserGroupID))
	TempStr = Replace(TempStr,"{$useremail}",Cl.Web_Info(8))
	TempStr = Replace(TempStr,"{$isdisabled}","")
	End If
	TempStr = Replace(TempStr,"{$usevalidcode}",UseValidCode)
	TempStr = Replace(TempStr,"{$usergroupname}",Cl.GetUserGroupName(Cl.UserGroupID))
	TempStr = Replace(TempStr,"{$comeurl}",ComeUrl)
end sub

sub SaveReply()
	if Cl.ChkIsOuter then Call Cl.OutMsg(0,"请不要从外部访问此文件！","Index.asp")
	if not Cl.ChkUserGroupID(Cl.Web_Setting(34),Cl.UserGroupID) then 
		Call Cl.OutErr(0,Cl.Language.SelectSingleNode("//NoLoginErr").text)
	end if
	Dim rsComment,ClassID,tClass,IsNoPassed,SucMsg
	Dim UserName,UserEmail,Hidden
	Dim CommentContent,ReplyContent,Argue,PKStatus
	Dim CommentTitle,AgreeContent,DisAgreeContent
	IsNoPassed=True
	If UseValidCode=1 Then
		If Not Cl.CodeIsTrue(Trim(request.Form("Comment_ValidCode")),"Comment_ValidCode") then
		Call Cl.OutErr(0,"验证码不正确，请刷新页面重新输入")
		End if
	End if
	if Cl.UserID>0 Then
		UserName	= Trim(Cl.MemberName)
		UserEmail	= Trim(Cl.User_Info(7))
	else
		UserName	= Trim(request.Form("UserName"))
		UserEmail	= Trim(request.Form("UserEmail"))
		if UserName="" Then UserName = Cl.GetUserGroupName(Cl.UserGroupID)
		'	Call Cl.OutMsg(0,"<br /><li>请输入您的姓名</li>","-1")
		'end if
		If Not Cl.ChkEmail(UserEmail) Then UserEmail = Cl.Web_Info(8)
		'	Call Cl.OutMsg(0,"<br /><li>请输入您的邮箱</li>","-1")
		'end if
	end If
	Argue	= Cl.GetClng(request.Form("Argue"))
	Hidden	= Cl.GetClng(request.Form("Hidden"))
	PKStatus= Cl.GetClng(request.Form("PKStatus"))
	CommentTitle = Trim(request.Form("CommentTitle"))
	AgreeContent = Trim(request.Form("AgreeContent"))
	DisAgreeContent = Trim(request.Form("DisAgreeContent"))
	ReplyContent = Trim(request.Form("CommentContent"))
	If PKStatus<>0 Then
		If PKStatus<>1 Then PKStatus=-1
	End if
	If Argue = 1 Then
		If AgreeContent="" Or DisAgreeContent="" Then
		Call Cl.OutMsg(0,"<br /><li>请输入辨题正方及反方观点！</li>","-1")
		End If
		ReplyContent = AgreeContent & "[PK]" & DisAgreeContent
	Else
		Argue = 0
	End if
	if ReplyContent = "" then
		Call Cl.OutMsg(0,"<br /><li>请输入评论内容</li>","-1")
	end if
	ReplyContent = Cl.HTMLEncode(ReplyContent)
	if Cl.Web_Setting(3)="Yes" then  '脏话过滤
	ReplyContent = Cl.ChkBadWords(ReplyContent)
	end If
	SQL="Select * from Cl_Comment Where CommentID = " & CommentID & " and Status=1"
	Set Rs = Cl.Execute(SQL)
	If Rs.Eof Then
		Rs.Close : Set Rs = Nothing
		Call Cl.OutErr(0,"找不到指定评论！")
	End if
	ChannelID	= Rs("ChannelID")
	InfoID		= Rs("InfoID")
	CommentContent = Rs("CommentContent")
	Rs.Close : Set Rs = Nothing
	Cl.Load_ChannelSetting(ChannelID)
	Select Case CLng(Cl.Channel.SelectSingleNode("@moduleid").text)
	Case 1
	set tClass=Cl.Execute("select ClassID from Cl_Article where InfoID=" & InfoID)
	Case 2
	set tClass=Cl.Execute("select ClassID from Cl_Soft where InfoID=" & InfoID)
	Case 3
	set tClass=Cl.Execute("select ClassID from Cl_Photo where InfoID=" & InfoID)
	Case 4
	set tClass=Cl.Execute("select ClassID from Cl_Movie where InfoID=" & InfoID)
	Case 5
	set tClass=Cl.Execute("select ClassID from Cl_Product where InfoID=" & InfoID)
	Case Else
	set tClass=Cl.Execute("select ClassID from Cl_Article where InfoID=" & InfoID)
	end Select
	if tClass.bof and tClass.eof then
		Call Cl.OutErr(0,replace(Cl.Language.SelectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.Channel.SelectSingleNode("@channelitemname").text))
	else
		ClassID=tClass(0)
	end if
	set tClass=Cl.Execute("Select CommentGroup,CommentIsChk From Cl_Class where ClassID="&Clng(ClassID))
	if tClass.bof and tClass.eof then
		Call Cl.OutMsg(0,"找不到指定文章栏目！",ComeUrl)
	End if
	if Not Cl.ChkUserGroupID(tClass(0),Cl.UserGroupID) then
		Call Cl.OutMsg(0,"对不起，此栏目只有 “"&Cl.GetUserGroupName(tClass(0))&"” 方可发表评论！",ComeUrl)
	end if
	IsNoPassed=tClass(1)
	set tClass=Nothing
	set rsComment=server.createobject("adodb.recordset")
	sql="select Top 1 * from Cl_Comment"
	OpenConn : rsComment.open sql,Conn,1,3
	rsComment.addnew
	rsComment("ChannelID")	= ChannelID
	rsComment("InfoID")		= InfoID
	rsComment("UserID")		= Cl.UserID
	rsComment("UserName")	= UserName
	rsComment("UserGroupID")= Cl.UserGroupID
	rsComment("UserEmail")	= UserEmail
	rsComment("UserIP")		= Cl.UserTrueIP
	rsComment("CommentContent")	= ReplyContent
	rsComment("CommentTime")= now()
	rsComment("Hidden")		= Hidden
	rsComment("ParentID")	= CommentID
	rsComment("ParentContent")= CommentContent
	rsComment("Argue")		= Argue
	rsComment("PKStatus")	= PKStatus
	if IsNoPassed=True then
		rsComment("Status") = 0
		SucMsg="发表评论成功，等待管理员审核后通过。点击返回！"
	else
		rsComment("Status") = 1
		SucMsg="发表评论成功，点击返回！"
	end if
	rsComment.update
	rsComment.close:set rsComment=Nothing
	if IsNoPassed=True then
	Cl.Execute("update Cl_Comment Set ReplyCount=ReplyCount+1 Where CommentID="&CommentID&"")
	End if
	Call Cl.OutMsg(0,SucMsg,"-1")'"Show.asp?CommentID=" & CommentID
end sub

' 更新Session
Sub ReSessionCedID()
	Dim sSCID,sSPCID
	sSCID=Session("CommentedID")
	if Trim(sSCID)="" then
		sSCID="#" & ChannelID & "|" & InfoID & "#"
	else
		sSCID=left(sSCID,len(sSCID)-1)
		sSCID=right(sSCID,len(sSCID)-1)
		sSPCID=split(sSCID,"#")
		if Ubound(sSPCID) < 50 then
			sSCID="#" & sSCID & "#" & ChannelID & "|" & InfoID & "#"
		else
			sSCID=replace("#" & sSCID,"#" & sSCID(0) & "#","#") & "#" & ChannelID & "|" & InfoID & "#"
		end if
	end if
	Session("CommentedID")=sSCID
End Sub
%>