powereasy.comment.asp

个人网站比较简短

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

'评论所用变量
Dim InfoID, rsCommentUser, sql, sqlout, InfoTitle, CommentNum
Dim InfoUrl

If ChannelID > 0 Then
    Call GetChannel(ChannelID)
Else
    Response.Write "频道参数丢失！"
    FoundErr = True
    Response.End
End If

UserLogined = CheckUserLogined()
If UserLogined = True Then GetUser (UserName)

CommentNum = Trim(Request("CommentNum"))

If Action = "ShowAll" Then
    PageTitle = XmlText("Site", "Comment/ShowDetal", "显示评论详细内容")
Else
    PageTitle = XmlText("Site", "Comment/Send", "发表评论")
End If

Select Case ModuleType
Case 1
    InfoID = Trim(Request("ArticleID"))
    strFileName = "Comment.asp?ArticleID=" & InfoID & "&Action=ShowAll"
    sql = "select A.Title,A.UpdateTime,A.InfoPurview,A.InfoPoint,C.EnableComment,C.CheckComment,C.ClassID,C.ParentDir,C.ClassDir,C.ClassPurview from PE_Article A left join PE_Class C on A.ClassID=C.ClassID where A.ArticleID="
    sqlout = "select ClassID from PE_Article where ArticleID="
Case 2
    InfoID = Trim(Request("SoftID"))
    strFileName = "Comment.asp?SoftID=" & InfoID & "&Action=ShowAll"
    sql = "select S.SoftName,S.UpdateTime,C.EnableComment,C.CheckComment,C.ClassID,C.ParentDir,C.ClassDir from PE_Soft S inner join PE_Class C on S.ClassID=C.ClassID where S.SoftID="
    sqlout = "select ClassID from PE_Soft where SoftID="
Case 3
    InfoID = Trim(Request("PhotoID"))
    strFileName = "Comment.asp?PhotoID=" & InfoID & "&Action=ShowAll"
    sql = "select P.PhotoName,P.UpdateTime,P.InfoPurview,P.InfoPoint,C.EnableComment,C.CheckComment,C.ClassID,C.ParentDir,C.ClassDir,C.ClassPurview from PE_Photo P inner join PE_Class C on P.ClassID=C.ClassID where P.PhotoID="
    sqlout = "select ClassID from PE_Photo where PhotoID="
Case 5
    InfoID = Trim(Request("ProductID"))
    strFileName = "Comment.asp?ProductID=" & InfoID & "&Action=ShowAll"
    sql = "select P.ProductName,P.UpdateTime,C.EnableComment,C.CheckComment,C.ClassID,C.ParentDir,C.ClassDir from PE_Product P left join PE_Class C on P.ClassID=C.ClassID where P.ProductID="
    sqlout = "select ClassID from PE_Product where ProductID="
Case 6
    InfoID = Trim(Request("SupplyID"))
    strFileName = "Comment.asp?SupplyID=" & InfoID & "&Action=ShowAll"
    sql = "select P.SupplyTitle,C.EnableComment,C.CheckComment,C.ClassID from PE_Supply P left join PE_Class C on P.ClassID=C.ClassID where P.SupplyId="
    sqlout = "select ClassID from PE_Supply where SupplyId="
End Select
If InfoID = "" Then
    FoundErr = True
    ErrMsg = ErrMsg & Replace(XmlText("Site", "Comment/Err1", "<li>请指定{$ChannelShortName}ID</li>"), "{$ChannelShortName}", ChannelShortName)
    Call WriteErrMsg(ErrMsg, ComeUrl)
    Call CloseConn
    Response.End
Else
    InfoID = PE_CLng(InfoID)
End If

sql = sql & InfoID
sqlout = sqlout & InfoID
If CommentNum = "" Then
    CommentNum = 10
Else
    CommentNum = PE_CLng(CommentNum)
End If

Select Case Action
Case "JS"
    Call GetCommentJS(CommentNum)
Case "Save"
    Call SaveComment
Case Else
    Call ShowComment
End Select

If FoundErr = True Then
    Call WriteErrMsg(ErrMsg, ComeUrl)
