动易指定关键字修改
作者：我就是个世界
发表于：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 & " "
If i = tmpDepth Then
strKeywordList = strKeywordList & "├ "
Else
strKeywordList = strKeywordList & " "
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 & " "
If i = tmpDepth Then
strKeywordList = strKeywordList & "├ "
Else
strKeywordList = strKeywordList & " "
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>隔开。不能出现"'&?;:()等字符。</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的字段，用来做树型列表用。因为本次要求不是那么严格，而且这个指定的关键字一旦完成，以后很少会改动，所以只做了添加关键字处理，而没有做删除及修改处理。关键字树列表那里也做的不够细。因为前提是够用即可。 实在讨厌了动易的标签模板，当然不能否认动易做的的确不错，只是我不喜欢而已。所以懒得再改了。
写到这里记录并分享一下，也希望可以帮助到与我有同样需要的朋友。 万恶的动易啊! 受不了了，快崩溃了~~~~
本文为本站原创，转载请注册出处！谢谢合作！
发布某一栏目下的文章时,要求关键字不可手动输入,要从后面的下拉列表中选择. 前台还要输出此类关键字. 并通过关键字作文章归类统计.
[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 & " "
If i = tmpDepth Then
strKeywordList = strKeywordList & "├ "
Else
strKeywordList = strKeywordList & " "
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 & " "
If i = tmpDepth Then
strKeywordList = strKeywordList & "├ "
Else
strKeywordList = strKeywordList & " "
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>隔开。不能出现"'&?;:()等字符。</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的字段，用来做树型列表用。因为本次要求不是那么严格，而且这个指定的关键字一旦完成，以后很少会改动，所以只做了添加关键字处理，而没有做删除及修改处理。关键字树列表那里也做的不够细。因为前提是够用即可。 实在讨厌了动易的标签模板，当然不能否认动易做的的确不错，只是我不喜欢而已。所以懒得再改了。
写到这里记录并分享一下，也希望可以帮助到与我有同样需要的朋友。 万恶的动易啊! 受不了了，快崩溃了~~~~
本文为本站原创，转载请注册出处！谢谢合作！
请发表您的评论