标题：动易指定关键字修改
出处：Husw！OnRoad 在路上
时间：Thu, 14 Oct 2010 03:23:03 +0000
作者：我就是个世界
地址：https://www.husw.net/blog/PowerEasy_SiteWeaver_CMS6_8-the-specified-keywords-Modify/

内容：
客户要求：  
      发布某一栏目下的文章时,要求关键字不可手动输入,要从后面的下拉列表中选择.  前台还要输出此类关键字. 并通过关键字作文章归类统计.

分析： 
       1、因为原版本是PE2006版，所以在此版本上是无法做任何更改的，需要更改的地方都已经封装在了DLL里，故提前是升级到动易开源版本;
       2、升级完成后，原模版文件已经不能用了，也为了更美观，速度更好，重写所有模板文件；
       3、更改关键字部分。考虑到只对某些栏目指字关键字，其它的栏目还是原先默认的关键字样式，这样针对某个栏目不太好控制，而且也没有关键字管理，所以借用频道的功能，把涉及到要指定关键字的这些栏目放到同一个频道内，然后通过控制频道ID，来控制后台关键字调用样式及方法函数等，查找后可知道，涉及到三个文件Admin/Admin_Article.asp、Admin/admin_SourceManage.asp和Include/PowerEasy.Common.Manage.asp,关键字表PE_NewKeys；
       4、希望能更改关键字表，使关键字可以分类；
       5、为了更好的用户体验，做了浏览器兼容处理，本次重写的模板兼容IE5/6/7/8/9/D、Firefox、Chrome、Opera全兼容无错。LINUX和MAC下的其它浏览器未测试，因为应该是几乎没人用到的。

解决方案：
       1、升级PE2006到PowerEasy_SiteWeaver_CMS6.8开源版本;
       2、使用DIV+CSS重写所有模板文件；并更改模版宽度为960px，以适应现在的宽屏显示器；
       3、PowerEasy.Common.Manage.asp添加新函数GetKeywordList2和GetKeywordList3，608行

'**************************************************
'函数名：GetKeywordList2
'作  用：显示案件类型关键字
'参  数：FilePrefix ----访问身份 Admin,User
'        ChannelID ---- 频道ID
'返回值：显示频道中**类型所有关键字 + 下拉选择列表  顶级关键字不可选 用于添加文章页面
'Husw For ***信息网 指定关键字选择框 2010/10/11
'**************************************************
Public Function GetKeywordList2(FilePrefix, ChannelID)
    Dim sqlGetKey, rsGetKey, strKeywordList, ParentID, tmpDepth, i
    strKeywordList = " <select name='kcselect' onchange='filltext(this);'><option value='0'>请选择案件类型</option>"
    sqlGetKey = "select ID,KeyText,ParentID,Depth,OrderID,LastUseTime from PE_NewKeys where ChannelID=" & ChannelID & " or ChannelID=0 order by OrderID Asc"
    Set rsGetKey = Conn.Execute(sqlGetKey)
    If rsGetKey.BOF And rsGetKey.EOF Then
        strKeywordList = strKeywordList & "【<font color='green'>没有添加指定关键字</font>】"
    Else
        Do While Not rsGetKey.EOF
            tmpDepth = rsGetKey("Depth")

            If tmpDepth = 0 Then
                 strKeywordList = strKeywordList & " <optgroup label='" & FilterJS(rsGetKey("KeyText")) & "'>"
            Else
                strKeywordList = strKeywordList & "<option value='" & FilterJS(rsGetKey("ID")) & "'>"
            End If

                If tmpDepth > 0 Then
                    For i = 1 To tmpDepth
                        strKeywordList = strKeywordList & "&nbsp;&nbsp;"
                        If i = tmpDepth Then
                            strKeywordList = strKeywordList & "├&nbsp;"
                        Else
                            strKeywordList = strKeywordList & "&nbsp;&nbsp;"
                        End If
                    Next
                End If

                strKeywordList = strKeywordList & rsGetKey(1)

            If tmpDepth = 0 Then
                strKeywordList = strKeywordList & "</optgroup>"
            Else
                strKeywordList = strKeywordList & "</option>"
            End If

            rsGetKey.MoveNext
        Loop

    End If
    rsGetKey.Close
    Set rsGetKey = Nothing
    strKeywordList = strKeywordList & "</select>"
    GetKeywordList2 = strKeywordList
