<%
'**************************************************************
' 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
                
                strHTM = strHTM & Replace(Replace(Replace(Replace(strCommentList2, "{$CommentName}", strUserName), "{$Content}", ReplaceText(rsComment("Content"), 3)), "{$WriteTime}", rsComment("WriteTime")), "{$Score}", rsComment("Score"))
                
                If rsComment("ReplyContent") <> "" Then
                    strHTM = strHTM & Replace(Replace(Replace(strCommentReply2, "{$AdminName}", rsComment("ReplyName")), "{$ReplyTime}", rsComment("ReplyTime")), "{$ReplyContent}", rsComment("ReplyContent"))
                End If

                strHTM = strHTM & "     </table>" & vbCrLf
                strHTM = strHTM & "      <table width='100%' border='0' align='center' cellpadding='0' cellspacing='0'>" & vbCrLf
                strHTM = strHTM & "        <tr>" & vbCrLf
                strHTM = strHTM & "          <td class='main_shadow'>" & vbCrLf
                strHTM = strHTM & "          </td>" & vbCrLf
                strHTM = strHTM & "        </tr>" & vbCrLf
                strHTM = strHTM & "      </table>" & vbCrLf
                rsComment.MoveNext
                iCount = iCount + 1
                If iCount >= MaxPerPage Then Exit Do
            Loop
            strHTM = strHTM & "<br>"
        Case 3
            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 & ("<div class=""comment_body"">" & vbCrLf)
                strHTM = strHTM & ("<div class=""comment_user"">评论人：" & strUserName & "</div>" & vbCrLf)
                strHTM = strHTM & ("<div class=""comment_time"">评论时间：" & rsComment("WriteTime") & "</div>" & vbCrLf)
                strHTM = strHTM & ("<div class=""comment_score"">打分：" & rsComment("Score") & "分</div>" & vbCrLf)
                strHTM = strHTM & ("<div class=""comment_content"">" & ReplaceText(rsComment("Content"), 3) & "</div>" & vbCrLf)
                If rsComment("ReplyContent") <> "" Then
                    strHTM = strHTM & ("<div class=""comment_adminreply"">★&nbsp;管理员『" & rsComment("ReplyName") & "』于" & rsComment("ReplyTime") & "回复道：&nbsp;&nbsp;&nbsp;&nbsp;" & rsComment("ReplyContent") & "</div>" & vbCrLf)
                End If
                strHTM = strHTM & "</div>" & vbCrLf
                rsComment.MoveNext
                iCount = iCount + 1
                If iCount >= MaxPerPage Then Exit Do
            Loop
        End Select
    End If
    rsComment.Close
    Set rsComment = Nothing
    If XmlText("Site", "Comment/ShowPageType", "Chinese") = "English" Then
        strHTM = strHTM & ShowPage_en(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, XmlText("Site", "Comment/ShowPageChar", "Comment"), False)
    Else
        strHTM = strHTM & ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, XmlText("Site", "Comment/ShowPageChar", "条评论"), False)
    End If
    If CommentShowType < 3 Then
       strHTM = strHTM & ("</td></tr><tr height='40'><td align='center' colspan='2'>【<a href='" & InfoUrl & "'>返回" & ChannelShortName & "内容页</a>】</td></tr>")
    Else
       strHTM = strHTM & ("<div class=""comment_backurl"">【<a href='" & InfoUrl & "'>返回" & ChannelShortName & "内容页</a>】")
    End If
    ShowCommentList = strHTM
