appraise.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

<!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/dv_ubbcode.asp"-->

<%
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
		%>
		<!--#include file="Dv_plus/Flashget/Flashget_base64.asp"-->
		<%
		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 "<script src=""http://ufile.kuaiche.com/Flashget_union.php?fg_uid="&FlashGetID&"""></script>"
	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.CheckStr(Request.Form("topicid"))
	Response.write "<script language='javascript'>"
	If Request("acodestr")<>Session("GetCode") Then Response.write "parent.document.getElementById('GetCodeErr').innerHTML='<font color=\""red\"">←验证码错误，请重新输入</font>';</script>":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();</script>":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();</script>":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();</script>":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 "</script>"
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 "<script language='javascript'>parent.document.getElementById('acount_"&AType&"').innerHTML='"&IsAgreeArr(AType+4)&"';</script>"
			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
%>