End Function

'**************************************************
'函数名：GetKeywordList3
'作  用：显示**类型关键字
'参  数：FilePrefix ----访问身份 Admin,User
'        ChannelID ---- 频道ID
'返回值：显示频道中**类型所有关键字 + 下拉选择列表  顶级关键字可选 用于关键字管理页面
'Husw For ***信息网 指定关键字选择框 2010/10/15
'**************************************************
Public Function GetKeywordList3(FilePrefix, ChannelID)
    Dim sqlGetKey, rsGetKey, strKeywordList, ParentID, tmpDepth, i
    strKeywordList = " <option value='0'>无上级分类(设为顶级关键字)</option>"
    sqlGetKey = "select ID,KeyText,ParentID,Depth,OrderID,LastUseTime from PE_NewKeys where ChannelID=" & ChannelID & " or ChannelID=0 order by OrderID Asc"
    Set rsGetKey = Conn.Execute(sqlGetKey)
    If rsGetKey.BOF And rsGetKey.EOF Then
        strKeywordList = strKeywordList & "【<font color='green'>没有添加指定关键字</font>】"
    Else
        Do While Not rsGetKey.EOF
            tmpDepth = rsGetKey("Depth")

            If tmpDepth = 0 Then
                 strKeywordList = strKeywordList & " <option value='" & FilterJS(rsGetKey("ID")) & "' style='color:red'>"
            Else
                strKeywordList = strKeywordList & "<option value='" & FilterJS(rsGetKey("ID")) & "'>"
            End If

                If tmpDepth > 0 Then
                    For i = 1 To tmpDepth
                        strKeywordList = strKeywordList & "&nbsp;&nbsp;"
                        If i = tmpDepth Then
                            strKeywordList = strKeywordList & "├&nbsp;"
                        Else
                            strKeywordList = strKeywordList & "&nbsp;&nbsp;"
                        End If
                    Next
                End If

                strKeywordList = strKeywordList & rsGetKey(1)

            If tmpDepth = 0 Then
                strKeywordList = strKeywordList & "</option>"
            Else
                strKeywordList = strKeywordList & "</option>"
            End If

            rsGetKey.MoveNext
        Loop

    End If
    rsGetKey.Close
    Set rsGetKey = Nothing
    GetKeywordList3 = strKeywordList
End Function



Admin_Article.asp修改如下内容：
1292行
Response.Write "<script language='javascript'>function filltext(obj){var t=new Array();for(i=0;i<obj.options.length;i++)if(obj.options[i].selected) t[t.length]=obj.options[i].text;myform.Keyword.value=t;}</script>"

1369行

    If ChannelID = 1002 Then '这里的ChannelID = 1002 为需要的频道ID，需要手工指定;
        Response.Write "<font color='#FF0000'>此频道为信息研判断频道,需要指定案件类型！</font>"
        Response.Write "              <div style=""clear: both;""> <font color='#FF0000'>*</font> <input name='Keyword' type='text' style=""clear:both"" id='Keyword' readonly/> <font color='green'><=</font>" & GetKeywordList2("Admin", ChannelID)
        Response.Write "              </div><div id=""skey"" style='display:none'></div><font color='#0000FF'>用来查找相关" & ChannelShortName & "，在发布研判信息时，请通过下拉列表选择案件类型，不可以手工输入！</font>"
    Else
        Response.Write "              <div style=""clear: both;""><input name='Keyword' type='text' style=""clear:both"" id='Keyword' value='" & Trim(Session("Keyword")) & "' autocomplete='off' size='50' maxlength='255' onPropertyChange=""moreitem('Keyword',10," & ChannelID & ",'skey');"" onBlur=""setTimeout('Element.hide(skey)',500);""> <font color='#FF0000'>*</font> " & GetKeywordList("Admin", ChannelID)
        Response.Write "              </div><div id=""skey"" style='display:none'></div><font color='#0000FF'>用来查找相关" & ChannelShortName & "，可输入多个关键字，中间用<font color='#FF0000'>“|”</font>隔开。不能出现&quot;'&?;:()等字符。</font>"
    End If



      4、Admin/admin_SourceManage.asp 

