<% Cl.GetWeb_Setting Cl.ChkUserLogin dim InfoID,CommentID,Action dim ErrMsg,FoundErr,ComeUrl dim strHTML,i Dim ModuleID,ChannelID ChannelID=Cl.ChkClng(request("ChannelID")) Action=Lcase(Trim(request("Action"))) InfoID=Cl.ChkClng(request("InfoID")) ComeUrl=Trim(Request("ComeUrl")) if ComeUrl="" then ComeUrl=Request.ServerVariables("HTTP_REFERER") if ComeUrl="" then ConeUrl="Index.asp" end if Select Case Action Case "js" ShowCommentJs Case "check" CommectCheck Case Else ShowMain End Select Sub ShowMain() if InfoID=0 then Call Cl.OutMsg("请指定评论ID!",ComeUrl) if ChannelID=0 then Call Cl.OutMsg("请指定频道ID",ComeUrl) Cl.GetChannelSetting(ChannelID) ModuleID=Cl.ChkCLng(Cl.Channel_Setting(20)) strHTML="" Select Case Action Case "save" strHTML=strHTML&"保存评论" Case "write" strHTML=strHTML&"发表评论" Case Else strHTML=strHTML&"显示所有评论" end Select strHTML=strHTML&"" & vbcrlf strHTML=strHTML&"" & vbcrlf strHTML=strHTML&"" & vbcrlf strHTML=strHTML&"" & vbcrlf strHTML=strHTML&"" strHTML=strHTML&"" Select Case Action Case "save" call SaveComment() Case "write" call WriteComment() Case Else call ShowAllComment() end Select if FoundErr=True then Cl.OutErr(ErrMsg) end if strHTML=strHTML&"" Response.write strHTML End Sub Sub ShowAllComment() dim rsComment,sqlComment sqlComment="select M.CommentID,M.InfoID,M.ClassID,M.UserLevel,M.UserName,M.Email,M.WriteTime,M.Score,M.Content,M.ReplyContent,M.ReplyName,M.ReplyTime,M.Passed," Select Case ModuleID Case 1 sqlComment=sqlComment&"I.Title,I.UpdateTime,I.ArticleID from Cl_Comment M inner join Cl_Article I on M.InfoID=I.ArticleID" Case 2 sqlComment=sqlComment&"I.SoftName,I.UpdateTime,I.SoftID from Cl_Comment M inner join Cl_Soft I on M.InfoID=I.SoftID" Case 3 sqlComment=sqlComment&"I.PhotoName,I.UpdateTime,I.PhotoID from Cl_Comment M inner join Cl_Photo I on M.InfoID=I.PhotoID" Case 4 sqlComment=sqlComment&"I.MovieName,I.UpdateTime,I.MovieID from Cl_Comment M inner join Cl_Movie I on M.InfoID=I.MovieID" Case 5 sqlComment=sqlComment&"I.ProductName,I.UpdateTime,I.ProductID from Cl_Comment M inner join Cl_Product I on M.InfoID=I.ProductID" Case Else sqlComment=sqlComment&"I.Title,I.UpdateTime,I.ArticleID from Cl_Comment M inner join Cl_Article I on M.InfoID=I.ArticleID" End Select if Cl.UserLevel=1 then sqlComment=sqlComment&" where M.ChannelID="&ChannelID&" and M.InfoID=" & InfoID & " order by M.Passed desc,M.CommentID desc" else sqlComment=sqlComment&" where M.ChannelID="&ChannelID&" and M.InfoID=" & InfoID & " and M.Passed=True order by M.CommentID desc" end if Set rsComment= Server.CreateObject("ADODB.Recordset") OpenConn : rsComment.open sqlComment,Conn,1,1 If rsComment.bof and rsComment.eof then rsComment.close:set rsComment=Nothing strHTML=strHTML & "    没有任何评论" Exit Sub End if strHTML=strHTML&"" strHTML=strHTML&"" strHTML=strHTML&"" strHTML=strHTML&"" strHTML=strHTML & "" strHTML=strHTML & "
" & rsComment(13)& " ["& formatdatetime(rsComment(14),2) &"]
 我也要评论      注:评论内容只代表网友观点,与本站立场无关!
