<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> <%option explicit%> <% '****************************************************************** ' Software name:KesionCMS X1.0 '****************************************************************** Dim KSCls Set KSCls = New SiteMaps KSCls.Kesion() Set KSCls = Nothing Class SiteMaps Private KS, KSR,ModelTable,XML,Node,Key,TotalPut,MaxPerPage,ChannelID,ID,Tid,OrderStr,PageNum,StartTime,CurrPage,Param Private Sub Class_Initialize() If (Not Response.IsClientConnected)Then Response.Clear Response.End End If Set KS=New PublicCls Set KSR = New Refresh End Sub Private Sub Class_Terminate() Call CloseConn() Set KS=Nothing End Sub Public Sub Kesion() ChannelID=114 MaxPerPage=12 ID=KS.ChkClng(KS.S("id")) Dim FileContent Dim MapTemplatePath:MapTemplatePath="template/车型经销商.html" '模板地址 FileContent = KSR.LoadTemplate(MapTemplatePath) FCls.RefreshType = "param" '设置刷新类型,以便取得当前位置导航等 FCls.RefreshFolderID = "0" '设置当前刷新目录ID 为"0" 以取得通用标签 Dim RS:Set RS=Conn.Execute("Select top 1 a.*,ClassPurview,DefaultArrGroupID,DefaultReadPoint,DefaultChargeType,DefaultPitchTime,DefaultReadTimes From " & KS.C_S(ChannelID,2) & " a inner join KS_Class b on a.tid=b.id Where a.ID=" & ID) IF RS.Eof And RS.Bof Then RS.Close:Set RS=Nothing KS.ShowTips "error","您要查看的" & KS.C_S(ChannelID,3) & "已删除。或是您非法传递注入参数!" End IF Dim DocXML:Set DocXML=KS.RsToXml(RS,"row","root") : RS.Close:Set RS=Nothing With KSR Set .Node=DocXml.DocumentElement.SelectSingleNode("row") .Tid=.Node.SelectSingleNode("@tid").text .oTid=.Node.SelectSingleNode("@otid").text Call FCls.SetContentInfo(ChannelID,.Tid,.Otid,ID,.Node.SelectSingleNode("@title").text) Tid=.Tid Dim N,K,PageStr,NextUrl,PrevUrl .ModelID = ChannelID .ItemID = ID .Templates="" .Scan FileContent FileContent = .Templates FileContent = .KSLabelReplaceAll(FileContent) End With StartTime = Timer() InitialSearch Scan FileContent End Sub Sub ParseArea(sTokenName, sTemplate) Select Case sTokenName Case "loop" If IsObject(XML) Then For Each Node In Xml.DocumentElement.SelectNodes("row") Scan sTemplate Next Else echo "
对不起,根据您的查找条件,找不到任何相关记录!
" End If End Select End Sub Sub ParseNode(sTokenType, sTokenName) Select Case lcase(sTokenType) case "item" EchoItem sTokenName case "search" select case sTokenName case "menu" SearchMenu case "showpage" echo KS.ShowPage(totalput, MaxPerPage, "", CurrPage,false,false) case "totalput" echo TotalPut case "leavetime" dim leavetime:leavetime=FormatNumber((timer-starttime),5) if leavetime<1 then leavetime="0"&leavetime echo leavetime case "keyword" echo KS.R(key) case "channelid" echo channelid end select End Select End Sub Sub EchoItem(sTokenName) Select Case sTokenName case "id" echo GetNodeText("id") case "linkurl" echo KS.GetItemURL(7,GetNodeText("tid"),GetNodeText("id"),GetNodeText("fname")) case "classname" echo KS.C_C(GetNodeText("tid"),1) case "classurl" echo KS.GetFolderPath(GetNodeText("tid")) case "intro" Dim Intro:intro=KS.Gottopic(KS.LoseHtml(GetNodeText("intro")),160) Intro=Replace(Intro," ","") If Not KS.IsNul(Key) Then echo Replace(Intro,key,"" & key & "") Else echo intro End If case "cx" dim rsb:set rsb=conn.execute("select top 1 intro from ks_bj where infoid=" & id &" and username='" & GetNodeText("username") & "'") if rsb.eof then echo "无" else echo KS.Gottopic(KS.LoseHtml(rsb(0)),150) end if rsb.close set rsb=nothing case else echo GetNodeText(sTokenName) End Select End Sub Function GetNodeText(NodeName) Dim N,Str NodeName=Lcase(NodeName) If IsObject(Node) Then set N=node.SelectSingleNode("@" & NodeName) If Not N is Nothing Then Str=N.text If Not KS.IsNul(Key) And NodeName="title" Then Dim I,KeyWordArr:KeyWordArr=Split(Key," ") For I=0 To Ubound(KeyWordArr) Str=Replace(Str,KeyWordArr(i),"" &KeyWordArr(i) & "") Next End If GetNodeText=Str End If End Function Sub InitialSearch() Dim FieldStr,SqlStr,TopStr,TopNum CurrPage=KS.ChkClng(Request("Page")) If CurrPage<=0 Then CurrPage=1 Param=" Where b.status=1 and a.username in(select username from KS_JYCX Where InfoID=" & ID &")" If KS.S("Province")<>"" Then Param=Param &" and b.Province='" & KS.CheckXSS(KS.S("Province")) & "'" End If If KS.S("City")<>"" Then Param=Param &" and b.City='" & KS.CheckXSS(KS.S("City")) & "'" End If OrderStr=" Order by b.ID Desc" SqlStr="Select a.userid,b.* From KS_Blog A inner Join KS_EnterPrise b On a.UserName=b.UserName " & Param & OrderStr 'ks.die sqlstr Dim RS:Set RS=Server.CreateObject("ADODB.RECORDSET") RS.Open SqlStr,conn,1,1 If RS.Eof And RS.Bof Then Else TotalPut = RS.RecordCount If TotalPut>TopNum And TopNum<>0 Then TotalPut=TopNum If CurrPage >1 and (CurrPage - 1) * MaxPerPage < totalPut Then RS.Move (CurrPage - 1) * MaxPerPage Else CurrPage = 1 End If Set XML=KS.ArrayToXml(RS.GetRows(MaxPerPage),RS,"row","root") End If RS.Close Set RS=Nothing End Sub End Class %>