此功能是模拟的筛选中的地区，以扩增筛选二手房字段KS_top_brands,KS_top_chexi为例

一改asp：admin/KS.Model.asp

     Case Else
         Call Main()
    End Select
    End With
  End Sub
  
  Sub SetSearch()
   Dim AllowField:AllowField="'title','author','origin','keywords','intro','area','areabox'"
   Dim ChannelID:channelid=KS.ChkClng(Request("channelid"))
   Dim RS,FieldXML,XMLStr,Node,TemplateFile,isrewrite,maxperpage
   Dim tj,check,xsz,ssz,title
   If ChannelID=0 Then KS.Die "error!"

二改asp：Item/Index.asp

  2.1处：

Class SearchCls
        Private OrderOptionList,OrderArr,OrderListStr,TopMenu,TopMenuArr
        Private KS,ChannelID,ModelTable,Param,XML,Node,StartTime,leavetime,I,FieldMenu,QueryParam
  Private CurrPage,MaxPerPage,TotalPut,PageNum,Key,KeyWordArr,SqlStr,OrderStr,currclassid,ClassXML
  Private FieldXML,FieldNode,TemplateFile,IsRewrite,ModelClassID,SEOTitle,AreaXML,Province,City,BrandXML,BrandNodes,HasBrand
Private KS_top_brands,KS_top_chexi
  Private Sub Class_Initialize()

  2.2处：

    FieldMenu=FieldMenu & "<strong>" & Node.SelectSingleNode("@city").text & "</strong>"
      Else
           FieldMenu=FieldMenu & "<a href=""" & GetFieldLink("area",Node.SelectSingleNode("@id").text,"") & """ title=""&""">" & Node.SelectSingleNode("@city").text & "</a>"
      End If
     Next
     FieldMenu=FieldMenu & "</div>"
     parentid=KS.ChkClng(split(GetParam("area")&":",":")(0))
        Call GetSubAreaMenu(parentid)
        FieldMenu=FieldMenu & "<div class=""clear""></div>"
     
  Case "areabox" '复制地区
        set AreaXML = KS.InitialObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
     AreaXML.async = false
     AreaXML.setProperty "ServerHTTPRequest", true
     AreaXML.load(Server.MapPath(KS.Setting(3)& "config/areabox.xml"))
     if AreaXML.parseError.errorCode<>0 Then
     Call KS.CreateAreaCacheBox()
     End If
     currk=KS.ChkClng(split(GetParam("areabox")&":",":")(0))
     If currk=0 Then
      If SEOTitle="" Then SEOTitle=CurrNode.SelectSingleNode("title").text &":不限" Else SEOTitle=SEOTitle & " " &CurrNode.SelectSingleNode("title").text & ":不限"
      KS_top_brands=""
      FieldMenu=FieldMenu & "<strong>不限</strong>"
     Else
      FieldMenu=FieldMenu & "<a href=""" & GetFieldLink("areabox","0","") & """>不限</a>"
     End If

                 For Each Node In AreaXML.DocumentElement.SelectNodes("item[@parentid=0 and @filtertf=1]")
      If KS.ChkClng(Node.SelectSingleNode("@id").text)=currk Then
        If SEOTitle="" Then SEOTitle=CurrNode.SelectSingleNode("title").text &":" & Node.SelectSingleNode("@city").text Else SEOTitle=SEOTitle & " " &CurrNode.SelectSingleNode("title").text & ":" & Node.SelectSingleNode("@city").text
                    KS_top_brands=Node.SelectSingleNode("@city").text
        FieldMenu=FieldMenu & "<strong>" & Node.SelectSingleNode("@city").text & "</strong>"
      Else
           FieldMenu=FieldMenu & "<a href=""" & GetFieldLink("areabox",Node.SelectSingleNode("@id").text,"")  & """ title=""" &Node.SelectSingleNode("@city").text&""">" & Node.SelectSingleNode("@city").text & "</a>"

      End If
     Next
     FieldMenu=FieldMenu & "</div>"
     parentid=KS.ChkClng(split(GetParam("areabox")&":",":")(0))
        Call GetSubAreaMenuBox(parentid)
        FieldMenu=FieldMenu & "<div class=""clear""></div>"
         
   Case "brandid"   '商城品牌
    If HasBrand Then
     currk=KS.ChkClng(GetParam("brandid"))
     If currk=0 Then
      If SEOTitle="" Then SEOTitle=CurrNode.SelectSingleNode("title").text &":不限" Else SEOTitle=SEOTitle & " " &CurrNode.SelectSingleNode("title").text & ":不限"
      Province=""
      FieldMenu=FieldMenu & "<strong>不限</strong>"
     Else
      FieldMenu=FieldMenu & "<a href=""" & GetFieldLink("brandid","0","") & """>不限</a>"
     End If
      For Each Node In BrandNodes

  2.3处：

If KS.ChkClng(KS.C_S(ChannelID,6))=1 Then
    If Not KS.IsNul(Province) Then
     Param=Param & " And Province='" & KS.DelSQL(Province) &"'"
    End If
    If Not KS.IsNul(City) Then
     Param=Param & " And City='" & KS.DelSQL(City) &"'"
    End If
    If Not KS.IsNul(KS_top_brands) Then
     Param=Param & " And KS_top_brands='" & KS.DelSQL(KS_top_brands) &"'"
    End If
    If Not KS.IsNul(KS_top_chexi) Then
     Param=Param & " And KS_top_chexi='" & KS.DelSQL(KS_top_chexi) &"'"
    End If
   ElseIf KS.ChkClng(GetParam("brandid"))<>0 And KS.ChkClng(KS.C_S(ChannelID,6))=5 Then
     Param=Param & " and brandid=" & KS.ChkClng(GetParam("brandid"))
   ElseIf KS.ChkClng(GetParam("typeid"))<>0 And KS.ChkClng(KS.C_S(ChannelID,6))=8 Then
     Param=Param & " and typeid=" & KS.ChkClng(GetParam("typeid"))
   End If

  2.4处：

Next
    FieldMenu=FieldMenu & "</div>"
   End If   
   
   End If
    End Sub
   
    '复制子地区
    Sub GetSubAreaMenuBox(parentid)
      If IsObject(AreaXML) and parentid<>0 Then
             Dim Node,currareaid,k,nodes,tj,ts,nn,pparam
      Set Nodes=AreaXML.DocumentElement.SelectNodes("item[@parentid=" & parentid &" and @filtertf=1]")
     if Nodes.length>0 Then
         FieldMenu=FieldMenu & "<DIV class=""condition_title"">&nbsp;</DIV><DIV class=""container"">"
      nn=0
      For Each Node In Nodes
         param=parentid & ":" & Node.SelectSingleNode("@id").text
      currareaid=split(GetParam("areabox")&":",":")(1)
      if nn=0 then
       If ks.chkclng(currareaid)=0 Then
          KS_top_chexi=""
       FieldMenu=FieldMenu & "<strong>不限</strong>"
       Else
       FieldMenu=FieldMenu & "<a href=""" & GetFieldLink("areabox",parentid&":0","") & """>不限</a>"
       End If
      end if
      nn=nn+1
      If KS.ChkClng(currareaid)=KS.ChkClng(Node.SelectSingleNode("@id").text) Then
       SEOTitle=SEOTitle & "," &Node.SelectSingleNode("@city").text
      KS_top_chexi=Node.SelectSingleNode("@city").text
         FieldMenu=FieldMenu & "<strong>" & Node.SelectSingleNode("@city").text & "</strong>"
      Else
        FieldMenu=FieldMenu & "<a href=""" & GetFieldLink("areabox",param,"") & """ title=""" &Node.SelectSingleNode("@city").text&""">" & Node.SelectSingleNode("@city").text & "</a>"
      End If
    Next
    FieldMenu=FieldMenu & "</div>"
   End If   


   End If
    End Sub
  
  Function GetParam(key)
    If KS.IsNUL(Request.QueryString) Then GetParam="":Exit Function
    Dim PArr:Parr=Split(Replace(Request.QueryString,".html",""),",")
    Dim Pkey,Pval,i
    For I=0 To Ubound(Parr)
       if instr(Parr(i),"-")<>0 Then
      Pkey=Split(Parr(i),"-")(0)
         if lcase(key)=lcase(Pkey) Then
        Pval=Split(Parr(i),"-")(1)
     Exit For
      End If
    End If
    Next
    GetParam=Pval
  End Function
  

三改asp：ks_cls/Kesion.CommonCls.asp

XMLStr=XMLStr&"</area>" &vbcrlf
   Call WriteTOFile(Setting(3) & "config/area.xml",xmlstr)
   End If
   RS.CLose
   Set RS=Nothing
End Sub

  
  '复制生成地区缓存
  Sub CreateAreaCacheBox()
   Dim XMLStr,RS:Set RS=Server.CreateObject("adodb.recordset")
   RS.Open "Select * From KS_ProvinceBox Order By ParentID,OrderID,ID",conn,1,1
   If Not RS.EOf Then
   XMLStr="<?xml version=""1.0"" encoding=""gb2312"" ?>" &vbcrlf
   XMLStr=XMLStr&"<areabox>" &vbcrlf
   Do While Not RS.Eof
    XMLStr=XMLStr & "<item id=""" & RS("ID") & """ city=""" & RS("City") & """ parentid=""" & RS("ParentID") &""" filtertf=""" & rs("filtertf") &"""></item>" &vbcrlf
    RS.MoveNext
   Loop
   XMLStr=XMLStr&"</areabox>" &vbcrlf
   Call WriteTOFile(Setting(3) & "config/areabox.xml",xmlstr)
   End If
   RS.CLose
   Set RS=Nothing
End Sub

'生成商品品牌缓存
Sub CreateBrandCache()
   Dim XMLStr,RS:Set RS=Server.CreateObject("adodb.recordset")
   RS.Open "Select B.ID,R.ClassID,B.BrandName From KS_ClassBrand B inner join KS_ClassBrandR R On B.id=R.BrandID  order by B.orderid",conn,1,1
   If Not RS.EOf Then
   XMLStr="<?xml version=""1.0"" encoding=""gb2312"" ?>" &vbcrlf
   XMLStr=XMLStr&"<brand>" &vbcrlf
   Do While Not RS.Eof
    XMLStr=XMLStr & "<item id=""" & RS("ID") & """ classid=""" & RS("classid") & """><brandname><![CDATA[ " & RS("BrandName") &"]]></brandname></item>" &vbcrlf
    RS.MoveNext
   Loop
   XMLStr=XMLStr&"</brand>" &vbcrlf

四改数据库：

  4.1、复制数据表KS_Province并命名为KS_ProvinceBox

  4.2、打开表KS_Field复制FieldID为952行的数据，粘贴到最后一行；

将字段FieldName值改为“areaBox”、将字段Title值改为“复制地区”、将字段OrderID值改为“103”

  4.3、进后台打开二手房赛选，选中“复制地区”保存

此时前台已经有了扩增的联动赛选项

五改asp：admin/Index.asp

       <%If KS.ReturnPowerResult(0, "KMST10016") Then %>
       <li><a href='javascript:void(0)' onClick="SelectObjItem1(this,'辅助管理 >> <font color=red>作者管理</font>','Disabled','KS.Author.asp?ChannelID=0');">作者管理</a> </li>
       <%end if%>

       <%If KS.ReturnPowerResult(0, "KMST10017") Then %>
       <li><a href='javascript:void(0)' onClick="SelectObjItem1(this,'辅助管理 >> <font color=red>省市管理</font>','Disabled','KS.Province.asp');">地区管理</a> </li>

       <%end if%>
                        
                        
                         <%If KS.ReturnPowerResult(0, "KMST10021") Then %>
       <li><a href='javascript:void(0)' onClick="SelectObjItem1(this,'辅助管理 >> <font color=red>复制省市管理</font>','Disabled','KS.ProvinceBox.asp');">复制地区管理</a> </li>
       <%end if%>

六复制asp：复制admin/KS.Province.asp命名为“KS.ProvinceBox.asp”

6.1处：

Public Sub Kesion()
   If Not KS.ReturnPowerResult(0, "KMST10021") Then                  '权限检查
    Call KS.ReturnErr(1, "")   
    Response.End()
   End if
%>

  6.2将所有的“KS.Province.asp”替换成“KS.ProvinceBox.asp”

       将所有的“KS_Province”替换成“KS_ProvinceBox”

       将所有的“KS.CreateAreaCache”替换成“KS.CreateAreaCacheBox”

   6.3刷新后台

此时就可以在后台更改选项了，字段KS_top_brands替代了省、字段KS_top_chexi替代了市

注意：1、红色为添加或修改部分；

           2、修改KS_top_brands、KS_top_chexi两字段后，前台筛选“复制地区”项没变化时；删除Config/areabox.xml后更新缓存或刷新筛选页面两次，即可解决该问题。

支持下 吼吼

http://www.4864678.com