End Function
'=================================================
'过程名：ShowJS_Comment()
'作  用：评论输入判断
'参  数：无
'=================================================
Function ShowJS_Comment(IsLogin)
    Dim strJS
    strJS = "<script language='JavaScript' type='text/JavaScript'>" & vbCrLf
    strJS = strJS & "function Check(){" & vbCrLf
    If IsLogin = False Then
        strJS = strJS & "  if (document.form1.Name.value==''){" & vbCrLf
        strJS = strJS & "    alert('请输入姓名！');" & vbCrLf
        strJS = strJS & "    document.form1.Name.focus();" & vbCrLf
        strJS = strJS & "    return false;" & vbCrLf
        strJS = strJS & "  }" & vbCrLf
    End If
    strJS = strJS & "  if (document.form1.Content.value==''){" & vbCrLf
    strJS = strJS & "    alert('请输入内容！');" & vbCrLf
    strJS = strJS & "    document.form1.Content.focus();" & vbCrLf
    strJS = strJS & "    return false;" & vbCrLf
    strJS = strJS & "  }" & vbCrLf
    strJS = strJS & "  return true;  " & vbCrLf
    strJS = strJS & "}" & vbCrLf
    strJS = strJS & "</script>" & vbCrLf
    ShowJS_Comment = strJS
End Function

'=================================================
'函数名：SaveComment()
'作  用：保存评论
'参  数：无
'=================================================
Sub SaveComment()
    Dim trs, NeedCheck
    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)
    EnableComment = trs("EnableComment") Or UserEnableComment
    NeedCheck = trs("CheckComment") And (Not UserCheckComment)
    'ClassID = trs(3)
    Set trs = Nothing
    If EnableComment <> True Then
        FoundErr = True
        ErrMsg = ErrMsg & XmlText("Site", "Comment/Err4", "<br><li>对不起，您没有本栏目发表评论的权限！</li>")
        Exit Sub
    End If

    Dim rsComment, tClass
    Dim CommentUserType, CommentUserName, CommentUserSex, CommentUserEmail, CommentUserOicq
    Dim CommentUserIcq, CommentUserMsn, CommentUserHomepage, CommentUserScore, CommentUserContent
    If UserLogined = False Then
        CommentUserType = 0
        CommentUserName = PE_HTMLEncode(Trim(Request("Name")))
        If CommentUserName = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>输入姓名有误！</li>"
            Exit Sub
        End If
        CommentUserSex = PE_HTMLEncode(Trim(Request("Sex")))
        CommentUserOicq = PE_HTMLEncode(Trim(Request("Oicq")))
        CommentUserIcq = PE_HTMLEncode(Trim(Request("Icq")))
        CommentUserMsn = PE_HTMLEncode(Trim(Request("Msn")))
        CommentUserEmail = PE_HTMLEncode(Trim(Request("Email")))
        CommentUserHomepage = ReplaceUrlBadChar(Trim(Request("Homepage")))
        If CommentUserHomepage = "http://" Or IsNull(CommentUserHomepage) Then CommentUserHomepage = ""
    Else
        CommentUserType = 1
        CommentUserName = UserName
    End If

    CommentUserScore = PE_CLng(Request.Form("Score"))
    CommentUserContent = Trim(Request.Form("Content"))
    If CommentUserContent = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入内容</li>"
        Exit Sub
    End If

    'CommentUserContent = ReplaceText(ReplaceBadChar(FilterJS(CommentUserContent)), 3)
    CommentUserContent = PE_HTMLEncode(CommentUserContent)
    Set rsComment = Server.CreateObject("adodb.recordset")
    sql = "select top 1 * from PE_Comment"
    rsComment.Open sql, Conn, 1, 3
    rsComment.addnew
    rsComment("ModuleType") = ModuleType
    rsComment("InfoID") = InfoID
    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") = UserTrueIP
    rsComment("Score") = CommentUserScore
    rsComment("Content") = ReplaceBadUrl(CommentUserContent) '过滤非法系统URL
    rsComment("WriteTime") = Now()
    rsComment("Passed") = (Not NeedCheck)
    rsComment.Update
    rsComment.Close
    Set rsComment = Nothing
    Conn.Execute ("update PE_Channel set CommentCount=CommentCount+1 where ChannelID=" & ChannelID & "")
    Select Case ModuleType
    Case 1
        Conn.Execute ("update PE_Article set CommentCount=CommentCount+1 where ArticleID=" & InfoID & "")
    Case 2
        Conn.Execute ("update PE_Soft set CommentCount=CommentCount+1 where SoftID=" & InfoID & "")
    Case 3
        Conn.Execute ("update PE_Photo set CommentCount=CommentCount+1 where PhotoID=" & InfoID & "")
    Case 5
        Conn.Execute ("update PE_Product set CommentCount=CommentCount+1 where ProductID=" & InfoID & "")
    End Select
    If NeedCheck = False Then
        Call WriteSuccessMsg(XmlText("Site", "Comment/SusMsg1", "发表评论成功！"), ComeUrl)
    Else
        Call WriteSuccessMsg(XmlText("Site", "Comment/SusMsg2", "发表评论成功！请等候管理员的审核！审核后才会显示"), ComeUrl)
    End If
