动易指定关键字修改

作者:我就是个世界 发表于:2010-10-14
[b]客户要求:[/b]  
      发布某一栏目下的文章时,要求关键字不可手动输入,要从后面的下拉列表中选择.  前台还要输出此类关键字. 并通过关键字作文章归类统计.

[b]分析:[/b]
       1、因为原版本是PE2006版,所以在此版本上是无法做任何更改的,需要更改的地方都已经封装在了DLL里,故提前是升级到动易开源版本;
       2、升级完成后,原模版文件已经不能用了,也为了更美观,速度更好,重写所有模板文件;
       3、更改关键字部分。考虑到只对某些栏目指字关键字,其它的栏目还是原先默认的关键字样式,这样针对某个栏目不太好控制,而且也没有关键字管理,所以借用频道的功能,把涉及到要指定关键字的这些栏目放到同一个频道内,[separator]然后通过控制频道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下的其它浏览器未测试,因为应该是几乎没人用到的。

[b]解决方案:[/b]
       1、升级PE2006到PowerEasy_SiteWeaver_CMS6.8开源版本;
       2、使用DIV+CSS重写所有模板文件;并更改模版宽度为960px,以适应现在的宽屏显示器;
       3、PowerEasy.Common.Manage.asp添加新函数GetKeywordList2和GetKeywordList3,608行
[code]
'**************************************************
'函数名: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
[/code]

Admin_Article.asp修改如下内容:
1292行
[code]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>"[/code]
1369行
[code]
    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
[/code]

      4、Admin/admin_SourceManage.asp

530行“关 键 字:”和“所属频道:”这两个TR之间添加关键字添加部分的HTML页面显示代码如下:
[code]
'--------------- 关键字分类处理 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 -----------------------------
[/code]

602行修改关键字添加部分的处理代码.修改如下:
[code]
'--------------关键字分类处理修改 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 -----------------------
[/code]

关键字数据表PE_NewKeys添加ParentID、Depth、OrderID三个字段
[code]
ParentID  数字   长整型  父级ID
Depth  数字   长整型 分类深度
OrderID  数字   长整型 排序ID
[/code]

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

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

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

分享:

扫一扫在手机阅读、分享本文

请发表您的评论