user_comment_code.asp

个人网站比较简短

<!--#include file="CommonCode.asp"-->
<!--#include file="../Include/PowerEasy.Common.Manage.asp"-->

<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Dim ClassID, Passed
Dim tClass, ClassName, ReadMe, RootID, ParentID, Depth, ParentPath, Child, arrChildID, ChildID, tID, tChild

Sub Execute()
    ChannelID = PE_CLng(Trim(Request("ChannelID")))
    If ChannelID > 0 Then
        Call GetChannel(ChannelID)
    Else
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要查看的频道ID！</li>"
        Response.Write ErrMsg
        Exit Sub
    End If


    ClassID = PE_CLng(Trim(Request("ClassID")))
    Passed = Trim(Request("Passed"))
    Session("Passed") = Passed
    FileName = "User_Comment.asp?ChannelID=" & ChannelID
    strFileName = "User_Comment.asp?ChannelID=" & ChannelID & "&Field=" & strField & "&keyword=" & Keyword

    Select Case Action
    Case "Modify"
        Call Modify
    Case "SaveModify"
        Call SaveModify
    Case "Del"
        Call DelComment
    Case Else
        Call main
    End Select
     
    If FoundErr = True Then
       Call WriteErrMsg(ErrMsg, ComeUrl)
    End If
End Sub