End If


Sub ShowComment()
    Dim CommentedID, arrCommentedID, i, trs
    Set trs = Conn.Execute(sqlout)
    If trs.BOF And trs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & Replace(XmlText("Site", "Comment/Err2", "<br>找不到指定的{$ChannelShortName}"), "{$ChannelShortName}", ChannelShortName)
        Exit Sub
    End If
    If trs(0) = -1 Then
        FoundErr = True
        ErrMsg = ErrMsg & Replace(XmlText("Site", "Comment/Err5", "<li>对不起，未指定栏目的{$ChannelShortName}暂不开放发表评论！</li>"), "{$ChannelShortName}", ChannelShortName)
        Exit Sub
    End If
    Set trs = nothing
    Set trs = Conn.Execute(sql)
    If trs.BOF And trs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & Replace(XmlText("Site", "Comment/Err2", "<br>找不到指定的{$ChannelShortName}"), "{$ChannelShortName}", ChannelShortName)
        Exit Sub
    End If
    InfoTitle = trs(0)
    ChannelUrl = UrlPrefix(SiteUrlType, ChannelUrl) & ChannelUrl
    ChannelUrl_ASPFile = UrlPrefix(SiteUrlType, ChannelUrl_ASPFile) & ChannelUrl_ASPFile
    Select Case ModuleType
    Case 1
        InfoUrl = GetInfoUrl(trs("ParentDir"), trs("ClassDir"), trs("UpdateTime"), InfoID, trs("ClassPurview"), trs("InfoPurview"), trs("InfoPoint"))
    Case 2
        InfoUrl = GetInfoUrl(trs("ParentDir"), trs("ClassDir"), trs("UpdateTime"), InfoID, "", "", "")
    Case 3
        InfoUrl = GetInfoUrl(trs("ParentDir"), trs("ClassDir"), trs("UpdateTime"), InfoID, trs("ClassPurview"), trs("InfoPurview"), trs("InfoPoint"))
    Case 5
        InfoUrl = GetInfoUrl(trs("ParentDir"), trs("ClassDir"), trs("UpdateTime"), InfoID, "", "", "")
    Case 6
        InfoUrl = GetInfoUrl("", "", "", InfoID, "", "", "")
    End Select

    Set trs = Nothing

    Dim sqlComment, rsComment
    
    CurrentPage = Trim(Request("page"))
    If CurrentPage = "" Then
        CurrentPage = 1
    Else
        CurrentPage = PE_CLng(CurrentPage)
    End If
    SkinID = DefaultSkinID
    strHtml = GetTemplate(ChannelID, 16, 0)
    strHtml = Replace(strHtml, "{$ArticleID}", InfoID)
    strHtml = Replace(strHtml, "{$SupplyID}", InfoID)
    strHtml = Replace(strHtml, "{$SoftID}", InfoID)
    strHtml = Replace(strHtml, "{$PhotoID}", InfoID)
    strHtml = Replace(strHtml, "{$ProductID}", InfoID)
    Call ReplaceCommonLabel

    strHtml = PE_Replace(strHtml, "{$Meta_Keywords_Channel}", Meta_Keywords_Channel)
    strHtml = PE_Replace(strHtml, "{$Meta_Description_Channel}", Meta_Description_Channel)
    strHtml = PE_Replace(strHtml, "{$ChannelID}", ChannelID)
    strHtml = PE_Replace(strHtml, "{$ChannelDir}", ChannelDir)
    strHtml = PE_Replace(strHtml, "{$ChannelName}", ChannelName)
    strHtml = PE_Replace(strHtml, "{$ChannelShortName}", ChannelShortName)
    strHtml = PE_Replace(strHtml, "{$UploadDir}", UploadDir)
    strHtml = PE_Replace(strHtml, "{$MenuJS}", GetMenuJS(ChannelDir, False))
    strHtml = PE_Replace(strHtml, "{$Skin_CSS}", GetSkin_CSS(SkinID))

    strNavPath = XmlText("BaseText", "Nav", "您现在的位置：") & "&nbsp;<a class='LinkPath' href='" & SiteUrl & "'>" & SiteName & "</a>"
    If Trim(ChannelName) <> "" And ShowNameOnPath <> False Then
        strNavPath = strNavPath & "&nbsp;" & strNavLink & "&nbsp;<a class='LinkPath' href='"
        If UseCreateHTML > 0 Then
            strNavPath = strNavPath & ChannelUrl & "/Index" & FileExt_Index
        Else
            strNavPath = strNavPath & ChannelUrl & "/Index.asp"
        End If
        strNavPath = strNavPath & "'>" & ChannelName & "</a>"
    End If
    strNavPath = strNavPath & "&nbsp;" & strNavLink & "&nbsp;" & XmlText("Site", "Comment/Send", "发表评论")

    strHtml = Replace(strHtml, "{$PageTitle}", PageTitle)
    strHtml = Replace(strHtml, "{$ShowPath}", strNavPath)
    strHtml = Replace(strHtml, "{$ShowJS_Comment}", ShowJS_Comment(UserLogined))
    
    strHtml = Replace(strHtml, "{$ArticleTitle}", InfoTitle)
    strHtml = Replace(strHtml, "{$SupplyTitle}", InfoTitle)
    strHtml = Replace(strHtml, "{$SoftTitle}", InfoTitle)
    strHtml = Replace(strHtml, "{$PhotoTitle}", InfoTitle)
    strHtml = Replace(strHtml, "{$ProductTitle}", InfoTitle)
    strHtml = Replace(strHtml, "{$InfoUrl}", InfoUrl)
    Dim CommentIsShow
    regEx.Pattern = "【CommentIsShow】([\s\S]*?)【\/CommentIsShow】"
    Set Matches = regEx.Execute(strHtml)
    For Each Match In Matches
        CommentIsShow = Match.value
    Next
    If UserLogined = True Then
         strHtml = Replace(strHtml, CommentIsShow, "")
    End If
    strHtml = Replace(strHtml, "{$UserName}", UserName)
    strHtml = Replace(strHtml, "{$UserEmail}", email)
    strHtml = Replace(strHtml, "【CommentIsShow】", "")
    strHtml = Replace(strHtml, "【/CommentIsShow】", "")
    
    Dim strCommentList
    If Action = "ShowAll" Then
        regEx.Pattern = "\{\$ShowCommentList\((.*?)\)\}"
        Set Matches = regEx.Execute(strHtml)
        For Each Match In Matches
            strCommentList = ShowCommentList(PE_CLng(Match.SubMatches(0)))
            strHtml = Replace(strHtml, Match.value, strCommentList)
        Next
    Else
        regEx.Pattern = "\{\$ShowCommentList\((.*?)\)\}"
        Set Matches = regEx.Execute(strHtml)
        For Each Match In Matches
            strHtml = Replace(strHtml, Match.value, "")
        Next
    End If
    strHtml = Replace(strHtml, "value= ", "value='' ")
    strHtml = Replace(strHtml, "Value= ", "value='' ")
    Response.Write strHtml
