admin_comment.asp

个人网站比较简短

    Response.Write "  <tr align='center' class='title'>"
    Response.Write "    <td height='22' colspan='2'> <strong>回 复 评 论</strong></td>"
    Response.Write "  </tr>"
    Response.Write "  <tr>"
    Response.Write "    <td width='200' align='right' class='tdbg'>评论" & ChannelShortName & "标题：</td>"
    Response.Write "    <td class='tdbg'>" & rs("Title") & "</td>"

    Response.Write "  </tr>"
    Response.Write "  <tr>"
    Response.Write "    <td width='200' align='right' class='tdbg'>评论人用户名：</td>"
    Response.Write "    <td class='tdbg'>" & rs("UserName") & "</td>"
    Response.Write "  </tr>"
    Response.Write "  <tr>"
    Response.Write "    <td width='200' align='right' class='tdbg'>评论内容：</td>"
    Response.Write "    <td class='tdbg'>" & rs("Content") & "</td>"
    Response.Write "  </tr>"
    Response.Write "  <tr>"
    Response.Write "    <td align='right' class='tdbg'>回复内容：</td>"
    Response.Write "    <td class='tdbg'><textarea name='ReplyContent' cols='50' rows='6' id='ReplyContent'>" & PE_ConvertBR(rs("ReplyContent")) & "</textarea></td>"
    Response.Write "  </tr>"
    Response.Write "  <tr align='center'>"
    Response.Write "    <td height='30' colspan='2' class='tdbg'><input name='ComeUrl' type='hidden' id='ComeUrl' value='" & ComeUrl & "'>"
    Response.Write "    <input name='Action' type='hidden' id='Action' value='SaveReply'>"
    Response.Write "      <input name='CommentID' type='hidden' id='CommentID' value='" & rs("CommentID") & "'>"
    Response.Write "      <input  type='submit' name='Submit' value=' 回 复 '> </td>"
    Response.Write "  </tr>"
    Response.Write "  </form>"
    Response.Write "</table>"
    rs.Close
    Set rs = Nothing
End Sub

Sub SetProperty()
    Dim CommentID
    Dim sqlProperty, rsProperty
    Dim ShowType, MoveChannelID
    CommentID = Trim(Request("CommentID"))
    If IsValidID(CommentID) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定评论ID</li>"
    End If
    If Action = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    End If
    If FoundErr = True Then
        Exit Sub
    End If
    If InStr(CommentID, ",") > 0 Then
        sqlProperty = "select * from PE_Comment where CommentID in (" & CommentID & ")"
    Else
        sqlProperty = "select * from PE_Comment where CommentID=" & CommentID
    End If
    Set rsProperty = Server.CreateObject("ADODB.Recordset")
    rsProperty.Open sqlProperty, Conn, 1, 3
    Do While Not rsProperty.EOF
        Select Case Action
        Case "SetPassed"
            rsProperty("Passed") = True
        Case "CancelPassed"
            rsProperty("Passed") = False
        Case "DelReply"
            rsProperty("ReplyContent") = ""
        Case "Del"
            rsProperty.Delete
        End Select
        rsProperty.Update
        rsProperty.MoveNext
    Loop
    rsProperty.Close
    Set rsProperty = Nothing
    
    Call CloseConn
    Response.Redirect ComeUrl
End Sub

Sub DelComment2()
    Dim InfoID, CommentUser
    InfoID = Trim(Request("InfoID"))
    CommentUser = Trim(Request("CommentUser"))
    If CommentUser <> "" Then
        CommentUser = ReplaceBadChar(CommentUser)
    End If
    If CommentUser = "" Then
        If InfoID = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>请指定评论ID</li>"
            Exit Sub
        Else
            InfoID = PE_CLng(InfoID)
        End If
        Conn.Execute "delete from PE_Comment where ModuleType=" & ModuleType & " and InfoID=" & InfoID
    Else
        Conn.Execute "delete from PE_Comment where ModuleType=" & ModuleType & " and UserName like '%" & CommentUser & "%' "
    End If
    Call CloseConn
    Response.Redirect ComeUrl
End Sub