Sub main()
    Dim rs, sql
    If ClassID > 0 Then
        Set tClass = Conn.Execute("select ClassName,RootID,ParentID,Depth,ParentPath,Child,arrChildID from PE_Class where ClassID=" & ClassID)
        If tClass.BOF And tClass.EOF Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>找不到指定的栏目</li>"
            Exit Sub
        Else
            ClassName = tClass("ClassName")
            RootID = tClass("RootID")
            ParentID = tClass("ParentID")
            Depth = tClass("Depth")
            ParentPath = tClass("ParentPath")
            Child = tClass("Child")
            arrChildID = tClass("arrChildID")
        End If
    End If

    Select Case ModuleType
    Case 1
        sql = "select I.Title as ObjectTitle,I.IncludePic"
    Case 2
        sql = "select I.SoftName as ObjectTitle"
    Case 3
        sql = "select I.PhotoName as ObjectTitle"
    Case 5
        sql = "select I.ProductName as ObjectTitle"
    Case 6
        sql = "Select I.SupplyTitle as ObjectTitle,I.SupplyID as ObjectID,C.CommentID,C.UserType,C.UserName,C.Email,C.Oicq,C.Homepage,C.Icq,C.Msn,C.IP,C.Content,C.WriteTime,C.ReplyName,C.ReplyContent,C.ReplyTime,C.Score,C.Passed From PE_Comment C Inner Join PE_Supply I On C.InfoID=I.SupplyID Where I.UserName='" & UserName & "'"

    End Select
    If ModuleType <> 6 Then
        sql = sql & ",I." & ModuleName & "ID as ObjectID,C.CommentID,C.UserType,C.UserName,C.Email,C.Oicq,C.Homepage,C.Icq,C.Msn,C.IP"
        sql = sql & ",C.Content,C.WriteTime,C.ReplyName,C.ReplyContent,C.ReplyTime,C.Score,C.Passed"
        sql = sql & " from PE_Comment C inner join " & SheetName & " I on C.InfoID=I." & ModuleName & "ID"
        sql = sql & " where I.ChannelID=" & ChannelID
    End If
    If Keyword <> "" Then
        Select Case strField
        Case "CommentContent"
            sql = sql & " and C.Content like '%" & Keyword & "%' "
        Case "CommentTime"
            If IsDate(Trim(Request("keyword"))) = False Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>输入的关键字不是有效日期！</li>"
                Exit Sub
            Else
                If SystemDatabaseType = "SQL" Then
                    sql = sql & " and C.WriteTime = '" & Trim(Request("keyword")) & "' "
                Else
                    sql = sql & " and C.WriteTime = #" & Trim(Request("keyword")) & "# "
                End If
            End If
        Case Else
            sql = sql & " and C.Content like '%" & Keyword & "%' "
        End Select
    End If
    If Passed = "True" Then
        sql = sql & " and C.Passed =" & PE_True & ""
    ElseIf Passed = "False" Then
        sql = sql & " and C.Passed =" & PE_False & ""
    End If

    If ClassID > 0 Then
        If Child > 0 Then
            sql = sql & " and I.ClassID in (" & arrChildID & ")"
        Else
            sql = sql & " and I.ClassID=" & ClassID
        End If
    End If
    If ModuleType <> 6 Then
        sql = sql & " and C.UserName='" & UserName & "' order by " & ModuleName & "ID desc"
    End If
    Set rs = Server.CreateObject("ADODB.Recordset")
    rs.Open sql, Conn, 1, 1
    
    Call ShowJS_Main("评论")
    Response.Write "<br><table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "  <tr class='title'>"
    Response.Write "    <td height='22'>" & GetRootClass() & "</td>"
    Response.Write "  </tr>" & GetChild_Root() & ""
    Response.Write "</table>"
    Response.Write "<br><table width='100%' border='0' align='center' cellpadding='0' cellspacing='0'>"
    Response.Write "<form name='myform' method='post' action='" & strFileName & "' onsubmit='return ConfirmDel();'>"
    Response.Write "  <tr>"
    Response.Write "    <td align='center'>"
    Response.Write "      <table border='0' cellpadding='2' width='100%' cellspacing='0'>"
    Response.Write "        <tr><td>"
    Response.Write "评论管理&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
                Response.Write "<a href='" & FileName & "&ClassID=" & rsPath(0) & "'>" & rsPath(1) & "</a>&nbsp;&gt;&gt;&nbsp;"
                rsPath.MoveNext
            Loop
            rsPath.Close
            Set rsPath = Nothing
        End If
        Response.Write "<a href='" & FileName & "&ClassID=" & ClassID & "'>" & ClassName & "</a>&nbsp;&gt;&gt;&nbsp;"
    End If
    If Keyword = "" Then
        Response.Write "所有评论"
    Else
        Select Case strField
            Case "CommentContent"
                Response.Write "评论内容中含有 <font color=red>" & Keyword & "</font> 的评论"
            Case "CommentName"
                Response.Write "评论人中含有 <font color=red>" & Keyword & "</font> 的评论"
            Case Else
                Response.Write "评论中含有 <font color=red>" & Keyword & "</font> 的评论"
        End Select
    End If
    Response.Write "          </td><td width='150' align='right'>"
    If rs.BOF And rs.EOF Then
        Response.Write "共找到 0 篇评论</td></tr></table>"
    Else
        totalPut = rs.RecordCount
        Response.Write "共找到 " & totalPut & " 篇评论</td></tr></table>"
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If
        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                rs.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If

        Dim CommentNum, rsCommentUser
        CommentNum = 0
        Dim PrevID, iTemp
        PrevID = rs("ObjectID")
        Do While Not rs.EOF
            If rs("ObjectID") <> PrevID Then Response.Write "</table></td></tr></table><br>"
            If CommentNum = 0 Or rs("ObjectID") <> PrevID Then
                iTemp = 1
                Response.Write "      <table class='border' width='100%' border='0' align='center' cellpadding='0' cellspacing='0'>"
                Response.Write "        <tr class='title'>"
                Response.Write "          <td width='80%' height='22'>"
                If ModuleType = 1 Then
                    Set XmlDoc = CreateObject("Microsoft.XMLDOM")
                    XmlDoc.async = False
                    If XmlDoc.Load(Server.MapPath(InstallDir & "Language/Gb2312_Channel_" & ChannelID & ".xml")) = False Then XmlDoc.Load (Server.MapPath(InstallDir & "Language/Gb2312.xml"))
                    Select Case rs("IncludePic")
                        Case 1
                            Response.Write "<font color=blue>" & XmlText("Article", "ArticlePro1", "[图文]") & "</font>"
                        Case 2
                            Response.Write "<font color=blue>" & XmlText("Article", "ArticlePro2", "[组图]") & "</font>"
                        Case 3
                            Response.Write "<font color=blue>" & XmlText("Article", "ArticlePro3", "[推荐]") & "</font>"
                        Case 4
                            Response.Write "<font color=blue>" & XmlText("Article", "ArticlePro4", "[注意]") & "</font>"
                    End Select
                    Set XmlDoc = Nothing
                End If
                Response.Write rs("ObjectTitle")
                Response.Write "          </td>"
                Response.Write "          <td width='20%' align='right'></td>"
                Response.Write "        </tr>"
                Response.Write "        <tr>"
                Response.Write "          <td colspan='2'>"
                Response.Write "            <table border='0' cellspacing='1' width='100%' cellpadding='0' style='word-break:break-all'>"
            End If
            Response.Write "              <tr class='tdbg' onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">"
            Response.Write "                <td width='20' align='center'>" & iTemp & "</td>"
            Response.Write "                <td><a href='#' Title='" & Left(rs("Content"), 200) & "'>评论内容：" & Left(rs("Content"), 30) & "</a></td>"
            Response.Write "                <td width='70' align='center'>评分：" & rs("Score") & "</td>"
            Response.Write "                <td width='160' align='center'>时间：" & rs("WriteTime") & "</td>"
            Response.Write "                <td width='60' align='center'>"
            If rs("Passed") = True Then
                Response.Write "已审核"
            Else
                Response.Write "<font color='red'>未审核</font>"
            End If
            Response.Write "</td>"
            Response.Write "                <td width='120' align='center'>"