%Option Explicit%>
<%
'****************************************************
' Software name:Kesion CMS 7.0
' Email: service@kesion.com . QQ:111394,9537636
' Web: http://www.kesion.com http://www.kesion.cn
' Copyright (C) Kesion Network All Rights Reserved.
'****************************************************
Dim TCls
Set TCls = New Tags
TCls.Kesion()
Set TCls = Nothing
Const MaxPerPage=20 '每页显示条数
Const MaxTags=500 '默认显示tags个数
Class Tags
Private KS,KMR,F_C,LoopContent,SearchResult,photourl
Private ChannelID,ClassID,SearchType,TagsName,SearchForm
Private I,TotalPut, CurrentPage,RS
Private Sub Class_Initialize()
Set KS=New PublicCls
Set KMR=New Refresh
If KS.S("page") <> "" Then
CurrentPage = CInt(Request("page"))
Else
CurrentPage = 1
End If
End Sub
Private Sub Class_Terminate()
closeconn
Set KS=Nothing
Set KMR=Nothing
End Sub
Sub Kesion()
F_C = KMR.LoadTemplate(KS.Setting(120))
If Trim(F_C) = "" Then F_C = "模板不存在!"
FCls.RefreshType = "tags" '设置刷新类型,以便取得当前位置导航等
FCls.RefreshFolderID = "0" '设置当前刷新目录ID 为"0" 以取得通用标签
TagsName=KS.CheckXSS(KS.S("n"))
If TagsName="" Then
Call TagsMain()
Else
Call TagsList()
End If
F_C = KMR.KSLabelReplaceAll(F_C)
Call TagsHits()
Response.Write F_C
End Sub
Sub TagsMain()
Dim TP:Tp=LFCls.GetConfigFromXML("tags","/labeltemplate/label","tags")
Dim RS,SQL,K,str
If InStr(tp,"{$ShowHotTags}")<>0 Then
Set RS=Conn.Execute("Select top " & MaxTags & " KeyText,hits From KS_KeyWords order by hits desc,id desc")
If Not RS.Eof Then SQL=RS.GetRows(-1)
RS.Close:Set RS=Nothing
If IsArray(SQL) Then
For k=0 to Ubound(SQL,2)
str=str & "" & SQL(0,K) & " "
Next
End If
Tp=Replace(Tp,"{$ShowHotTags}",str)
End If
If InStr(tp,"{$ShowNewTags}")<>0 Then
str=""
Set RS=Conn.Execute("Select top " & MaxTags & " KeyText,hits From KS_KeyWords order by adddate desc")
If Not RS.Eof Then SQL=RS.GetRows(-1)
RS.Close:Set RS=Nothing
If IsArray(SQL) Then
For k=0 to Ubound(SQL,2)
str=str & "" & SQL(0,K) & " "
Next
End If
Tp=Replace(Tp,"{$ShowNewTags}",str)
End If
F_C=Replace(F_C,"{$ShowTags}",Tp)
F_C=Replace(F_C,"{$TagsName}","")
End Sub
Sub TagsList()
SearchTags()
TagsHits()
F_C=Replace(F_C,"{$ShowTags}",SearchResult)
F_C=Replace(F_C,"{$PageStr}","
" & ShowPagePara(totalput, MaxPerPage, "", true,"条记录", CurrentPage,KS.QueryParam("page,submit")) & "
")
F_C = Replace(F_C,"{$TagsName}",TagsName)
F_C = Replace(F_C,"{$ShowTotal}",totalput)
End Sub
Sub TagsHits()
If TagsName<>"" Then
Conn.Execute("Update KS_KeyWords set hits=hits+1,lastusetime=" & SqlNowString & " where keytext='" & TagsName & "'")
End IF
End Sub
Sub SearchTags()
Dim SqlStr,Param,SQL,K
Dim RSC:Set RSC=conn.execute("select ChannelID,ChannelTable From KS_Channel Where ChannelID<>6 And ChannelID<>8 And ChannelID<>9 and ChannelID<>10 and ChannelStatus=1 order by channelid")
SQL=RSC.GetRows(-1):RSC.Close:Set RSC=Nothing
For K=0 To Ubound(SQL,2)
If SqlStr<>"" Then SqlStr=SqlStr & " Union All "
Select Case KS.C_S(SQL(0,K),6)
Case 1
SqlStr=SqlStr & "select ID,Title,Tid,ReadPoint,InfoPurview,Fname,Changes,AddDate,Popular," & SQL(0,K) & " as ChannelID,hits,Inputer As username From " & SQL(1,K)
case 2
SqlStr=SqlStr & "select ID,Title,Tid,ReadPoint,InfoPurview,Fname,0 as Changes,AddDate,Popular," & SQL(0,K) & " as ChannelID,Hits,Inputer As username From " & SQL(1,K)
case 3
SqlStr=SqlStr & "select ID,Title,Tid,ReadPoint,InfoPurview,Fname,0 as Changes,AddDate,Popular," & SQL(0,K) & " as ChannelID,Hits,Inputer As username From " & SQL(1,K)
case 4
SqlStr=SqlStr & "select ID,Title,Tid,ReadPoint,InfoPurview,Fname,0 as Changes,AddDate,Popular," & SQL(0,K) & " as ChannelID,Hits,Inputer As username From " & SQL(1,K)
Case 5
SqlStr=SqlStr & "select ID,Title,Tid,0 as ReadPoint,0 as InfoPurview,Fname,0 as Changes,AddDate,Popular," & SQL(0,K) & " as ChannelID,Hits,Inputer As username From " & SQL(1,K)
Case 7
SqlStr=SqlStr & "select ID,Title,Tid,0 as ReadPoint,0 as InfoPurview,Fname,0 as Changes,AddDate,Popular," & SQL(0,K) & " as ChannelID,Hits,Inputer As username From " & SQL(1,K)
End Select
SqlStr=SqlStr & " Where DelTF=0 And Verific=1 And keywords like '%" & TagsName & "%'"
Next
SqlStr="Select ID,Title,Tid,ReadPoint,InfoPurview,Fname,Changes,AddDate,Popular,ChannelID,hits,username From (" & SQLStr & ") a ORDER BY ADDDATE DESC,ID Asc"
Set RS=Server.CreateObject("ADODB.RECORDSET")
RS.Open SqlStr,Conn,1,1
IF RS.Eof And RS.Bof Then
totalput=0
SearchResult = "Tags:" & TagsName & ",没有找到任何相关信息!"
exit sub
Else
TotalPut= RS.Recordcount
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 and (CurrentPage - 1) * MaxPerPage < totalPut Then
RS.Move (CurrentPage - 1) * MaxPerPage
Else
CurrentPage = 1
End If
Call GetSearchResult
End IF
RS.Close
Set RS=Nothing
End Sub
Sub GetSearchResult()
On Error Resume Next
Dim LP:LP=LFCls.GetConfigFromXML("tags","/labeltemplate/label","listtp")
LoopContent=KS.CutFixContent(LP, "[loop]", "[/loop]", 0)
I=0
Dim LC
Do While Not RS.Eof
LC=LoopContent
LC=replace(LC,"{$Title}",rs(1))
If IsNull(rs(11)) or rs(11)="" Then
LC=replace(LC,"{$UserName}","-")
Else
LC=replace(LC,"{$UserName}",rs(11))
End If
LC=replace(LC,"{$Hits}",rs(10))
LC=replace(LC,"{$AddDate}",formatdatetime(rs(7),2))
LC=replace(LC,"{$ClassName}",KS.GetClassNP(rs(2)))
LC=replace(LC,"{$Url}",KS.GetItemUrl(rs(9),rs(2),rs(0),rs(5)))
SearchResult=SearchResult & LC
I = I + 1
If I >= MaxPerPage Then Exit Do
RS.MoveNext
Loop
LP=Replace(LP,KS.CutFixContent(LP, "[loop]", "[/loop]", 1),SearchResult)
SearchResult=LP
End Sub
Public Function ShowPagePara(totalnumber, MaxPerPage, FileName, ShowAllPages, strUnit, CurrentPage, ParamterStr)
Dim N, I, PageStr
Const Btn_First = "9" '定义第一页按钮显示样式
Const Btn_Prev = "3" '定义前一页按钮显示样式
Const Btn_Next = "4" '定义下一页按钮显示样式
Const Btn_Last = ":" '定义最后一页按钮显示样式
PageStr = ""
If totalnumber Mod MaxPerPage = 0 Then
N = totalnumber \ MaxPerPage
Else
N = totalnumber \ MaxPerPage + 1
End If
PageStr = PageStr & (""
ShowPagePara = PageStr
End Function
End Class
%>