user_comments.asp

来自「是个不错的文件代码,希望大家好好用,」· ASP 代码 · 共 472 行 · 第 1/2 页

        <option value="id">作者</option>
        <option value="ip">作者ip</option>
        <option value="topic" selected>评论标题</option>
      </select>
      <input name="Keyword" type="text" id="Keyword" size="20" maxlength="30">
      <input type="submit"  value="搜索" />
    </form>
</div>
<%


Sub modify()
    Dim id
    Dim rsblog, sql
    Dim restr
    id = Trim(request("id"))
    If id = "" Then
        oblog.adderrstr ("错误：参数不足！")
        oblog.showusererr
        Exit Sub
    Else
        id = Int(id)
    End If
    Set rsblog = server.CreateObject("Adodb.RecordSet")
    sql="select * from [oblog_comment] where commentid=" & id&" and userid="&oblog.l_uid
    rsblog.Open sql, conn, 1, 1
    If rsblog.EOF Then
        rsblog.Close
        Set rsblog = Nothing
        oblog.adderrstr ("错误：无权限，只有blog主人才能操作！")
        oblog.showusererr
        Exit Sub
    End If
%>
<SCRIPT language=javascript>
var ubbimg='';
</SCRIPT>
<form action="user_comments.asp?action=savemodify" method="post" name="oblogform" onSubmit="">
	<table  class="dTab12_body" align="center" border="0" cellpadding="0" cellspacing="1">
	  <tr>
	  	<%if Request("re") <> "true" then%>
		<td class="dTab12_body_td" style="text-align:left;">
<span class="user_post_inputtxt">评论标题:</span><input style="height:16px;padding:2px 0 0 0;margin:0px 0 -3px 0;" name="topic" type=text class="cont" id="topic" value="<%=rsblog("commenttopic")%>" size="53" maxlength="30" /><br /><br />
		<%else%>
		<td class="dTab12_body_td" style="text-align:left;">
<div class="messagetopic"><%=rsblog("commenttopic")%></div>
<div class="message"><%=oblog.ubb_comment(rsblog("comment"))%></div><br /><br />
<div style="color:#CCC;margin:-10px 0 0 0px;">回复此评论:</div>
		<%end if%>
<style type='text/css'>@import url('editor/ubb.css');</style>
<Script src="editor/ubb.js"></Script>
<div id="oblog_ubb">
	<div class="oblog_ubbtoolbar" style="width:98%;">
	<a href="javascript:InsertText(objActive,ReplaceText(objActive,'[B]','[/B]'),true);void(0)"><img src="images/bold.gif" alt="粗体"  border="0" align="absmiddle"></a>
	<a href="javascript:InsertText(objActive,ReplaceText(objActive,'[I]','[/I]'),true);void(0)"><img src="images/italic.gif" alt="斜体" border="0" align="absmiddle" ></a>
	<a href="javascript:InsertText(objActive,ReplaceText(objActive,'[U]','[/U]'),true);void(0)"><img src="images/underline.gif" alt="下划线" border="0" align="absmiddle"></a>
	<a href="javascript:InsertText(objActive,ReplaceText(objActive,'[QUOTE]','[/QUOTE]'),true);void(0)"><img src="images/quote.gif" alt="插入引用" border="0" align="absmiddle"></a>
	<a href="javascript:UBB_smiley();void(0)"><img src="images/smiley.gif" alt="插入表情" border="0" align="absmiddle" id="A_smiley"></a>
	</div>
	<div id="oblog_ubbemot">
	</div>
	  <textarea name="edit" style="border:0;width:100%x;"cols="92" rows="6" id="oblog_edittext" class="oblog_ubbtext" ><%if rsblog("comment")<>"" and Request("re") <> "true" then response.Write Server.HtmlEncode(rsblog("comment"))%></textarea>
</div>
<ul id="user_post_input">
<input type="hidden" name="id" value="<%=rsblog("commentid")%>" /><input type="hidden" name="re" value="<%=request("re")%>" /><input type="submit" name="Submit2" value=" 提交 " />
</ul>
</td>
	 </tr>
  </table>
</form>
<%
    rsblog.Close
    Set rsblog = Nothing
End Sub

Sub Savemodify()
    Dim id, rsblogchk, blog, logid, uid
    id = Int(Trim(request("id")))
    sql="select * from oblog_comment where commentid="&id&" and userid="&oblog.l_uid
    Set rs = server.CreateObject("adodb.recordset")
    rs.Open sql, conn, 1, 3
    uid = rs("userid")
    logid = rs("mainid")
   if request("re")="true" then
		rs("comment") = rs("comment")&"[quote][b]以下为blog主人的回复：[/b]"&vbcrlf&oblog.filt_badword(Request("edit"))&"[/quote]"
	else
		rs("comment") = oblog.filt_badword(Request("edit"))
		rs("commenttopic") = oblog.InterceptStr(oblog.filt_badword(Trim(Request("topic"))), 250)
	end if
    rs.Update
    rs.Close
    Set rs = Nothing
    Set blog = New class_blog
    blog.userid = uid
    blog.Update_log logid, 0
    Set blog = Nothing
    oblog.showok "修改评论成功！", ""