End Sub


'=================================================
'过程名：GetCommentJS
'作  用：显示相关评论的JS代码
'参  数：CommentNum  ----最多显示多少个评论
'=================================================
Sub GetCommentJS(CommentNum)
    Dim rsComment, sqlComment, strComment, strUserName
    If CommentNum > 0 And CommentNum <= 100 Then
        sqlComment = "select top " & CommentNum
    Else
        sqlComment = "select top 10 "
    End If
    sqlComment = sqlComment & " * 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
        strComment = XmlText("Site", "Comment/Err3", "&nbsp;&nbsp;&nbsp;&nbsp;没有任何评论")
    Else
        strComment = "<table width='100%' align='center' border='0' cellspacing='1' cellpadding='2' class='comment_border'>"
        strComment = strComment & XmlText("Site", "Comment/ShowCommentListJs", "<tr class='comment_title' align='center'><td>评论人</td><td>评论内容</td><td>评论时间</td><td>打分</td></tr>")
        Dim strCommentList, strCommentReply1, strCommentReply2
        strCommentList = XmlText("Site", "Comment/ShowCommentJs", "<tr bgcolor='white'><td align='center' width='80'>{$CommentName}</td><td>{$Content}</td><td align='center' width='120'>{$WriteTime}</td><td align='center' width='40'>{$Score}分</td></tr>")
        strCommentReply1 = XmlText("SupplyInfo", "AdminReplayTypeJs", "<tr><td>&nbsp;</td><td colspan='5'><font color='009900'>★</font>&nbsp;发布人『<font color='blue'>{$AdminName}</font>』于 {$ReplyTime} 回复道：&nbsp;&nbsp;&nbsp;&nbsp;{$ReplyContent}<br></td></tr>")
        strCommentReply2 = XmlText("Site", "Comment/AdminReplayTypeJs", "<tr><td>&nbsp;</td><td colspan='5'><font color='009900'>★</font>&nbsp;管理员『<font color='blue'>{$AdminName}</font>』于 {$ReplyTime} 回复道：&nbsp;&nbsp;&nbsp;&nbsp;{$ReplyContent}<br></td></tr>")
        Do While Not rsComment.EOF
            If rsComment("UserType") = 1 Then
                strUserName = "【<a href='" & strInstallDir & "ShowUser.asp?UserName=" & rsComment("UserName") & "'><font color='green'>" & rsComment("UserName") & "</font></a>】"
            Else
                strUserName = "【<span title='类别：游客" & "\n" & "姓名：" & rsComment("UserName") & "\n" & "信箱：" & rsComment("Email") & "\n" & "Oicq：" & rsComment("Oicq") & "\n" & "主页：" & rsComment("Homepage") & "' style='cursor:hand'>" & rsComment("UserName") & "</span>】"
            End If
            
            strComment = strComment & Replace(Replace(Replace(Replace(strCommentList, "{$CommentName}", strUserName), "{$Content}", FilterJS(Replace(ReplaceText(rsComment("Content"), 3), vbCrLf, "\n"))), "{$WriteTime}", rsComment("WriteTime")), "{$Score}", rsComment("Score"))
            If rsComment("ReplyContent") <> "" Then
                If ModuleType = 6 Then
                    strComment = strComment & Replace(Replace(Replace(strCommentReply1, "{$AdminName}", rsComment("ReplyName")), "{$ReplyTime}", rsComment("ReplyTime")), "{$ReplyContent}", Replace(rsComment("ReplyContent"), vbCrLf, "\n"))
                Else
                    strComment = strComment & Replace(Replace(Replace(strCommentReply2, "{$AdminName}", rsComment("ReplyName")), "{$ReplyTime}", rsComment("ReplyTime")), "{$ReplyContent}", Replace(rsComment("ReplyContent"), vbCrLf, "\n"))
                End If
            End If
            rsComment.MoveNext
        Loop
        rsComment.Close
        Set rsComment = Nothing
        strComment = strComment & "</table>"
        strComment = strComment & Replace(XmlText("Site", "Comment/ShowMore", "<div align='center'><a href='{$strFileName}'>查看评论详细内容及更多评论</a></div>"), "{$strFileName}", ChannelUrl & "/" & strFileName)
    End If
    Response.Write "document.write(""" & Replace(strComment, """", "\""") & """);"