" dim UserIM,sTemp,i Set ClUbb= New Cls_UbbCode sqlComment = rsComment.GetRows(-1) rsComment.close:set rsComment=Nothing sTemp="" For i=0 to Ubound(sqlComment,2) sTemp=sTemp & "" sTemp=sTemp & "" Next Set ClUbb=Nothing sTemp=sTemp & "
  • "&Cl.GetUserGroupName(sqlComment(3,i))&"『" if sqlComment(3,i)=5 then sTemp=sTemp & "" & sqlComment(4,i) & "" else sTemp=sTemp & "" & sqlComment(4,i) & "" end if sTemp=sTemp & "』于" & sqlComment(6,i) & "发表评论:
  • " if Cl.UserLevel=1 then if sqlComment(12,i)=True then sTemp=sTemp & " [取消]" else sTemp=sTemp & " [审核]" end if 'sTemp=sTemp & " [修改]" sTemp=sTemp & " [删除]" end if sTemp=sTemp & "
    评分:"&sqlComment(7,i)&"分
    " sTemp=sTemp & "    " & ClUbb.UbbCode(sqlComment(8,i)) & "
    " if sqlComment(9,i)<>"" then sTemp=sTemp & "     管理员『" & sqlComment(10,i) & "』于 " & sqlComment(11,i) & " 回复道:    " & ClUbb.UbbCode(sqlComment(9,i)) & "
    " end if sTemp=sTemp & "
    " strHTML=strHTML & sTemp &"
    返回内容页】 【关闭窗口】 【我也要评论
    " end Sub Sub WriteComment() if not Cl.ChkUserLevel(Cl.Web_Setting(34),Cl.UserLevel) then ErrMsg=ErrMsg & "

  • 对不起,只有本站的" ErrMsg=ErrMsg & Cl.GetUserGroupName(Cl.Web_Setting(34)) ErrMsg=ErrMsg & "才能发表评论!


  • " ErrMsg=ErrMsg & "
  • 如果你还没注册,请赶紧点此注册吧!


  • " ErrMsg=ErrMsg & "
  • 如果你已经注册但还没登录,请赶紧点此登录吧!


  • " Cl.OutErr(ErrMsg) end if if Instr(Session("CommentedID"),"#"&ChannelID&"|"&InfoID&"#")>0 then Cl.OutErr("
  • 你已经对该篇文章发表过评论了!请勿连续对同一篇文章发表评论。
  • ") end if dim CommentUGrade,sqlComment,rsComment,sTitle CommentUGrade=Cl.GetUserGroupName(Cl.UserLevel) Select Case ModuleID Case 1 sqlComment="Select Title from Cl_Article where ArticleID="&InfoID&"" Case 2 sqlComment="Select SoftName from Cl_Soft where SoftID="&InfoID&"" Case 3 sqlComment="Select PhotoName from Cl_Photo where PhotoID="&InfoID&"" Case 4 sqlComment="Select MovieName from Cl_Movie where MovieID="&InfoID&"" Case 5 sqlComment="Select ProductName from Cl_Product where ProductID="&InfoID&"" Case Else sqlComment="Select Title from Cl_Article where ArticleID="&InfoID&"" End Select Set rsComment=Cl.Execute(sqlComment) if rsComment.Bof and rsComment.Eof then rsComment.close : set rsComment=Nothing Cl.OutErr("
  • 找不到要发表评论的内容,可能已经被管理员删除。
  • ") end if sTitle = rsComment(0) rsComment.close : set rsComment=Nothing strHTML=strHTML & "
    " & vbCrLf strHTML=strHTML & "" & vbCrLf strHTML=strHTML & "" & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf if Cl.UserID=0 Or Cl.UserLevel=5 then strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf else strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf end if strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & "
    发 表 评 论 ("&CommentUGrade&")
    标 题: " & vbCrLf strHTML=strHTML & " "&Cl.Channel_Setting(1)&" -- "&sTitle&"" & vbCrLf strHTML=strHTML & "
    姓 名:" & vbCrLf strHTML=strHTML & " * E-mail: " & vbCrLf strHTML=strHTML & " *
    姓 名: " & vbCrLf strHTML=strHTML & " * E-mail:" & vbCrLf strHTML=strHTML & " *
    评 分:10  20  30  40  50  60  70  80  90  100" & vbCrLf strHTML=strHTML & "
    内 容: " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & "
    " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & " " & vbCrLf strHTML=strHTML & "

    " & vbCrLf strHTML=strHTML & "
  • 请遵守《互联网电子公告服务管理规定》及中华人民共和国其他各项有关法律法规。
    " & vbCrLf strHTML=strHTML & "
  • 严禁发表危害国家安全、损害国家利益、破坏民族团结、破坏国家宗教政策、破坏社会稳定、侮辱、诽谤、教唆、淫秽等内容的评论 。
    " & vbCrLf strHTML=strHTML & "
  • 用户需对自己在使用本站服务过程中的行为承担法律责任(直接或间接导致的)。
    " & vbCrLf strHTML=strHTML & "
  • 本站管理员有权保留或删除评论内容。
    " & vbCrLf strHTML=strHTML & "
  • 评论内容只代表网友个人观点,与本网站立场无关。 " & vbCrLf strHTML=strHTML & "
  • " & vbCrLf strHTML=strHTML & "
    " & vbCrLf end sub sub SaveComment() if Cl.ChkIsOuter then Call Cl.OutMsg("请不要从外部访问此文件!","Index.asp") if not Cl.ChkUserLevel(Cl.Web_Setting(34),Cl.UserLevel) then FoundErr=True ErrMsg=ErrMsg & "

  • 对不起,只有本站的" ErrMsg=ErrMsg & Cl.GetUserGroupName(Cl.Web_Setting(34)) ErrMsg=ErrMsg & "才能发表评论!


  • " ErrMsg=ErrMsg & "
  • 如果你还没注册,请赶紧点此注册吧!


  • " ErrMsg=ErrMsg & "
  • 如果你已经注册但还没登录,请赶紧点此登录吧!


  • " Cl.OutErr(ErrMsg) end if if Instr(Session("CommentedID"),"#"&ChannelID&"|"&InfoID&"#")>0 then FoundErr=True ErrMsg=ErrMsg & "
  • 你已经对该篇文章发表过评论了!请勿连续对同一篇文章发表评论。
  • " Exit Sub end if dim rsComment,ClassID,tClass,IsNoPassed,strSucMsg dim CommentUName,CommentUEmail dim CommentUScore,CommentUContent IsNoPassed=True if Cl.UserID=0 Or Cl.UserLevel=5 then CommentUName=Trim(request("Name")) CommentUEmail=Trim(request("Email")) if CommentUName="" then founderr=true errmsg=errmsg & "
  • 请输入姓名
  • " end if If Not Cl.ChkEmail(CommentUEmail) then founderr=true errmsg=errmsg & "
  • 请输入正确的Email
  • " end if else CommentUName=Trim(Cl.User_Info(5)) CommentUEmail=Trim(Cl.User_Info(8)) end if CommentUScore=Clng(request.Form("Score")) CommentUContent=Trim(request.Form("Content")) if CommentUContent="" then founderr=true errmsg=errmsg & "
  • 请输入评论内容
  • " end if CommentUContent=Cl.HTMLEncode(CommentUContent) if Cl.Web_Setting(3)="Yes" then '脏话过滤 CommentUName=Cl.ChkBadWords(CommentUName) CommentUContent=Cl.ChkBadWords(CommentUContent) end if Select Case ModuleID Case 1 set tClass=Cl.Execute("select ClassID from Cl_Article where ArticleID=" & InfoID) Case 2 set tClass=Cl.Execute("select ClassID from Cl_Soft where SoftID=" & InfoID) Case 3 set tClass=Cl.Execute("select ClassID from Cl_Photo where PhotoID=" & InfoID) Case 4 set tClass=Cl.Execute("select ClassID from Cl_Movie where MovieID=" & InfoID) Case 5 set tClass=Cl.Execute("select ClassID from Cl_Product where ProductID=" & InfoID) Case Else Call Cl.OutMsg("找不到要评论的文章,可能已经被删除!",ComeUrl) end Select if tClass.bof and tClass.eof then Call Cl.OutMsg("找不到要评论的文章,可能已经被删除!",ComeUrl) 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("找不到指定文章栏目!",ComeUrl) End if if Not Cl.ChkUserLevel(tClass(0),Cl.UserLevel) then Call Cl.OutMsg("对不起,此栏目只有 “"&Cl.GetUserGroupName(tClass(0))&"” 方可发表评论!",ComeUrl) end if IsNoPassed=tClass(1) set tClass=Nothing if founderr=true then exit sub set rsComment=server.createobject("adodb.recordset") sql="select * from Cl_Comment" OpenConn : rsComment.open sql,Conn,1,3 rsComment.addnew rsComment("ChannelID") = ChannelID rsComment("ClassID") = ClassID rsComment("InfoID") = InfoID rsComment("UserLevel") = Cl.UserLevel rsComment("UserName") = CommentUName rsComment("Email") = CommentUEmail rsComment("IP") = Cl.UserTrueIP rsComment("Score") = CommentUScore rsComment("Content") = CommentUContent rsComment("WriteTime") = now() if IsNoPassed=True then rsComment("Passed")=False strSucMsg="发表评论成功,等待管理员审核后通过。点击返回!" else rsComment("Passed")=True strSucMsg="发表评论成功,点击返回!" end if rsComment.update rsComment.close:set rsComment=Nothing ReSessionCedID if Instr(Lcase(ComeUrl),"comment.asp")>0 then ComeUrl="Index.asp" Call Cl.OutMsg(strSucMsg,ComeUrl) 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 Sub ShowCommentJs() if InfoID=0 then Call Cl.OutMsg("请指定评论ID!",ComeUrl) if ChannelID=0 then Call Cl.OutMsg("请指定频道ID",ComeUrl) Cl.GetChannelSetting(ChannelID) ModuleID=Cl.ChkCLng(Cl.Channel_Setting(20)) Cl.LoadTemplates("") Dim strCJs,strCJsType,CommentNum strCJsType=Lcase(Request("Type")) CommentNum=Trim(Request("Num")) 'if strCJsType="" then strCJsType="s" Select Case strCJsType Case "a" 'if Not IsNumeric(CommentNum) then CommentNum=5 'CommentNum=Clng(CommentNum) 'strCJs=ShowComment(ChannelID,InfoID,CommentNum) strCJs=Cl.mainhtml(14) strCJs=Replace(strCJs,"{%action%}",Cl.WebDir&"Comment.asp") if Cl.UserID>0 then strCJs=Replace(strCJs,"{%chkname%}","value="""&Cl.User_Info(5)&""" disabled") strCJs=Replace(strCJs,"{%chkemail%}","value="""&Cl.User_Info(8)&""" disabled") else strCJs=Replace(strCJs,"{%chkname%}","") strCJs=Replace(strCJs,"{%chkemail%}","") end if strCJs=Replace(strCJs,"{%channelid%}",ChannelID) strCJs=Replace(strCJs,"{%infoid%}",InfoID) strCJs=ShowComment(ChannelID,InfoID,CommentNum)&"
    "&strCJs Case "w" strCJs=Cl.mainhtml(14) strCJs=Replace(strCJs,"{%action%}",Cl.WebDir&"Comment.asp") if Cl.UserID>0 then strCJs=Replace(strCJs,"{%chkname%}","value="""&Cl.User_Info(5)&""" disabled") strCJs=Replace(strCJs,"{%chkemail%}","value="""&Cl.User_Info(8)&""" disabled") else strCJs=Replace(strCJs,"{%chkname%}","") strCJs=Replace(strCJs,"{%chkemail%}","") end if strCJs=Replace(strCJs,"{%channelid%}",ChannelID) strCJs=Replace(strCJs,"{%infoid%}",InfoID) Case else 'if Not IsNumeric(CommentNum) then CommentNum=5 'CommentNum=Clng(CommentNum) strCJs=ShowComment(ChannelID,InfoID,CommentNum) End Select strCJs="document.write ('" & Replace(strCJs,"'","") & "');" strCJs=Replace(strCJs,Vbcrlf,"');"& Vbcrlf&"document.write ('") response.write strCJs response.end End Sub Sub CommectCheck() if Cl.UserLevel<>1 then Call Cl.OutMsg("对不起,您没有执行此操作的权限!",ComeUrl) Dim ChkType ChkType = Lcase(Request("Type")) CommentID = Cl.ChkClng(Trim(Request("CommentID"))) if CommentID=0 then Call Cl.OutMsg("参数错误,请指定评论ID!",ComeUrl) Select Case ChkType Case "p" Cl.Execute("Update Cl_Comment Set Passed=True where CommentID="&CommentID&"") Case "n" Cl.Execute("Update Cl_Comment Set Passed=False where CommentID="&CommentID&"") Case "d" Cl.Execute("delete * from Cl_Comment where CommentID="&CommentID&"") Case else Call Cl.OutMsg("参数错误,请指定执行操作参数!",ComeUrl) end Select Call Cl.OutMsg("恭喜您,执行操作成功!",ComeUrl) End Sub '================================================== 'CreateLive CMS Version 3.1 ' Powered by Aspoo.Net ' '邮箱: aspoo@126.com Info@aspoo.cn 'QQ: 3315263 596197794 '网站: www.aspoo.cn www.aspoo.com '论坛: bbs.aspoo.cn bbs.aspoo.com ' 'Copyright (C) 2005 Aspoo.Net All Rights Reserved. '================================================== %>