www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\ask\handle.asp
<!--#include file="conn.asp"--> <!--#include file="inc/const.asp"--> <!--#include file="inc/ubbcode.asp"--> <!--#include file="inc/check.asp"--> <% Dim Action,TopicID,TopicUseTable,supplement Dim XMLDom,UserReward,ExpiredTime,RemainDays Dim LockTopic,TopicMode,classid,PostNum,TopicUserID Dim allowDeletes allowDeletes = NewAsp.ChkNumeric(NewAsp.Posts_Setting(5)) '--检测是否代理服务器提交 NewAsp.ChcekProxy(NewAsp.Asked_Setting(21)) Action = NewAsp.CheckBadstr(Request("action")) TopicID = NewAsp.ChkNumeric(Request("TopicID")) If TopicID = 0 Then NewAsp.FoundErr = True If Len(Action) = 0 Then NewAsp.FoundErr = True 'Response.Write "<script>alert('友情提示!\n\n您的问题悬赏已高于300分不能再提高悬赏!');</script>" Call showmain() Select Case LCase(Action) Case "0" Call HandleQuestion() Case "1" Call AddQuestion() Case "2" Call AdvanceReward() Case "3" Call NoSatisAnswer() Case "selbest","handle" Call HandleQuestion() Case "saveadd" Call saveadd() Case "nosatis" Call Nosatis() Case "reward" Call AddReward() Case "delanswer" Call DelAnswer() Case "delcomment" Call DelComment() Case "selvote" Call SelVote() Case "vote" Call UserVote() Case Else Call HandleQuestion() End Select If Len(Action) > 1 Then Set XMLDom=Nothing Else Call transform_handxslt() End If NewAsp.CloseConn() Sub HandleQuestion() Dim bestAnswerID,AnswerIDArray Dim Rs,SQL,i,star bestAnswerID = ChkAnswerID(Request.Form("bestAnswerID")) If LockTopic > 0 Or TopicMode=1 Or TopicMode=3 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n问题已处理不能进行此项操作!');top.location.replace(document.referrer);</script>" Exit Sub End If If TopicID = 0 Then Response.Write "<script>alert('友情提示!\n\n请选择正确的问题ID!');</script>" Exit Sub End If If bestAnswerID = "" Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n请选择您满意的答案!');</script>" Exit Sub End If If NewAsp.FoundErr Then Exit Sub Set Rs = NewAsp.CreateAXObject("ADODB.Recordset") SQL = "SELECT postsid,TopicID,userid FROM ["&TopicUseTable&"] WHERE topicid="&topicid&" and PostsMode=1 and LockTopic=0 and postsid in("& bestAnswerID &")" Rs.Open SQL,Conn,1,1 If Rs.BOF And Rs.EOF Then Set Rs = Nothing NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n请选择正确的问题ID!');</script>" Exit Sub Else UserReward = UserReward + NewAsp.ChkNumeric(NewAsp.Point_Setting(10)) Do While Not Rs.EOF star = NewAsp.ChkNumeric(Request.Form("star_"&Rs(0))) If star=0 Then star=3 NewAsp.Execute ("UPDATE ["&TopicUseTable&"] SET satis=1,star="& star &",DoneTime="& NowString &" WHERE postsid="& Rs(0)) NewAsp.Execute ("UPDATE NC_Ask_Users SET Points=Points+" & UserReward & ",Experience=Experience+" & NewAsp.ChkNumeric(NewAsp.Point_Setting(11)) & ",Adopted=Adopted+1 WHERE userid="& Rs(2)) NewAsp.Execute ("UPDATE NC_Ask_Answer SET AnswerMode=1 WHERE topicid="&topicid&" and userid="& Rs(2)) Rs.movenext Loop End If Rs.Close:Set Rs = Nothing NewAsp.Execute ("UPDATE NC_Ask_Topic SET LastPostTime="& NowString &",TopicMode=1 WHERE topicid="&topicid&" and userid="& NewAsp.UserID &" and Closed=0 and LockTopic=0") NewAsp.Execute ("UPDATE NC_Ask_Answer SET TopicMode=1 WHERE topicid="&topicid) If TopicMode = 2 Then NewAsp.Execute ("UPDATE NC_Ask_Users SET Points=Points+" & NewAsp.ChkNumeric(NewAsp.Point_Setting(6)) & ",Experience=Experience+" & NewAsp.ChkNumeric(NewAsp.Point_Setting(7)) & ",Askdone=Askdone+1,Askvote=Askvote-1 WHERE userid="& NewAsp.UserID) Newasp.Execute ("UPDATE NC_Ask_Setup SET MaxVoteNum=MaxVoteNum-1,MaxDoneNum=MaxDoneNum+1") Newasp.Execute ("UPDATE NC_Ask_Class SET AskVoteNum=AskVoteNum-1,AskDoneNum=AskDoneNum+1 WHERE classid="& classid) NewAsp.ReloadSetupCache Clng(NewAsp.MaxDoneNum)+1,8 NewAsp.ReloadSetupCache Clng(NewAsp.MaxVoteNum)-1,9 Else NewAsp.Execute ("UPDATE NC_Ask_Users SET Points=Points+" & NewAsp.ChkNumeric(NewAsp.Point_Setting(6)) & ",Experience=Experience+" & NewAsp.ChkNumeric(NewAsp.Point_Setting(7)) & ",Askdone=Askdone+1,Askpend=Askpend-1 WHERE userid="& NewAsp.UserID) Newasp.Execute ("UPDATE NC_Ask_Setup SET MaxPendNum=MaxPendNum-1,MaxDoneNum=MaxDoneNum+1") Newasp.Execute ("UPDATE NC_Ask_Class SET AskPendNum=AskPendNum-1,AskDoneNum=AskDoneNum+1 WHERE classid="& classid) NewAsp.ReloadSetupCache Clng(NewAsp.MaxPendNum)-1,7 NewAsp.ReloadSetupCache Clng(NewAsp.MaxDoneNum)+1,8 End If Dim strReturnURL,Direct Direct = NewAsp.ChkNumeric(Request.Form("direct")) strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "question.asp?topicid=" & topicid & "") Response.Write "<script language=""JavaScript"">" If Direct = 0 Then Response.Write "alert('满意答案设置成功!');" Response.Write "try{top.location='" & strReturnURL & "';" Response.Write "}catch(e){}" Response.Write "</script>" End Sub Function ChkAnswerID(str) If str<>"" And str<>"0" Then Dim strArray,i,n,m_strID,CHECK_ID strArray=Split(str, ",") n=0 For i=0 To UBound(strArray) CHECK_ID = Trim(strArray(i)) If CHECK_ID<>"" And IsNumeric(CHECK_ID) And CHECK_ID<>"0" Then n=n+1 If n=1 Then m_strID = CHECK_ID Else m_strID = m_strID&","&CHECK_ID Exit For End If End If Next ChkAnswerID=m_strID Else ChkAnswerID="" End If End Function Sub AddQuestion() If NewAsp.FoundErr Then Exit Sub If LockTopic > 0 Or TopicMode=1 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n问题已处理不能进行此项操作!');top.location.replace(document.referrer);</script>" Exit Sub End If If supplement > 5 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n补充问题已超过5次,不能再进行问题补充!');top.location.replace(document.referrer);</script>" Exit Sub End If Dim SQL,Rs,Postlist,Node SQL="SELECT postsid,classid,TopicID,userid,UserName,topic,content,addText,PostTime,DoneTime,satis,LockTopic,PostsMode,Report FROM ["&TopicUseTable&"] WHERE topicid="&topicid&" and PostsMode=0 and LockTopic=0 and userid="& NewAsp.UserID Set Rs = NewAsp.Execute(SQL) If Not Rs.EOF Then SQL=Rs.GetRows(-1) Set Postlist=NewAsp.ArrayToxml(SQL,Rs,"row","postlist") Else Set Postlist=Nothing End If Set Rs=Nothing SQL=Empty If Not Postlist Is Nothing Then For Each Node in Postlist.documentElement.SelectNodes("row") If Not IsNull(Node.selectSingleNode("@addtext").text) And Node.selectSingleNode("@addtext").text <> "" Then Node.selectSingleNode("@addtext").text=Server.HTMLEncode(Html2UBB(Node.selectSingleNode("@addtext").text)) Else Node.selectSingleNode("@addtext").text="" End If Next XMLDom.documentElement.appendChild(Postlist.documentElement) Set Postlist=Nothing Else NewAsp.FoundErr = True End If End Sub Sub saveadd() Dim AddContent,Rs,SQL,TextLength,TextContent AddContent = Request.Form("AddContent") If LockTopic > 0 Or TopicMode=1 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n问题已处理不能进行此项操作!');top.location.replace(document.referrer);</script>" Exit Sub End If If Len(AddContent) < 2 Then Response.Write "<script>alert('友情提示!\n\n请输入要补充的问题内容!');history.back();</script>" Exit Sub End If AddContent = UBB2Html(AddContent) TextLength = NewAsp.strLength(AddContent) If TextLength > 2000 Then Response.Write "<script>alert('友情提示!\n\n补充问题内容太长!');history.back();</script>" Exit Sub End If If supplement > 5 Then Response.Write "<script>alert('友情提示!\n\n补充问题已超过5次,不能再进行问题补充!');history.back();</script>" Exit Sub End If If NewAsp.FoundErr Then Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');history.back();</script>" Exit Sub End If Set Rs = NewAsp.CreateAXObject("ADODB.Recordset") SQL = "SELECT * FROM [" & TopicUseTable & "] WHERE topicid="&topicid&" and PostsMode=0 and LockTopic=0 and satis=0 and userid="& NewAsp.UserID Rs.Open SQL,Conn,1,3 If Rs.BOF And Rs.EOF Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');history.back();</script>" Set Rs = Nothing Exit Sub Else TextLength = CLng(NewAsp.strLength(Rs("content")) + TextLength) Rs("addText") = AddContent Rs("length") = TextLength Rs.Update End If Rs.Close:Set Rs = Nothing NewAsp.Execute ("UPDATE NC_Ask_Topic SET supplement=supplement+1 WHERE topicid="&topicid&" and userid="& NewAsp.UserID) Dim strReturnURL,Direct Direct = NewAsp.ChkNumeric(Request.Form("direct")) strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "question.asp?topicid=" & topicid & "") Response.Write "<script language=""JavaScript"">" If Direct = 0 Then Response.Write "alert('恭喜您!问题补充成功.');" Response.Write "try{top.location='" & strReturnURL & "';" Response.Write "}catch(e){}" Response.Write "</script>" End Sub Sub AdvanceReward() If NewAsp.FoundErr Then Exit Sub If UserReward > 300 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n您的问题悬赏已高于300分不能再提高悬赏!');top.location.replace(document.referrer);</script>" Exit Sub End If End Sub Sub NoSatisAnswer() If NewAsp.FoundErr Then Exit Sub End Sub Sub DelAnswer() If NewAsp.FoundErr Then Exit Sub If allowDeletes = 0 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n禁止用户删除回答!');</script>" Exit Sub End If If LockTopic > 0 Or TopicMode=1 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n问题已处理不能进行此项操作!');top.location.replace(document.referrer);</script>" Exit Sub End If Dim Rs,SQL,postsid,AnswerUserID,MinusPoints,MinusExperience,totalnumber postsid = NewAsp.ChkNumeric(Request("postsid")) If postsid = 0 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');</script>" Exit Sub End If SQL = "SELECT postsid,TopicID,userid FROM ["&TopicUseTable&"] WHERE topicid="&topicid&" and postsid="& postsid &" And PostsMode=1 and LockTopic=0 and satis=0" Set Rs = NewAsp.Execute(SQL) If Rs.BOF And Rs.EOF Then Set Rs = Nothing NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');</script>" Exit Sub Else postsid = Rs("postsid") AnswerUserID = Rs("userid") End If Set Rs = Nothing MinusPoints = NewAsp.ChkNumeric(NewAsp.Point_Setting(24)) MinusExperience = NewAsp.ChkNumeric(NewAsp.Point_Setting(25)) If AnswerUserID > 0 Then totalnumber = CLng(NewAsp.Execute("SELECT COUNT(*) FROM NC_Ask_Answer WHERE topicid="&topicid&" And userid="&AnswerUserID)(0)) If totalnumber > 1 Then NewAsp.Execute ("UPDATE [NC_Ask_Answer] SET AnswerNum=" & totalnumber-1 & " WHERE topicid="&topicid&" and userid="&AnswerUserID) Else NewAsp.Execute ("DELETE FROM [NC_Ask_Answer] WHERE topicid="&topicid&" and userid="&AnswerUserID) End If End If NewAsp.Execute ("DELETE FROM ["&TopicUseTable&"] WHERE topicid="&topicid&" and postsid="& postsid) NewAsp.Execute ("UPDATE NC_Ask_Topic SET PostNum=PostNum-1 WHERE topicid="&topicid&" and userid="& NewAsp.UserID &" and Closed=0 and LockTopic=0") NewAsp.Execute ("UPDATE NC_Ask_Users SET Points=Points-" & MinusPoints & ",Experience=Experience-" & MinusExperience & ",PunishPoint=PunishPoint+" & MinusPoints & ",Answertotal=Answertotal-1,Delnum=Delnum+1 WHERE userid="& AnswerUserID) Dim strReturnURL strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "question.asp?topicid=" & topicid & "") Response.Write "<script language=""JavaScript"">" Response.Write "try{top.location='" & strReturnURL & "';" Response.Write "}catch(e){}" Response.Write "</script>" End Sub Sub DelComment() If NewAsp.FoundErr Then Exit Sub Dim Rs,SQL,commentid,CommentUserID,MinusPoints,MinusExperience,totalnumber commentid = NewAsp.ChkNumeric(Request("commentid")) If commentid = 0 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');</script>" Exit Sub End If If allowDeletes = 0 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n禁止用户删除评论!');</script>" Exit Sub End If SQL = "SELECT CommentID,TopicID,userid FROM [NC_Ask_Comment] WHERE topicid="&topicid&" and commentid="& commentid Set Rs = NewAsp.Execute(SQL) If Rs.BOF And Rs.EOF Then Set Rs = Nothing NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');</script>" Exit Sub Else commentid = Rs("commentid") CommentUserID = Rs("userid") End If Set Rs = Nothing MinusPoints = NewAsp.ChkNumeric(NewAsp.Point_Setting(32)) MinusExperience = NewAsp.ChkNumeric(NewAsp.Point_Setting(33)) totalnumber = CLng(NewAsp.Execute("SELECT COUNT(*) FROM NC_Ask_Comment WHERE topicid="&topicid)(0)) NewAsp.Execute("DELETE FROM NC_Ask_Comment WHERE topicid="&topicid&" and commentid="& commentid) NewAsp.Execute ("UPDATE NC_Ask_Topic SET CommentNum=" & totalnumber-1 & " WHERE topicid="&topicid&" and userid="& NewAsp.UserID) NewAsp.Execute ("UPDATE NC_Ask_Users SET Points=Points-" & MinusPoints & ",Experience=Experience-" & MinusExperience & ",PunishPoint=PunishPoint+" & MinusPoints & ",Delnum=Delnum+1 WHERE userid="& CommentUserID) Newasp.Execute ("UPDATE NC_Ask_Setup SET MaxCommentNum=MaxCommentNum-1") NewAsp.ReloadSetupCache Clng(NewAsp.MaxCommentNum)-1,11 Dim strReturnURL strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "question.asp?topicid=" & topicid & "") Response.Write "<script language=""JavaScript"">" Response.Write "try{top.location='" & strReturnURL & "';" Response.Write "}catch(e){}" Response.Write "</script>" End Sub Sub SelVote() If NewAsp.FoundErr Then Exit Sub Dim Rs,SQL If TopicMode <> 0 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');</script>" Exit Sub End If If PostNum < 2 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n回答小于2不能发起投票!');</script>" Exit Sub End If NewAsp.Execute ("UPDATE NC_Ask_Topic SET TopicMode=2 WHERE topicid="&topicid&" and userid="& NewAsp.UserID) NewAsp.Execute ("UPDATE NC_Ask_Users SET Askpend=Askpend-1,Askvote=Askvote+1 WHERE userid="& NewAsp.UserID) Newasp.Execute ("UPDATE NC_Ask_Setup SET MaxPendNum=MaxPendNum-1,MaxVoteNum=MaxVoteNum+1") Newasp.Execute ("UPDATE NC_Ask_Class SET AskPendNum=AskPendNum-1,AskVoteNum=AskVoteNum+1 WHERE classid="& classid) NewAsp.ReloadSetupCache Clng(NewAsp.MaxPendNum)-1,7 NewAsp.ReloadSetupCache Clng(NewAsp.MaxVoteNum)+1,9 Dim strReturnURL strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "question.asp?topicid=" & topicid & "") Response.Write "<script language=""JavaScript"">" Response.Write "try{top.location='" & strReturnURL & "';" Response.Write "}catch(e){}" Response.Write "</script>" End Sub Sub UserVote() If NewAsp.FoundErr Then Exit Sub Dim Rs,SQL,postsid,UserIDlist,m_strUserIDlist If TopicMode <> 2 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');</script>" Exit Sub End If postsid = NewAsp.ChkNumeric(Request("postsid")) If postsid = 0 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');</script>" Exit Sub End If If TopicUserID = NewAsp.UserID Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n不能对自己的提问进行投票!');</script>" Exit Sub End If Set Rs = NewAsp.CreateAXObject("ADODB.Recordset") SQL = "SELECT postsid,TopicID,userid,UserIDlist FROM ["&TopicUseTable&"] WHERE topicid="&topicid&" and PostsMode=1 and LockTopic=0 and postsid="& postsid Rs.Open SQL,Conn,1,1 If Rs.BOF And Rs.EOF Then Set Rs = Nothing NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n请选择正确的问题ID!');</script>" Exit Sub Else UserIDlist = "," & Rs("UserIDlist") & "" m_strUserIDlist = Rs("UserIDlist") & NewAsp.UserID & "," If InStr(UserIDlist,","& NewAsp.UserID &",") > 0 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n请不要重复投票!');</script>" Exit Sub Else NewAsp.Execute ("UPDATE ["&TopicUseTable&"] SET VoteNum=VoteNum+1,UserIDlist='"& Replace(m_strUserIDlist, "'", "''") &"' WHERE postsid="& Rs(0)) NewAsp.Execute ("UPDATE NC_Ask_Users SET Points=Points+" & NewAsp.ChkNumeric(NewAsp.Point_Setting(12)) & ",Experience=Experience+" & NewAsp.ChkNumeric(NewAsp.Point_Setting(13)) & " WHERE userid="& NewAsp.UserID) End If End If Rs.Close:Set Rs = Nothing Dim strReturnURL,Direct Direct = NewAsp.ChkNumeric(Request("direct")) strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "question.asp?topicid=" & topicid & "") Response.Write "<script language=""JavaScript"">" If Direct = 0 Then Response.Write "alert('恭喜您!投票操作成功.');" Response.Write "try{top.location='" & strReturnURL & "';" Response.Write "}catch(e){}" Response.Write "</script>" End Sub Sub AddReward() If NewAsp.FoundErr Then Exit Sub If LockTopic > 0 Or TopicMode=1 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n问题已处理不能进行此项操作!');top.location.replace(document.referrer);</script>" Exit Sub End If Dim RewardPoints,NeedPoint,UserNowPoint RewardPoints = NewAsp.ChkNumeric(Request.Form("points")) If UserReward > 300 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n您的问题悬赏已高于300分不能再提高悬赏!');top.location.replace(document.referrer);</script>" Exit Sub End If If RewardPoints > UserPoints Then NewAsp.FoundErr = True Response.Write "<script>alert('亲爱的用户:\n\n您的积分不够,不能提高悬赏分!');history.back();</script>" Exit Sub End If If RewardPoints = 0 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n请选择你要增加的悬赏分!');history.back();</script>" Exit Sub End If NeedPoint = RewardPoints + UserReward UserNowPoint = UserPoints - RewardPoints NewAsp.Execute ("UPDATE NC_Ask_Topic SET Reward=" & NeedPoint & " WHERE topicid="&topicid&" and userid="& NewAsp.UserID &" and Closed=0 and LockTopic=0") If RemainDays < 5 Then NewAsp.Execute ("UPDATE NC_Ask_Topic SET ExpiredTime=ExpiredTime+5 WHERE topicid="&topicid&" and userid="& NewAsp.UserID &" and Closed=0 and LockTopic=0") End If NewAsp.Execute ("UPDATE NC_Ask_Users SET Points=" & UserNowPoint & ",RewardPoint=RewardPoint+" & RewardPoints & " WHERE userid="& NewAsp.UserID) Dim strReturnURL,Direct Direct = NewAsp.ChkNumeric(Request.Form("direct")) strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "question.asp?topicid=" & topicid & "") Response.Write "<script language=""JavaScript"">" If Direct = 0 Then Response.Write "alert('提高问题悬赏分成功!');" Response.Write "try{top.location='" & strReturnURL & "';" Response.Write "}catch(e){}" Response.Write "</script>" End Sub Sub Nosatis() If NewAsp.FoundErr Then Exit Sub If LockTopic > 0 Or TopicMode=1 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n问题已处理不能进行此项操作!');top.location.replace(document.referrer);</script>" Exit Sub End If NewAsp.Execute ("UPDATE NC_Ask_Topic SET Closed=1 WHERE topicid="&topicid&" and userid="& NewAsp.UserID) Dim strReturnURL,Direct Direct = NewAsp.ChkNumeric(Request.Form("direct")) strReturnURL = NewAsp.RewriteHtmlURL(NewAsp.InstallDir & "question.asp?topicid=" & topicid & "") Response.Write "<script language=""JavaScript"">" If Direct = 0 Then Response.Write "alert('问题已成功关闭!');" Response.Write "try{top.location='" & strReturnURL & "';" Response.Write "}catch(e){}" Response.Write "</script>" End Sub Sub showmain() If NewAsp.FoundErr Then Exit Sub Dim SQL,Rs,Node If LCase(Action) = "vote" Then SQL="SELECT TopicID,classid,userid,classname,title,PostUsername,Expired,Closed,PostTable,DateAndTime,LastPostTime,ExpiredTime,LockTopic,Reward,Hits,PostNum,CommentNum,TopicMode,Broadcast,Anonymous,supplement FROM NC_Ask_Topic WHERE topicid="&topicid&" and Closed=0" Else SQL="SELECT TopicID,classid,userid,classname,title,PostUsername,Expired,Closed,PostTable,DateAndTime,LastPostTime,ExpiredTime,LockTopic,Reward,Hits,PostNum,CommentNum,TopicMode,Broadcast,Anonymous,supplement FROM NC_Ask_Topic WHERE topicid="&topicid&" and userid="& NewAsp.UserID &" and Closed=0" End If Set Rs = NewAsp.Execute(SQL) If Rs.BOF And Rs.EOF Then Set Rs = Nothing NewAsp.FoundErr = True Exit Sub End If Set XMLDom = NewAsp.RecordsetToxml(Rs,"topic","xml") Set Rs = Nothing Set Node = XMLDom.documentElement.selectSingleNode("topic") topicid = CLng(Node.selectSingleNode("@topicid").text) classid = CLng(Node.selectSingleNode("@classid").text) TopicUserID = CLng(Node.selectSingleNode("@userid").text) TopicUseTable = Trim(Node.selectSingleNode("@posttable").text) UserReward = CLng(Node.selectSingleNode("@reward").text) ExpiredTime = CDate(Node.selectSingleNode("@expiredtime").text) supplement = CLng(Node.selectSingleNode("@supplement").text) LockTopic = CLng(Node.selectSingleNode("@locktopic").text) TopicMode = CLng(Node.selectSingleNode("@topicmode").text) PostNum = CLng(Node.selectSingleNode("@postnum").text) RemainDays = DateDIff("d",Now(),ExpiredTime) If CLng(Node.selectSingleNode("@closed").text) = 1 Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n问题已关闭不能进行此项操作!');top.location.replace(document.referrer);</script>" Exit Sub End If If LCase(Action) = "vote" Then If TopicUserID = NewAsp.UserID Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n不能对自己的提问进行投票!');top.location.replace(document.referrer);</script>" Exit Sub End If Else If TopicUserID <> NewAsp.UserID Then NewAsp.FoundErr = True Response.Write "<script>alert('友情提示!\n\n错误的系统参数!');top.location.replace(document.referrer);</script>" Exit Sub End If End If Set Node = Nothing 'Set XMLDom = NewAsp.CreateXMLDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) 'XMLDom.appendChild(XMLDom.createElement("xml")) XMLDom.documentElement.setAttribute "action",Action XMLDom.documentElement.setAttribute "userid",NewAsp.UserID XMLDom.documentElement.setAttribute "topicid",TopicID End Sub Sub transform_handxslt() If NewAsp.FoundErr Then Exit Sub Dim proc,XMLStyle,node,cnode,XSLTemplate Set XSLTemplate=NewAsp.CreateAXObject("Msxml2.XSLTemplate" & MsxmlVersion) Set XMLStyle=NewAsp.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) XMLStyle.load Server.MapPath(NewAsp.TemplatePath & "xslt/handle.xslt") Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="installdir" Node.attributes.setNamedItem(CNode) Node.text=NewAsp.InstallDir XMLStyle.documentElement.appendChild(node) Set Node=XMLStyle.createNode(1,"xsl:variable","http://www.w3.org/1999/XSL/Transform") Set CNode=XMLStyle.createNode(2,"name","") CNode.text="skinurl" Node.attributes.setNamedItem(CNode) node.text=NewAsp.AskedSkinUrl XMLStyle.documentElement.appendChild(node) XSLTemplate.stylesheet=XMLStyle Set proc = XSLTemplate.createProcessor() proc.input = XMLDom proc.transform() Dim procstr procstr = proc.output procstr = Replace(procstr, "{$UserPoints}", UserPoints) Response.Write Replace(procstr, "{$InstallDir}", NewAsp.InstallDir) 'Response.Write XMLDom.xml Set XMLDom=Nothing Set proc=Nothing End Sub %>