科讯6.5企业黄页首页列表显示

　　也不知道是我的操作不正确还是怎么回事，想让企业黄页以列表的形式显示出来 可是怎么调整也不行 算了，最后打算还是自己动手改造吧！既方便也快捷，废话不多说一下是改造科讯6.5企业黄页首页列表显示过程：

我直接将修改过的源代码发上来吧！我语言能力不行，不要见笑........

<%Option Explicit%>
<!--#include File="../Conn.asp"-->
<!--#include file="../KS_Cls/Kesion.CommonCls.asp"-->
<!--#include file="../KS_Cls/Kesion.Label.CommonCls.asp"-->
<%

'****************************************************
' Software name:Kesion CMS 6.5
' Email: service@kesion.com . QQ:111394,9537636
' Web: http://www.kesion.com http://www.kesion.cn
' Copyright (C) Kesion Network All Rights Reserved.
'****************************************************
Dim SearchCls
Set SearchCls = New SearchResult
SearchCls.Kesion()
Set SearchCls = Nothing

Class SearchResult
    Private KS,KMR,F_C,LoopContent,SearchResult,photourl
 Private ChannelID,ClassID,SearchType,str,astr,SearchForm
    Private I,TotalPut, CurrentPage,MaxPerPage,RS,KeyWordArr
  
 Private Sub Class_Initialize()
 
 '***********判断是否与服务器端连接*********
  If (Not Response.IsClientConnected)Then
   Response.Clear
   Response.End
   End If
 
  Set KS=New PublicCls
  Set KMR=New Refresh
  MaxPerPage=3
  If KS.S("page") <> "" Then
          CurrentPage = CInt(Request("page"))
        Else
          CurrentPage = 1
        End If

 End Sub

 Private Sub Class_Terminate()
'  response.Write "bbbbbbbb"
        closeconn
     Set KS=Nothing
  Set KMR=Nothing
 End Sub
 
 Sub Kesion()
           F_C = KMR.LoadTemplate(KS.Setting(3) & KS.Setting(90) & "企业空间/index.html")
     If Trim(F_C) = "" Then F_C = "模板不存在!"
    
     FCls.RefreshType = "enterprise" '设置刷新类型，以便取得当前位置导航等
     Fcls.RefreshFolderID = "0" '设置当前刷新目录ID 为"0" 以取得通用标签
    
     '********获取分类*********
     call GetClassList()
     F_C=Replace(F_C,"{$ShowClass}",str)
     '********获取地区*********
     call getarealist()
     F_C=Replace(F_C,"{$ShowAreaList}",astr)
    
'     Response.Write FCls.RefreshType&"fffffffffffsss"
     '得到“[loop] [/loop]”中间的所有内容
      LoopContent=KS.CutFixContent(F_C, "[loop]", "[/loop]", 0)
   Call LoadSearch()
   F_C = KMR.KSLabelReplaceAll(F_C)
   Response.Write F_C
 End Sub
 
 
Sub GetClassList()
   Dim RS,I,RSS
   Set RS=Conn.Execute("select id,classname from ks_enterpriseclass where parentid=0 order by orderid")
   str="<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"">" & vbcrlf
   Do While Not RS.Eof
   str=str & "<tr>" & vbcrlf
   for i=1 to 2
     str=str & "<td width=""50%"" style=""padding:5px"">" & vbcrlf
     str=str & "<div style=""height:20px;"" class=""classname""><span style=""font-weight:bold""><img src=""../images/arrow_r.gif""> <a href=""list.asp?pid=" & rs(0) & """>" & rs(1) &"</a></span>(" & conn.execute("select count(id) from ks_enterprise where status=1 and classid=" & rs(0))(0) &") </div>" & vbcrlf
     str=str & "<div style=""height:50px;padding-left:12px"">"
     dim xml,node,num,n
     set rss=conn.execute("select id,classname from ks_enterpriseclass where parentid=" & rs(0))
     if not rss.eof then set xml=KS.RsToXml(rss,"row","") else xml=empty
     rss.close:set rss=nothing
     if isobject(xml) then
         num=xml.DocumentElement.SelectNodes("row").length : n=0
      for each node in xml.DocumentElement.SelectNodes("row")
    str=str & "<a href='list.asp?id=" & node.selectsinglenode("@id").text & "'>" & node.selectsinglenode("@classname").text & "</a>"
    n=n+1
    if num<>n then str=str & " | "
      next
    xml=empty : set node=nothing
     end if
     str=str & "</div>"
     str=str & "</td>" & vbcrlf
     rs.movenext
     if rs.eof then exit for
   next
   str=str & "</tr>"
   Loop
   str=str & "</table>" & vbcrlf
   rs.close:set rs=nothing
End Sub
 
'******************获取地区*********
Sub getarealist()
    Dim RS,I,SQL,K,N
    Set RS=Conn.Execute("Select id,city from KS_Province where parentid=0 order by orderid")
    IF Not RS.Eof Then SQL=RS.GetRows(-1):RS.Close:Set RS=Nothing
    If IsArray(SQL) Then
     astr="<table border='0' width='100%'>" &vbcrlf
     N=0
     For i=0 To Ubound(SQL,2)
    astr=astr & "<tr>" &vbcrlf
    For K=1 To 3
    astr=astr & "<td><img src='../images/arrow_r.gif'> <a href=""list.asp?province=" & sql(1,n) & "&provinceid=" & SQL(0,n) & """>" & sql(1,n) & "</a></td>"
    n=n+1
    if n>Ubound(SQL,2) then Exit For
    Next
    astr=astr & "</tr>" &vbcrlf
    if n>Ubound(SQL,2) then Exit For
    Next
    astr=astr & "</table>" & vbcrlf
   End If