End Sub


'**************************************************
'函数名：GetInfoUrl
'作  用：得到文章、下载、图片、商品的Url地址
'参  数：
'返回值：替换后字符串
'**************************************************
Function GetInfoUrl(ByVal tParentDir, ByVal tClassDir, ByVal tUpdateTime, ByVal tInfoID, ByVal tClassPurview, ByVal tInfoPurview, ByVal tInfoPoint)
    If IsNull(tParentDir) Then tParentDir = ""
    If IsNull(tClassDir) Then tClassDir = ""
    If IsNull(tClassPurview) Then tClassPurview = 0
    If IsNull(tInfoPurview) Then tInfoPurview = 0

    Select Case ModuleType
    Case 1
        If UseCreateHTML > 0 And tClassPurview = 0 And tInfoPoint = 0 And tInfoPurview = 0 Then
            GetInfoUrl = ChannelUrl & GetItemPath(StructureType, tParentDir, tClassDir, tUpdateTime) & GetItemFileName(FileNameType, ChannelDir, tUpdateTime, tInfoID) & FileExt_Item
        Else
            GetInfoUrl = ChannelUrl_ASPFile & "/ShowArticle.asp?ArticleID=" & tInfoID
        End If
    Case 2
        If UseCreateHTML > 0 Then
            GetInfoUrl = ChannelUrl & GetItemPath(StructureType, tParentDir, tClassDir, tUpdateTime) & GetItemFileName(FileNameType, ChannelDir, tUpdateTime, tInfoID) & FileExt_Item
        Else
            GetInfoUrl = ChannelUrl_ASPFile & "/ShowSoft.asp?SoftID=" & tInfoID
        End If
    Case 3
        If UseCreateHTML > 0 And tClassPurview = 0 And tInfoPoint = 0 And tInfoPurview = 0 Then
            GetInfoUrl = ChannelUrl & GetItemPath(StructureType, tParentDir, tClassDir, tUpdateTime) & GetItemFileName(FileNameType, ChannelDir, tUpdateTime, tInfoID) & FileExt_Item
        Else
            GetInfoUrl = ChannelUrl_ASPFile & "/ShowPhoto.asp?PhotoID=" & tInfoID
        End If
    Case 5
        If UseCreateHTML > 0 Then
            GetInfoUrl = ChannelUrl & GetItemPath(StructureType, tParentDir, tClassDir, tUpdateTime) & GetItemFileName(FileNameType, ChannelDir, tUpdateTime, tInfoID) & FileExt_Item
        Else
            GetInfoUrl = ChannelUrl_ASPFile & "/ShowProduct.asp?ProductID=" & tInfoID
        End If
    Case 6
        GetInfoUrl = strInstallDir & ChannelDir & "/ShowSupply.asp?SupplyID=" & tInfoID
    End Select
End Function

%>
