<% Dim action action = Trim(request("action")) %> <% Dim sIp, sGuide Dim rs, sql,mainid Dim id, cmd, keyword, sField keyword = Trim(request("keyword")) If keyword <> "" Then keyword = oblog.filt_badstr(keyword) End If sField = Trim(request("Field")) cmd = Trim(request("cmd")) id = Trim(request("id")) mainid = Int(request("mainid")) sIp = CheckIP(request("IP")) If cmd = "" Then cmd = 0 Else cmd = Int(cmd) End If G_P_FileName = "user_comments.asp?cmd=" & cmd If keyword <> "" Then G_P_FileName="user_comments.asp?cmd=10&keyword="&keyword&"&Field="&sField End If G_P_FileName =G_P_FileName & "&page=" If request("page") <> "" Then G_P_This = Int(request("page")) Else G_P_This = 1 If sIp <> "" Then G_P_FileName = "user_comments.asp" If action = "modify" Then Call modify ElseIf action = "savemodify" Then Call Savemodify ElseIf action = "del" Then Call delcomment ElseIf action = "passcomment" Then Call passcomment Else Call main End If %> <% Sub main() server.scriptTimeOut = 999999999 Dim ssql,i,lPage,lAll,lPages,iPage,tsql ssql = "userid,mainid,commenttopic,addtime,commentid,comment_user,addip,comment,iState" tsql = " comment_user = '"&oblog.l_uname&"' AND isguest = 0 " sGuide = "" Select Case cmd Case 0 sql="select "&ssql&" from [oblog_comment] where userid="&oblog.l_uid&" OR ("&tsql&") order by commentid desc" sGuide = sGuide & "所有评论" Case 1 sql="select "&ssql&" from [oblog_comment] where userid="&oblog.l_uid&" order by commentid desc" sGuide = sGuide & "我文章里的评论" Case 2 sql="select "&ssql&" from [oblog_comment] where userid="&oblog.l_uid&" and iState=1 order by commentid desc" sGuide = sGuide & "已审核的评论" Case 3 sql="select "&ssql&" from [oblog_comment] where userid="&oblog.l_uid&" and iState=0 order by commentid desc" sGuide = sGuide & "待审核的评论" Case 4 sql="select "&ssql&" from [oblog_comment] where "&tsql&" order by commentid desc" sGuide = sGuide & "我发布的评论" Case 10 If keyword = "" Then oblog.adderrstr ("错误：关键字不能为空！") oblog.showusererr Exit Sub Else Select Case sField Case "id" sql="select "&ssql&" from [oblog_comment] where comment_user like '%" & keyword&"%' and userid="&oblog.l_uid&" order by commentid desc" sGuide = sGuide & "作者名称含有 " & keyword & " 的评论" Case "topic" sql="select "&ssql&" from [oblog_comment] where commenttopic like '%" & keyword & "%' and userid="&oblog.l_uid&" order by commentid desc" sGuide = sGuide & "标题中含有“ " & keyword & " ”的评论" Case "ip" sql="select "&ssql&" from [oblog_comment] where addip='" & keyword&"' and userid="&oblog.l_uid&" order by commentid desc" sGuide = sGuide & "作者ip含有 " & keyword & " 的评论" Case "content" sql="select "&ssql&" from [oblog_comment] where comment like '%" & keyword&"%' and userid="&oblog.l_uid&" order by commentid desc" sGuide = sGuide & "评论内容中包含 " & keyword & " 的评论" End Select End If Case Else End Select Set rs = server.CreateObject("Adodb.RecordSet") ' response.write sql rs.Open sql, conn, 1, 3 lAll=INT(rs.recordcount) If lAll=0 Then rs.Close Set rs=Nothing %>
<% Exit Sub End If i=0 iPage=12 '分页 If Request("page") = "" Or Request("page") ="0" then lPage = 1 Else lPage = Int(Request("page")) End If '设置缓存大小 = 每页需显示的记录数目 rs.CacheSize = iPage rs.PageSize = iPage rs.movefirst lPages = rs.PageCount If lPage>lPages Then lPage=lPages rs.AbsolutePage = lPage i=0 %>
<%=MakeMiniPageBar(lAll,iPage,lPage,G_P_FileName)%>
<% Do while not rs.EOF i = i + 1%> <% If i>iPage Then Exit Do rs.movenext Loop rs.Close Set rs = Nothing %>
<% End Sub %>
快速查找评论: 搜索:
<% 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 %>
<%if Request("re") <> "true" then%>
评论标题:" size="53" maxlength="30" />

<%else%>
<%=rsblog("commenttopic")%>
<%=oblog.ubb_comment(rsblog("comment"))%>


回复此评论:
<%end if%>
粗体 斜体 下划线 插入引用 插入表情
    " />" />
<% 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 "修改评论成功！", "user_comments.asp" 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,istate Set rstComment=Server.CreateObject("Adodb.Recordset") 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) istate=rs(2) 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 rstComment.Close 'oblog.Execute ("update [oblog_log] set commentnum=" & CommentNum & ",scores=scores-" & oblog.CacheScores(6) & " where logid=" & mainid) rstComment.Open "Select commentnum,scores From [oblog_log] where logid=" & mainid,conn,1,3 rstComment(0)=CommentNum If istate=1 Then If rstComment(1)>Int(oblog.CacheScores(6)) Then rstComment(1)=rstComment(1)-oblog.CacheScores(6) Else rstComment(1)=0 End If End If rstComment.Update rstComment.Close blog.Update_log mainid, 0 'oblog.Execute ("update [oblog_user] set comment_count=comment_count-1,scores=scores-" & oblog.CacheScores(6) & " where userid=" & uid) rstComment.Open "Select comment_count,scores From [oblog_user] where userid=" & uid,conn,1,3 rstComment(0)=rstComment(0)-1 If istate=1 Then If rstComment(1)>Int(oblog.CacheScores(6)) Then rstComment(1)=rstComment(1)-Int(oblog.CacheScores(6)) Else rstComment(1)=0 End If End If rstComment.Update Set rstComment = Nothing 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 %>