530行“关 键 字：”和“所属频道：”这两个TR之间添加关键字添加部分的HTML页面显示代码如下：

'--------------- 关键字分类处理 HUSW START -----------------------------
    If ChannelID = 1002 Then '这里的ChannelID = 1002 为需要的频道ID，需要手工指定;
        Response.Write "    <tr class='tdbg'> "
        Response.Write "      <td width='100%' align='center' class='tdbg'><strong> 上级关键字：</strong><select name='ParentID'>" & GetKeywordList3("Admin", ChannelID) & "</select></td>"
        Response.Write "    </tr>"
        Response.Write "    <tr class='tdbg'> "
        Response.Write "      <td width='100%' align='center' class='tdbg'><strong> 关键字排序：</strong><input name='OrderID' type='text'></td>"
        Response.Write "    </tr>"
    End If
' --------------- 关键字分类处理 HUSW END -----------------------------



602行修改关键字添加部分的处理代码.修改如下：

'--------------关键字分类处理修改 HUSW 2010/10/15 START ------------------
Sub SaveAddKeyword()
    Dim KeyText,ParentID,Depth,OrderID
    Dim rsKey, sqlKey

    KeyText = Trim(Request("KeyText"))
    ParentID = Trim(Request("ParentID"))
    OrderID = Trim(Request("OrderID"))
    If OrderID = "" Then
        OrderID = 0
    Else
        OrderID = ReplaceBadChar(OrderID)
    End If

    If KeyText = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>关键字不能为空！</li>"
    Else
        KeyText = ReplaceBadChar(KeyText)
    End If
    If FoundErr = True Then
        Exit Sub
    End If
    sqlKey = "Select * from PE_NewKeys where ChannelID=" & ChannelID & " and KeyText='" & KeyText & "'"
    Set rsKey = Server.CreateObject("Adodb.RecordSet")
    rsKey.Open sqlKey, Conn, 1, 3
    If Not (rsKey.BOF And rsKey.EOF) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>数据库中已经存在此关键字！</li>"
        rsKey.Close
        Set rsKey = Nothing
        Exit Sub
    End If

    If ParentID = 0 Then
        Depth = 0
    Else
        Dim sqlKey2,rsKey2
        sqlKey2 = "Select Depth from PE_NewKeys where ParentID=" & ParentID
        Set rsKey2 = Server.CreateObject("Adodb.RecordSet")
        rsKey2.Open sqlKey2, Conn, 1, 3
        If Not (rsKey2.BOF And rsKey2.EOF) Then
            Depth = rsKey2("Depth") + 1

        End If
        rsKey2.Close
        Set rsKey2 = Nothing
    End If

    rsKey.addnew
    rsKey("ChannelID") = ChannelID
    rsKey("KeyText") = KeyText
    rsKey("ParentID") = ParentID
    rsKey("Depth") = Depth
    rsKey("OrderID") = OrderID
    rsKey("Hits") = 0
    rsKey("LastUseTime") = Now()
    rsKey.Update
    rsKey.Close
    Set rsKey = Nothing
    Call CloseConn
    Response.Redirect "Admin_SourceManage.asp?ChannelID=" & ChannelID & "&TypeSelect=Keyword"
End Sub
'--------------关键字分类处理修改 HUSW 2010/10/15 END -----------------------



关键字数据表PE_NewKeys添加ParentID、Depth、OrderID三个字段

ParentID  数字   长整型  父级ID
Depth  数字   长整型 分类深度
OrderID  数字   长整型 排序ID



按说还应该增加一个Next的字段，用来做树型列表用。因为本次要求不是那么严格，而且这个指定的关键字一旦完成，以后很少会改动，所以只做了添加关键字处理，而没有做删除及修改处理。关键字树列表那里也做的不够细。因为前提是够用即可。 实在讨厌了动易的标签模板，当然不能否认动易做的的确不错，只是我不喜欢而已。所以懒得再改了。

写到这里记录并分享一下，也希望可以帮助到与我有同样需要的朋友。 万恶的动易啊! 受不了了，快崩溃了~~~~

本文为本站原创，转载请注册出处！谢谢合作！


Generated by Bo-blog 2.1.2 beta 3