<%@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=20 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() dim rsf:set rsf=conn.execute("select top 1 options From KS_Field Where Channelid=2 AND FieldName='ks_type'") if not rsf.eof then dim options:options=rsf(0) if not ks.isnul(options) then dim ii,oparr:oparr=split(options,vbcrlf) dim str for ii=0 to ubound(oparr) str=str &"
" & oparr(ii) & "(0张)
" &vbcrlf str=str &" " next end if end if FileContent=replace(FileContent,"{#showpiclist}",str) ks.die FileContent 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 "shorttitle" echo KS.Gottopic(GetNodeText("title"),22) case "linkurl" echo KS.GetItemURL(2,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 "picnum" echo Ubound(split(GetNodeText("picurls"),"|||"))+1 case "piclist" dim ni,picarr:picarr=split(GetNodeText("picurls")&"||||||||||||||||||||||||||||||","||||") for ni=0 to 7 if Not KS.IsNul(picarr(ni)) then if Not KS.IsNUL(split(picarr(ni),"|")(1)) Then echo "
  • " echo "" echo "
  • " end if end if next 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 Verific=1 and deltf=0" Param=Param & " And oTid In(" & KS.GetFolderTid(Tid) & ")" ModelTable="KS_Photo" FieldStr="*" OrderStr=" Order by ID Desc" SqlStr="Select " & TopStr & " " & FieldStr & " From " & ModelTable & 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 = Conn.Execute("select Count(1) from " & ModelTable & " " & Param)(0) 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 %>