Sub SaveModify()
    Dim rsComment, sql, CommentID
    Dim CommentUserType, CommentUserName, CommentUserSex, CommentUserEmail, CommentUserOicq
    Dim CommentUserIcq, CommentUserMsn, CommentUserHomepage, CommentUserScore, CommentUserContent
    Dim CommentUserIP, CommentWritetime
    CommentID = PE_CLng(Trim(Request("CommentID")))
    If CommentID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定评论ID</li>"
        Exit Sub
    End If
    CommentUserName = Trim(Request("UserName"))
    If CommentUserName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入姓名</li>"
        Exit Sub
    End If
    CommentUserType = PE_CLng(Request("UserType"))
    If CommentUserType = 0 Then
        CommentUserSex = Trim(Request("Sex"))
        CommentUserOicq = Trim(Request("Oicq"))
        CommentUserIcq = Trim(Request("Icq"))
        CommentUserMsn = Trim(Request("Msn"))
        CommentUserEmail = Trim(Request("Email"))
        CommentUserHomepage = Trim(Request("Homepage"))
        If CommentUserHomepage = "http://" Or IsNull(CommentUserHomepage) Then CommentUserHomepage = ""
    End If
    CommentUserIP = Trim(Request.Form("IP"))
    CommentWritetime = PE_CDate(Trim(Request.Form("WriteTime")))
    CommentUserScore = PE_CLng(Request.Form("Score"))
    CommentUserContent = Trim(Request.Form("Content"))
    If CommentUserContent = "" Or CommentUserIP = "" Or CommentUserScore = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请完整输入评论内容、评论时间、评论人IP等信息</li>"
    End If
    CommentUserContent = PE_HTMLEncode(CommentUserContent)

    If FoundErr = True Then
        Exit Sub
    End If

    sql = "Select * from PE_Comment where CommentID=" & CommentID
    Set rsComment = Server.CreateObject("Adodb.RecordSet")
    rsComment.Open sql, Conn, 1, 3
    If rsComment.BOF Or rsComment.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的评论！</li>"
    Else
        rsComment("UserType") = CommentUserType
        rsComment("UserName") = CommentUserName
        rsComment("Sex") = CommentUserSex
        rsComment("Oicq") = CommentUserOicq
        rsComment("Icq") = CommentUserIcq
        rsComment("Msn") = CommentUserMsn
        rsComment("Email") = CommentUserEmail
        rsComment("Homepage") = CommentUserHomepage
        rsComment("IP") = CommentUserIP
        rsComment("WriteTime") = CommentWritetime
        rsComment("Score") = CommentUserScore
        rsComment("Content") = CommentUserContent
        rsComment.Update
    End If
    rsComment.Close
    Set rsComment = Nothing
    Call CloseConn
    Response.Redirect strFileName
End Sub

Sub SaveReply()
    Dim rs, sql
    Dim CommentID, ReplyName, ReplyContent, ReplyTime
    CommentID = PE_CLng(Trim(Request("CommentID")))
    ReplyContent = Trim(Request("ReplyContent"))
    If CommentID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定评论ID</li>"
        Exit Sub
    End If
    If ReplyContent = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入回复内容</li>"
    End If
    
    If FoundErr = True Then
        Exit Sub
    End If
    
    sql = "Select * from PE_Comment where CommentID=" & CommentID
    Set rs = Server.CreateObject("Adodb.RecordSet")
    rs.Open sql, Conn, 1, 3
    If rs.BOF Or rs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到指定的评论！</li>"
    Else
        rs("ReplyName") = AdminName
        rs("ReplyTime") = Now()
        rs("ReplyContent") = PE_HTMLEncode(ReplyContent)
        rs.Update
    End If
    rs.Close
    Set rs = Nothing
    Call CloseConn
    Response.Redirect strFileName
End Sub

Function GetCommentPath()
    Dim strPath
    strPath = "您现在的位置：&nbsp;评论管理&nbsp;&gt;&gt;&nbsp;"
    If ClassID > 0 Then
        If ParentID > 0 Then
            Dim sqlPath, rsPath
            sqlPath = "select ClassID,ClassName from PE_Class where ClassID in (" & ParentPath & ") order by Depth"
            Set rsPath = Server.CreateObject("adodb.recordset")
            rsPath.Open sqlPath, Conn, 1, 1
            Do While Not rsPath.EOF
                strPath = strPath & "<a href='" & FileName & "&ClassID=" & rsPath(0) & "'>" & rsPath(1) & "</a>&nbsp;&gt;&gt;&nbsp;"
                rsPath.MoveNext
            Loop
            rsPath.Close
            Set rsPath = Nothing
        End If
        strPath = strPath & "<a href='" & FileName & "&ClassID=" & ClassID & "'>" & ClassName & "</a>&nbsp;&gt;&gt;&nbsp;"
    End If
    If Keyword = "" Then
        If Passed = "New" Then
            strPath = strPath & "最新" & ChannelShortName & "评论"
        Else
            strPath = strPath & "所有评论"
        End If
    Else
        Select Case strField
            Case "CommentContent"
                strPath = strPath & "评论内容中含有 <font color=red>" & Keyword & "</font> 的评论"
            Case "CommentName"
                strPath = strPath & "评论人中含有 <font color=red>" & Keyword & "</font> 的评论"
            Case Else
                strPath = strPath & "评论中含有 <font color=red>" & Keyword & "</font> 的评论"
            End Select

        End If
    GetCommentPath = strPath
End Function


Function GetCommentSearch()
    Dim strForm
    strForm = "<table border='0' cellpadding='0' cellspacing='0'>"
    strForm = strForm & "<form method='Get' name='SearchForm' action='Admin_Comment.asp'>"
    strForm = strForm & "<tr><td height='28' align='center'>"
    strForm = strForm & "<select name='Field' size='1'>"
    strForm = strForm & "<option value='CommentContent' selected>评论内容</option>"
    strForm = strForm & "<option value='CommentTime'>评论时间</option>"
    strForm = strForm & "<option value='CommentName'>评论人</option>"
    strForm = strForm & "</select>"
    strForm = strForm & "<input type='text' name='keyword'  size='20' value='关键字' maxlength='50' onFocus='this.select();'>"
    strForm = strForm & "<input type='submit' name='Submit'  value='搜索'>"
    strForm = strForm & "<input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>"
    strForm = strForm & "</td></tr></form></table>"
    GetCommentSearch = strForm
End Function
%>