<% Dim Action,AppraiseXMLDom Dim TotalUseTable,Announceid,UserName,PostBuyUser,ReplyID_a,RootID_a,AnnounceID_a,EmotPath If Dvbbs.BoardID=0 Then Response.redirect "showerr.asp?ErrCodes=版面ID错误,不能查看评论信息&action=OtherErr" If Dvbbs.GroupSetting(2)="0" Then Dvbbs.AddErrcode(31) Dvbbs.Showerr() Action = LCase(Request("action")) Select Case Action Case "save" SaveAppraise() Case "querylist" QueryAppraise() Case "delete" DeleteAppraise() QueryAppraise() Case Else ShowTopicPK() If UserFlashGet = 1 Then %> <% End If End Select Sub ShowTopicPK() Dvbbs.loadtemplates("dispbbs") Dvbbs.Stats="查看评论" Response.Write Dvbbs.mainhtml(18) Dvbbs.nav() Dvbbs.Head_var 1,"","","" EmotPath=Split(Dvbbs.Forum_emot,"|||")(0) 'em心情路径 If UserFlashGet = 1 Then Response.Write "" End If ShowAppraise() Dvbbs.Footer() End Sub Sub QueryAppraise() Dvbbs.loadtemplates("dispbbs") Dim AType,PostID,XmlDom,Node PostID = Dvbbs.CheckNumeric(Request("postid")) AType = Dvbbs.CheckNumeric(Request("atype")) Set XMLDom=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLDom.appendChild(XMLDom.createElement("hidepage")) XMLDom.DocumentElement.appendChild(GetPKData(PostID,Atype).DocumentElement.cloneNode(True)) Set Node = XMLDom.DocumentElement.selectSingleNode("AppraiseList") Node.setAttribute "postid",PostID Node.setAttribute "boardid",Dvbbs.Boardid Node.setAttribute "topicid",Dvbbs.CheckNumeric(Request("topicid")) TransNode(XmlDom) 'XMLDom.save Server.MapPath("pk"&AType&".xml") Set XMLDom = Nothing End Sub Sub ShowAppraise() Dim Rs,URs,SQL,XMLDom Dim TopicID,PostID,Title,PostTable,body Dim TopicNode Dim PostNode,IsAgree,i,dv_ubb Dim LockUser,UserGroupID TopicID = Dvbbs.CheckNumeric(Request("topicid")) PostID = Dvbbs.CheckNumeric(Request("postid")) '获取主题数据 Set Rs=Dvbbs.Execute("Select Title,PostTable From Dv_Topic Where TopicID="&TopicID) If Rs.Eof Then Response.redirect "showerr.asp?ErrCodes=主题ID错误,不能查看评论信息。&action=OtherErr" Title = Rs(0) PostTable = Rs(1) Rs.Close '获取帖子数据 'SQL = "Select AnnounceID as PostID,ParentID,PostUserID,UserName,Topic,Body,IsAgree,DateAndTime,ubblist,IsBest From "&PostTable&" Where AnnounceID="&PostID Set Rs=Dvbbs.Execute("Select AnnounceID as PostID,ParentID,Boardid,PostUserID,UserName,Topic,Body,Rootid as Topicid,IsAgree,DateAndTime,ubblist,IsBest,PostBuyUser From "&PostTable&" Where AnnounceID="&PostID) If Rs.Eof Then Response.redirect "showerr.asp?ErrCodes=帖子ID错误,不能查看评论信息。&action=OtherErr" Ubblists = Rs("ubblist") Set URs=Dvbbs.Execute("Select LockUser,UserGroupID From Dv_User Where UserID="&Dvbbs.CheckNumeric(Rs("PostUserID"))) If Not URs.Eof Then LockUser = URs(0) UserGroupID = URs(1) Else LockUser = 0 UserGroupID = 7 End If URs.Close:Set URs=Nothing If Not (Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster) Then If LockUser>0 Then Response.redirect "showerr.asp?ErrCodes=本帖子已经被屏蔽,不能展开评论。"&LockUser&"&action=OtherErr" If Rs("IsBest")=1 And Dvbbs.GroupSetting(41)<>1 Then Response.redirect "showerr.asp?ErrCodes=本帖子是精华贴,你没有参与评论的权限。&action=OtherErr" End If Set XMLDom=Dvbbs.RecordsetToxml(Rs,"post","AppraiseInfo") Rs.Close:Set Rs=Nothing '帖子节点分析 Set PostNode = XMLDom.DocumentElement.selectSingleNode("post") IsAgree = Split(PostNode.getAttribute("isagree"),"|") For i=4 to 6 If i<=Ubound(IsAgree) Then PostNode.setAttribute "isagree_"&i,IsAgree(i) Else PostNode.setAttribute "isagree_"&i,0 End If Next PostNode.removeAttribute "isagree" Body = PostNode.getAttribute("body") UserName = PostNode.getAttribute("username") PostBuyUser = PostNode.getAttribute("postbuyuser") ReplyID_a = PostNode.getAttribute("announceid") RootID_a = PostNode.getAttribute("rootid") AnnounceID_a = ReplyID_a TotalUseTable = PostTable Announceid = PostID Set dv_ubb=new Dvbbs_UbbCode dv_ubb.PostType=1 Body=Dvbbs.ChkBadWords(Body) If InStr(Ubblists,",39,") > 0 Then Body = dv_ubb.Dv_UbbCode(Body,UserGroupID,1,0) Else Body = dv_ubb.Dv_UbbCode(Body,UserGroupID,1,1) End If PostNode.setAttribute "body",Body '主题节点分析 Set TopicNode = XMLDom.DocumentElement.appendChild(XMLDom.createNode(1,"topic","")) TopicNode.setAttribute "title",Title XMLDom.DocumentElement.appendChild(GetPKData(PostID,0).DocumentElement.cloneNode(True)) XMLDom.DocumentElement.appendChild(GetPKData(PostID,1).DocumentElement.cloneNode(True)) XMLDom.DocumentElement.appendChild(GetPKData(PostID,2).DocumentElement.cloneNode(True)) TransNode(XMLDom) 'XMLDom.save Server.MapPath("topicpk.xml") Set XMLDom = Nothing End Sub Sub TransNode(XmlDoc) 'XSLT模板转换开始 Dim Xmlskin,Proc,XmlStyle Set Xmlskin = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) If Not (Xmlskin.load(Server.MapPath("inc/Templates/topicpk.xslt"))) Then Response.Write "模板数据出错,请与管理员联系!" Response.End End If Set XMLStyle=Server.CreateObject("msxml2.XSLTemplate" & MsxmlVersion) XMLStyle.stylesheet=Xmlskin Set Proc=XMLStyle.createProcessor() Proc.input = XmlDoc proc.transform() Response.Write proc.output Set XmlStyle = Nothing Set Xmlskin = Nothing End Sub Function GetPKData(PostID,Atype) Dim Rs,SQL,XMLDom,Node,Body,ChildNode Dim ACount,EPRCount,Page,PageCount 'PostID = Dvbbs.CheckNumeric(Request("postid")) 'AType = Dvbbs.CheckNumeric(Request("atype")) EPRCount = 5 Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Appraise Where PostID="&PostID&" And AType="&AType) ACount = Rs(0):If IsNull(ACount) Then ACount=0 Rs.Close If ACount Mod EPRCount=0 Then PageCount = ACount \ EPRCount Else PageCount = ACount \ EPRCount + 1 End If Page = Dvbbs.CheckNumeric(Request("page")) If Page=0 Then Page=1 If Page>PageCount Then Page=PageCount '根据评论类型(AType)获取评论数据 'AType:0为中立, 1为支持, 2反对 SQL = "Select AppraiseID,TopicID,PostID,ATitle,AContent,UserID,UserName,DateTime,IP From Dv_Appraise Where PostID="&PostID&" And AType="&AType&" Order By AppraiseID" Set Rs=Dvbbs.Execute(SQL) If Not Rs.Eof Then If Page>1 Then Rs.Move(EPRCount*(Page-1)) SQL=Rs.GetRows(EPRCount) Set XMLDom=Dvbbs.ArrayToxml(SQL,Rs,"row","AppraiseList") Else Set XMLDom=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLDom.appendChild(XMLDom.createElement("AppraiseList")) End If Rs.Close Set Rs = Nothing For Each ChildNode in XmlDom.documentElement.SelectNodes("row") Body = Dvbbs.Replacehtml(ChildNode.getAttribute("acontent")&"") Body = Dvbbs.HTMLEncode(Body) ChildNode.setAttribute "acontent",body If Dvbbs.GroupSetting(30) <>"1" Then ChildNode.setAttribute "ip","*.*.*.*" End If If Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster Or Dvbbs.GroupSetting(18)=1 Or (ChildNode.getAttribute("userid")=Dvbbs.UserID And Dvbbs.GroupSetting(11)=1) Then ChildNode.setAttribute "DeletePower",1 Else ChildNode.setAttribute "DeletePower",0 End If Next '插入分页信息 XMLDom.documentElement.setAttribute "AType",AType XMLDom.documentElement.setAttribute "ACount",ACount XMLDom.documentElement.setAttribute "PageSize",EPRCount XMLDom.documentElement.setAttribute "PageCount",PageCount XMLDom.documentElement.setAttribute "Page",Page XMLDom.documentElement.setAttribute "postid",PostID XMLDom.documentElement.setAttribute "boardid",Dvbbs.Boardid XMLDom.documentElement.setAttribute "topicid",Dvbbs.CheckNumeric(Request("topicid")) Set GetPKData = XMLDom Set XMLDom = Nothing End Function '保存评论信息 Sub SaveAppraise() Dim Rs,SQL,IsAgree,URs,ErrInfo Dim AType,AContent,ATitle,TopicID,PostID,PostTable Dim T_LockTopic,P_IsBest,P_LockTopic,P_LockUser AType = Dvbbs.CheckNumeric(Request.Form("atype")) ATitle = Dvbbs.CheckStr(Request.Form("atitle")) AContent = Dvbbs.CheckStr(Request.Form("acontent")) PostID = Dvbbs.CheckNumeric(Request.Form("announceid")) TopicID = Dvbbs.CheckNumeric(Request.Form("topicid")) Response.write "":Exit Sub Set Rs=Dvbbs.Execute("Select PostTable,LockTopic From Dv_Topic Where TopicID="&TopicID) If Rs.Eof Then Response.write "alert('主题ID错误,你要评论的主题不存在或已经被删除');ShadeDiv.Close();":Exit Sub PostTable=Rs(0):T_LockTopic = Rs(1) Rs.Close Set Rs=Dvbbs.Execute("Select IsAgree,IsBest,LockTopic,PostUserID From "&PostTable&" Where AnnounceID="&PostID) If Rs.Eof Then Response.write "alert('主题ID错误,你要评论的主题不存在或已经被删除');ShadeDiv.Close();":Exit Sub IsAgree = Split(Dvbbs.CheckStr(Rs(0)),"|") P_IsBest=Rs(1):P_LockTopic=Rs(2) Set URs=Dvbbs.Execute("Select LockUser From Dv_User Where UserID="&Rs(3)) If Not URs.Eof Then P_LockUser=URs(0) Else P_LockUser=0 URs.Close:Set URs=Nothing Rs.Close:Set Rs=Nothing ErrInfo=CheckEmitPower(T_LockTopic,P_IsBest,P_LockTopic,P_LockUser) If ErrInfo<>"" Then Response.write "alert('"&ErrInfo&"');ShadeDiv.Close();":Exit Sub Dvbbs.Execute("Insert Into Dv_Appraise (TopicID,PostID,AType,ATitle,AContent,UserID,UserName,[DateTime],Ip,BoardID) Values ("&TopicID&","&PostID&","&AType&",'"&ATitle&"','"&AContent&"',"&Dvbbs.UserID&",'"&Dvbbs.MemberName&"',"&SqlNowString&",'"&Dvbbs.UserTrueIP&"',"&Dvbbs.BoardID&")") If Ubound(IsAgree)<6 Then If Ubound(IsAgree)<1 Then IsAgree = Split("0|0|||0|0|0","|") Else IsAgree = Split(Join(IsAgree,"|")&"|||0|0|0","|") End If End If IsAgree(AType+4)=IsAgree(AType+4)+1 Dvbbs.Execute("UpDate "&PostTable&" Set IsAgree='"&Join(IsAgree,"|")&"' Where AnnounceID="&PostID) Response.write "alert('发表评论成功');" Response.write "parent.document.getElementById('isagree"&AType&"_"&PostID&"').innerHTML='"&IsAgree(AType+4)&"';" Response.write "parent.ShadeDiv.Close();" Response.write "if (parent.document.getElementById('pgetcode')!=null) {parent.document.getElementById('pgetcode').src='"&DvCodeFile&"?t='+Math.random();}" Response.write "" End Sub '删除评论 Sub DeleteAppraise() Dim Rs,SQL Dim AppraiseID,AUserID,TopicID,PostID,PostTable,AType,IsAgreeArr AppraiseID = Dvbbs.CheckNumeric(Request("AppraiseID")) AUserID = Dvbbs.CheckNumeric(Request("AUserID")) If Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster Or Dvbbs.GroupSetting(18)=1 Or (AUserID=Dvbbs.UserID And Dvbbs.GroupSetting(11)=1) Then 'Dvbbs.ShowSQL=1 Set Rs=Dvbbs.Execute("Select TopicID,PostID,AType From Dv_Appraise Where AppraiseID="&AppraiseID) If Rs.Eof Then Exit Sub TopicID = Rs(0):PostID = Rs(1):AType = Rs(2):Rs.Close Set Rs=Dvbbs.Execute("Select PostTable From Dv_Topic Where TopicID="&TopicID) If Rs.Eof Then Exit Sub PostTable = Rs(0):Rs.Close Set Rs=Dvbbs.Execute("Select IsAgree From "&PostTable&" Where AnnounceID="&PostID) If Not Rs.Eof Then IsAgreeArr = Split(Rs(0)&"","|") If UBound(IsAgreeArr)<1 Then IsAgreeArr = Split(Rs(0)&""," ") If UBound(IsAgreeArr)>=6 Then IsAgreeArr(AType+4) = IsAgreeArr(AType+4) - 1 Dvbbs.Execute("Update "&PostTable&" Set IsAgree='"&Join(IsAgreeArr,"|")&"' Where AnnounceID="&PostID) Response.write "" End If End If Dvbbs.Execute("Delete From Dv_Appraise Where AppraiseID="&AppraiseID) Rs.Close:Set Rs=Nothing End If End Sub '检查发表评论权限 Function CheckEmitPower(T_LockTopic,P_IsBest,P_LockTopic,P_LockUser) Dim LockUser LockUser = Dvbbs.UserSession.documentElement.selectSingleNode("userinfo").getAttribute("lockuser") If LockUser>0 Then CheckEmitPower="本用户已经被屏蔽,不能参与评论。":Exit Function If T_LockTopic=1 And Not (Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster) Then CheckEmitPower="本主题被已经锁定,不能发表评论信息。":Exit Function If P_IsBest=1 And Dvbbs.GroupSetting(41)<>1 Then CheckEmitPower="本帖子是精华贴,你没有参与评论的权限。":Exit Function If P_LockTopic=1 Or P_LockUser>0 Then CheckEmitPower="本帖子已经被屏蔽,不能展开评论。"&P_LockTopic End Function %>