End Sub


Sub delcomment()
    Dim blog, rstComment
    If id = "" Then
        oblog.adderrstr ("错误：请指定要删除的评论！")
        oblog.showusererr
        Exit Sub
    End If
    If InStr(id, ",") > 0 Then
        id = FilterIDs(id)
        Dim n, i
        n = Split(id, ",")
        For i = 0 To UBound(n)
            delonecomment (n(i))
        Next
    Else
        delonecomment (id)
    End If
    oblog.showok "删除评论成功!", ""
End Sub

Sub delonecomment(id)
    Dim blog, rstComment, CommentNum
    id = Int(id)
    Dim uid, mainid
    sql = "select userid,mainid from [oblog_comment] where commentid=" & Int(id) & " and userid=" & oblog.l_uId
    Set rs = server.CreateObject("adodb.recordset")
    rs.Open sql, conn, 1, 3
    If Not rs.EOF Then
        uid = rs(0)
        mainid = rs(1)
        rs.Delete
        rs.Close
        Set blog = New class_blog
        blog.userid = uid
        '重新计算评论数目
        Set rstComment = server.CreateObject("adodb.recordset")
        rstComment.Open "Select Count(commentid) From [oblog_comment] Where mainid=" & Int(mainid), conn, 1, 1
        If rstComment.EOF Then
            CommentNum = 0
        Else
            If IsNull(rstComment(0)) Or Not IsNumeric(rstComment(0)) Then
                CommentNum = 0
            Else
                CommentNum = rstComment(0)
            End If
        End If
        Set rstComment = Nothing
        oblog.Execute ("update [oblog_log] set commentnum=" & CommentNum & ",scores=scores-" & oblog.CacheScores(6) & " where logid=" & mainid)
        blog.Update_log mainid, 0
        oblog.Execute ("update [oblog_user] set comment_count=comment_count-1,scores=scores-" &  oblog.CacheScores(6) & " where userid=" & uid)
        Set blog = Nothing
    Else
        rs.Close
        Set rs = Nothing
        oblog.adderrstr ("错误：无删除权限！")
        oblog.showusererr
        Exit Sub
    End If
End Sub

Function FilterUbb(byval strHTML)
	Dim objRegExp, strOutput
	Set objRegExp = New Regexp	  
	strOutput=strHTML	
	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern="(\[EMOT\])(.[^\[]*)(\[\/EMOT\])"
	strOutput = objRegExp.Replace(strOutput, "")	
	objRegExp.Pattern =  "\[[^\]]*\]"
	strOutput = objRegExp.Replace(strOutput, " ")	
	FilterUbb = strOutput   
	Set objRegExp = Nothing
End Function

Sub passcomment()
	Dim iState
	iState=request("iState")
    Dim blog, rstComment
    If id = "" Then
        oblog.adderrstr ("错误：请指定要审核的评论！")
        oblog.showusererr
        Exit Sub
    End If
    If InStr(id, ",") > 0 Then
        id = FilterIDs(id)
        Dim n, i
        n = Split(id, ",")
        For i = 0 To UBound(n)
            passonecomment n(i),iState
        Next
    Else
        passonecomment id,iState
    End If
    oblog.showok "审核评论成功!", ""
End Sub

Sub passonecomment(id,iState)
    Dim blog
    id = Int(id)
	iState=CLng(iState)
    Dim uid, mainid
	Dim sScore
	If iState = 1 Then
		sScore=oblog.CacheScores(6)
	Else 
		sScore=-1*Abs(oblog.CacheScores(6))
	End if
    sql = "select userid,mainid,iState from [oblog_comment] where commentid=" & Int(id) & " and userid=" & oblog.l_uId
    Set rs = server.CreateObject("adodb.recordset")
    rs.Open sql, conn, 1, 3
    If Not rs.EOF Then
        uid = rs(0)
        mainid = rs(1)
		If rs("iState")<>iState Then
			If oblog.CacheConfig(50) = 0 Then 
				oblog.GiveScore "",sScore,""
			End If
		Else 
			Exit Sub
		End if
		rs("iState")=iState
        rs.Update
        rs.Close
        Set blog = New class_blog
        blog.userid = uid
		blog.Update_log mainid, 0
        Set blog = Nothing
    Else
        rs.Close
        Set rs = Nothing
        oblog.adderrstr ("错误：无操作权限！")
        oblog.showusererr
        Exit Sub
    End If
End Sub
%>