End Sub
 
 
 

 Sub LoadSearch()
     Call ArticleSearch()
' F_C = Replace(F_C,"{$GetClassName}","郑州家政网")
 F_C = Replace(F_C,"{$ShowTotal}",totalput)
 F_C = Replace(F_C,KS.CutFixContent(F_C, "[loop]", "[/loop]", 1),SearchResult)
 F_C = Replace(F_C,"{$ShowPage}",KS.ShowPage(totalput, MaxPerPage, "", CurrentPage,false,false))
  End Sub
 
 
Sub ArticleSearch()
  Dim SqlStr,Param
'  Param=" Where IsShow=1"
'  If DQType <> 0 Then Param = Param &" And Y_DiQu="& DQType &""
 
 SqlStr="Select * From KS_EnterPrise" & Param & " Order By ID Desc"
  Set RS=Server.CreateObject("ADODB.RECORDSET")
  RS.Open SqlStr,Conn,1,3
  IF RS.Eof And RS.Bof Then
      totalput=0
      SearchResult = "<a href=""http://www.21863.cn"">郑州家政网</a>"
   exit sub
  Else
     TotalPut= Conn.Execute("Select count(*) from KS_EnterPrise" & Param)(0)
                    If CurrentPage < 1 Then CurrentPage = 1

                    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
                             Call GetSearchResult
                    Else
                        If (CurrentPage - 1) * MaxPerPage < totalPut Then
                            RS.Move (CurrentPage - 1) * MaxPerPage
                            Call GetSearchResult
                        Else
                            CurrentPage = 1
                            Call GetSearchResult
                        End If
                    End If
    End IF
 RS.Close
 Set RS=Nothing
End Sub  

  Sub GetSearchResult()
      on error resume next
   I=0
       Dim LC
    Do While Not RS.Eof
    If Not Response.IsClientConnected Then Response.end
     LC=LoopContent
     LC=replace(LC,"{$GetUserName}",rs("UserName"))
     LC=replace(LC,"{$GetCompanyName}",rs("CompanyName"))
     LC=replace(LC,"{$GetProvince}",rs("Province"))
     LC=replace(LC,"{$GetCity}",rs("City"))
     LC=replace(LC,"{$GetAddress}",rs("Address"))
     LC=replace(LC,"{$GetEmail}",rs("Email"))
     LC=replace(LC,"{$GetMobile}",rs("Mobile"))
     LC=replace(LC,"{$GetIntro}",KS.gotTopic(FilterAllHTML(rs("Intro")),180))
'     LC=replace(LC,"{$GetLinkUrl}","/"&Y_JZDir&"info.asp?"& rs("ID") &".html")
   '替换自定义字段 ReplaceUserDefine
     LC=LFCls.ReplaceUserDefine(ChannelID,LC,RS)
     SearchResult=SearchResult & LC
   I = I + 1
   If I >= MaxPerPage Then Exit Do
   RS.MoveNext
  Loop
  End Sub
 
'*************************************
'***********过滤HTML******************
'*************************************
Function FilterAllHTML(strHTML)
 'Strips the HTML tags from strHTML
 Dim objRegExp, strOutput
 Set objRegExp = New Regexp
 objRegExp.IgnoreCase = True
 objRegExp.Global = True
 objRegExp.Pattern = "<.+?>"
 'Replace all HTML tag matches with the empty string
 strOutput = objRegExp.Replace(strHTML, "")
 'Replace all < and > with < and >
 strOutput = Replace(strOutput, "&lt;p&gt;", "")
 strOutput = Replace(strOutput, "&lt;/p&gt;", "")
 strOutput = Replace(strOutput, "<", "<")
 strOutput = Replace(strOutput, ">", ">")
 FilterAllHTML = strOutput 'Return the value of strOutput
 Set objRegExp = Nothing
End Function

End Class
%>

为了让显示的简介能正常显示 我使用了 FilterAllHTML 函数将所有HTML都给过滤了！本人使用的科讯6.5

可能以上程序有错误之处 还请大虾们指正 共同研究 学习