End Sub
'=================================================
'过程名：ShowCommentList()
'作  用：显示评论列表
'参  数：CommentShowType  1。表格显示
'                         2。分条显示
'                         3。DIV输出
'=================================================
Function ShowCommentList(CommentShowType)
    Dim rsComment, sqlComment, iCount, strHTM, strUserName
    sqlComment = "select * from PE_Comment where ModuleType=" & ModuleType & " and InfoID=" & InfoID & " and Passed=" & PE_True & " order by CommentID desc"
    Set rsComment = Server.CreateObject("ADODB.Recordset")
    rsComment.Open sqlComment, Conn, 1, 1
    If rsComment.BOF And rsComment.EOF Then
        strHTM = strHTM & XmlText("Site", "Comment/Err3", "&nbsp;&nbsp;&nbsp;&nbsp;没有任何评论")
    Else
        totalPut = rsComment.RecordCount
        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
                rsComment.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        Dim strCommentList1, strCommentList2, strCommentReply1, strCommentReply2
        strCommentList1 = XmlText("Site", "Comment/ShowComment1", "<tr class='Comment_tdbg1'><td width='100'>{$CommentName}</td><td style='width:480; word-wrap:break-word;'>{$Content}</td><td align='center' width='120'>{$WriteTime}</td><td align='center' width='40'>{$Score}分</td></tr>")
        strCommentList2 = XmlText("Site", "Comment/ShowComment2", "<tr class='Comment_title'><td height=22 colspan='3'>&nbsp;&nbsp评论人：{$CommentName}&nbsp;&nbsp;评论时间：{$WriteTime}&nbsp;&nbsp;打分：{$Score}分</td></tr><tr class='Comment_tdbg1'><td width=5>&nbsp;</td><td  class=>{$Content}</td><td width=5 class=>&nbsp;</td></tr>")
        strCommentReply1 = XmlText("Site", "Comment/AdminReplayType1", "<tr class='Comment_tdbg2'><td>&nbsp;</td><td colspan='5'>★&nbsp;管理员『{$AdminName}』于{$ReplyTime}回复道：&nbsp;&nbsp;&nbsp;&nbsp;{$ReplyContent}</td></tr>")
        strCommentReply2 = XmlText("Site", "Comment/AdminReplayType2", "<tr class='Comment_tdbg2'><td width=5>&nbsp;</td><td>★&nbsp;管理员『{$AdminName}』于 {$ReplyTime}回复道：&nbsp;&nbsp;{$ReplyContent}</td><td width=5 class=>&nbsp;</td></tr>")
        Select Case CommentShowType
        Case 1
            strHTM = "<table width='100%' align='center' border='0' cellspacing='1' cellpadding='2' class='Comment_border'>"
            strHTM = strHTM & XmlText("Site", "Comment/ShowCommentList", "<tr class='Comment_title' align='center'><td>评论人</td><td>评论内容</td><td>评论时间</td><td>打分</td></tr>")
            Do While Not rsComment.EOF
                If rsComment("UserType") = 1 Then
                    strUserName = "【<a href='" & strInstallDir & "ShowUser.asp?UserName=" & rsComment("UserName") & "'>" & rsComment("UserName") & "</a>】"
                Else
                    strUserName = "【<span title='类别：游客" & vbCrLf & "姓名：" & rsComment("UserName") & vbCrLf & "信箱：" & rsComment("Email") & vbCrLf & "Oicq：" & rsComment("Oicq") & vbCrLf & "主页：" & rsComment("Homepage") & "' style='cursor:hand'>" & rsComment("UserName") & "</span>】"
                End If
                strHTM = strHTM & Replace(Replace(Replace(Replace(strCommentList1, "{$CommentName}", strUserName), "{$Content}", ReplaceText(rsComment("Content"), 3)), "{$WriteTime}", rsComment("WriteTime")), "{$Score}", rsComment("Score"))
                If rsComment("ReplyContent") <> "" Then
                    strHTM = strHTM & Replace(Replace(Replace(strCommentReply1, "{$AdminName}", rsComment("ReplyName")), "{$ReplyTime}", rsComment("ReplyTime")), "{$ReplyContent}", rsComment("ReplyContent"))
                End If
                rsComment.MoveNext
                iCount = iCount + 1
                If iCount >= MaxPerPage Then Exit Do
            Loop
            strHTM = strHTM & "</table><br>"
        Case 2
            Do While Not rsComment.EOF
                If rsComment("UserType") = 1 Then
                    strUserName = "【<a href='" & strInstallDir & "ShowUser.asp?UserName=" & rsComment("UserName") & "'>" & rsComment("UserName") & "</a>】"
                Else
                    strUserName = "【<span title='类别：游客" & vbCrLf & "姓名：" & rsComment("UserName") & vbCrLf & "信箱：" & rsComment("Email") & vbCrLf & "Oicq：" & rsComment("Oicq") & vbCrLf & "主页：" & rsComment("Homepage") & "' style='cursor:hand'>" & rsComment("UserName") & "</span>】"
                End If
                
                strHTM = strHTM & "     <table width='100%' align='center' border='0' cellspacing='1' cellpadding='2' class='Comment_border'>" & vbCrLf