📄 ks_refreshfunctioncls.asp
字号:
ArticleSql = "SELECT TOP " & PicArticleNumber & " ID,Tid,Title,PicUrl,TitleType,TitleFontColor,TitleFontType,ArticleContent,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article WHERE Verific=1 AND DelTF<>1 AND PicNews=1 And " & ArticlePropertyStr & " ORDER BY " & ArticleSort
ElseIf CBool(IncludeSubClass) = True Then
Dim ArticleTid
ArticleTid = GetFolderTid(FolderID) '取子目录ID集合
ArticleSql = "SELECT TOP " & PicArticleNumber & " ID,Tid,Title,PicUrl,TitleType,TitleFontColor,TitleFontType,ArticleContent,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article WHERE tid in (" & ArticleTid & ") AND Verific=1 AND DelTF<>1 AND PicNews=1 AND " & ArticlePropertyStr & " ORDER BY " & ArticleSort
Else
ArticleSql = "SELECT TOP " & PicArticleNumber & " ID,Tid,Title,PicUrl,TitleType,TitleFontColor,TitleFontType,ArticleContent,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article Where Tid='" & FolderID & "' AND Verific=1 AND DelTF<>1 AND PicNews=1 AND " & ArticlePropertyStr & " ORDER BY " & ArticleSort
End If
OpenTypeStr = GetOpenTypeStr(OpenType)
'调用通用图片文章列表函数
GetPicArticleList = GetCommonPicArticleList(ArticleSql, PicWidth, PicHeight, OpenTypeStr, ShowTitle, PicStyle, ContentLen, TitleLen, ColNumber, TitleCss, ThumbsBorderType, ThumbsBorder)
End Function
'取得滚动文章函数
Function GetMarqueeArticle(FolderID, IncludeSubClass, MarqueeWidth, MarqueeHeight, MarqueeSpeed, MarqueeDirection, OpenType, ArticleSort, TitleLen, MarqueeStyle, MarqueeArticleNumber, DateRule, MarqueeBgcolor, TitleCss, DateCss)
Dim ArticleSql, OpenTypeStr
If MarqueeArticleNumber = "" Or Not IsNumeric(MarqueeArticleNumber) Then MarqueeArticleNumber = 10
If FolderID = "-1" Then FolderID = Application(Cstr(KSCMS.SiteSN & "RefreshFolderID")) '如果是通用标签,则置刷新目录ID为当前ID
If Lcase(Left(Trim(ArticleSort),2))<>"id" Then
ArticleSort=ArticleSort & ",ID Desc"
End IF
If FolderID = "" Or FolderID = "0" Then
ArticleSql = "SELECT TOP " & MarqueeArticleNumber & " ID,Tid,Title,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article WHERE Verific=1 AND DelTF<>1 And Rolls=1 ORDER BY " & ArticleSort
ElseIf CBool(IncludeSubClass) = True Then
Dim ArticleTid
ArticleTid = GetFolderTid(FolderID) '取子目录ID集合
ArticleSql = "SELECT TOP " & MarqueeArticleNumber & " ID,Tid,Title,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article WHERE tid in (" & ArticleTid & ") AND Verific=1 AND DelTF<>1 And Rolls=1 ORDER BY " & ArticleSort
Else
ArticleSql = "SELECT TOP " & MarqueeArticleNumber & " ID,Tid,Title,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article Where Tid='" & FolderID & "' AND Verific=1 AND DelTF<>1 And Rolls=1 ORDER BY " & ArticleSort
End If
OpenTypeStr = GetOpenTypeStr(OpenType)
'调用通用滚动文章函数
GetMarqueeArticle = GetCommonMarqueeArticle(ArticleSql, MarqueeWidth, MarqueeHeight, MarqueeSpeed, MarqueeDirection, OpenTypeStr, TitleLen, MarqueeStyle, DateRule, MarqueeBgcolor, TitleCss, DateCss)
End Function
'取得今日头条文章函数
Function GetStripArticle(FolderID, IncludeSubClass, ColNumber, OpenType, StripArticleNumber, RowHeight, TitleLen, NavType, Nav, SplitPic, TitleCss)
Dim ArticleSql,OpenTypeStr,MoreLinkStr
StripArticleNumber=Cint(StripArticleNumber)
If FolderID = "-1" Then FolderID = Application(Cstr(KSCMS.SiteSN & "RefreshFolderID")) '如果是通用标签,则置刷新目录ID为当前ID
If FolderID = "" Or FolderID = "0" Then
ArticleSql = "SELECT TOP " & StripArticleNumber & " ID,NewsID,Tid,Title,ShowComment,Comment,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article WHERE Verific=1 AND DelTF<>1 AND Strip=1 ORDER BY ID Desc"
ElseIf CBool(IncludeSubClass) = True Then
Dim ArticleTid
ArticleTid = GetFolderTid(FolderID) '取子目录ID集合
ArticleSql = "SELECT TOP " & StripArticleNumber & " ID,NewsID,Tid,Title,ShowComment,Comment,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article WHERE tid in (" & ArticleTid & ") AND Verific=1 AND DelTF<>1 AND Strip=1 order by ID desc"
Else
ArticleSql = "SELECT TOP " & StripArticleNumber & " ID,NewsID,Tid,Title,ShowComment,Comment,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article Where Tid='" & FolderID & "' AND Verific=1 AND DelTF<>1 And Strip=1 order by ID desc"
End If
MoreLinkStr = ""
OpenTypeStr = GetOpenTypeStr(OpenType)
'调用通用栏目文章列表函数
GetStripArticle = GetCommonArticleList(ArticleSql, MoreLinkStr, False, OpenTypeStr, RowHeight, TitleLen, ColNumber, False, NavType, Nav, SplitPic, "0", "", TitleCss, "")
End Function
'取得相关文章
Function GetCorrelativeArticle(ChannelID, CorrelativeArticleNumber, RowHeight, TitleLen, ColNumber, OpenType, NavType, Nav, SplitPic, DateRule, DateAlign, TitleCss)
If Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "ArticleContent" Then
Dim SqlStr
SqlStr = "Select KeyWords From KS_Article Where NewsID='" & Application(Cstr(KSCMS.SiteSN & "RefreshArticleID")) & "'"
Dim ArticleRS
Set ArticleRS=Server.CreateObject("ADODB.RECORDSET")
ArticleRS.Open SqlStr, Conn, 1, 1
If Not ArticleRS.EOF Then
If Trim(ArticleRS("KeyWords")) <> "" And IsNull(ArticleRS("KeyWords")) = False Then
Dim KeyWordsArr, I, SqlKeyWordStr
KeyWordsArr = Split(Trim(ArticleRS("KeyWords")), "|")
For I = 0 To UBound(KeyWordsArr)
If SqlKeyWordStr = "" Then
SqlKeyWordStr = "KeyWords like '%" & KeyWordsArr(I) & "%' "
Else
SqlKeyWordStr = SqlKeyWordStr & "or KeyWords like '%" & KeyWordsArr(I) & "%' "
End If
Next
ArticleRS.Close
Set ArticleRS = Nothing
Dim ArticleSql, OpenTypeStr
ArticleSql = "Select TOP " & CorrelativeArticleNumber & " ID,NewsID,Tid,Title,ShowComment,Comment,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname,Changes FROM KS_Article Where (" & SqlKeyWordStr & ") AND NewsID<>'" & Application(Cstr(KSCMS.SiteSN & "RefreshArticleID")) & "' AND DelTF<>1 AND Verific=1 order by ID Desc"
OpenTypeStr = GetOpenTypeStr(OpenType)
'调用通用栏目文章列表函数
GetCorrelativeArticle = GetCommonArticleList(ArticleSql, "", False, OpenTypeStr, RowHeight, TitleLen, ColNumber, False, NavType, Nav, SplitPic, DateRule, DateAlign, TitleCss, "")
If GetCorrelativeArticle = "" Then GetCorrelativeArticle = "<li>暂无相关链接"
Else
GetCorrelativeArticle = ""
ArticleRS.Close
Set ArticleRS = Nothing
Exit Function
End If
Else
GetCorrelativeArticle = ""
ArticleRS.Close:Set ArticleRS = Nothing:Exit Function
End If
Else
GetCorrelativeArticle = ""
End If
End Function
'取得频道专题汇总函数
Function GetArticleTotalSpecialList(FolderID, OpenType, SpecialListNumber, RowHeight, TitleLen, ColNumber, NavType, Nav, MoreLinkType, MoreLink, SplitPic, DateRule, DateAlign, TitleCss, DateCss)
'刷新前,移除缓存Application
Call KSCMS.DelApplication
Dim SpecialRS
Set SpecialRS=Server.CreateObject("ADODB.Recordset")
SpecialRS.Open "Select TOP " & SpecialListNumber & " * From KS_Special Where ChannelID=1 And FolderID='" & FolderID & "'", Conn, 1, 1
If Not SpecialRS.EOF Then
Dim TempStr, TempTitle, I,OpenTypeStr, CurrPath,NaviStr, ColSpanNum,TitleCssStr, DateCssStr
TitleCssStr = GetCss(TitleCss):DateCssStr = GetCss(DateCss):OpenTypeStr = GetOpenTypeStr(OpenType)
RowHeight = GetRowHeight(RowHeight):NaviStr = GetNavi(NavType, Nav)
TempStr = "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"" align=""center"">" & vbCrLf
Do While Not SpecialRS.EOF
TempStr = TempStr & "<tr>" & vbCrLf
For I = 1 To ColNumber
CurrPath = GetSpecialPath(SpecialRS("ID"), True)
TempTitle = Trim(SpecialRS("SpecialName"))
TempTitle = KSCMS.GotTopic(TempTitle, TitleLen)
TempTitle = "<a" & TitleCssStr & " href=""" & CurrPath & """" & OpenTypeStr & " title=""" & SpecialRS("SpecialName") & """>" & TempTitle & "</a>"
TempStr = TempStr & ("<td WIDTH=""" & CInt(100 / CInt(ColNumber)) & "%"" height=""" & RowHeight & """>" & vbCrLf)
TempStr = TempStr & ("<table width=""100%"" height=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"">" & vbCrLf)
TempStr = TempStr & ("<tr><td> " & NaviStr & TempTitle & "</td>")
If CStr(DateRule) <> "0" And CStr("DateRule") <> "" Then
Dim AddDate
AddDate = SpecialRS("SpecialAddDate")
TempStr = TempStr & ("<td width=""20%"" nowrap align=" & DateAlign & "><span " & DateCssStr & ">" & DateFormat(AddDate, DateRule) & "</span></td></tr>" & vbCrLf)
ColSpanNum = 2
Else
TempStr = TempStr & ("</tr>" & vbCrLf)
ColSpanNum = 1
End If
If SplitPic <> "" Then
TempStr = TempStr & (GetSplitPic(SplitPic, ColSpanNum) & vbCrLf)
End If
TempStr = TempStr & ("</table>" & vbCrLf)
TempStr = TempStr & ("</td>" & vbCrLf)
SpecialRS.MoveNext
If SpecialRS.EOF Then Exit For
Next
TempStr = TempStr & "</tr>" & vbCrLf
Loop
If MoreLink <> "" Then
TempStr = TempStr & GetMoreLink(ColNumber, RowHeight, MoreLinkType, MoreLink, GetFolderSpecialPath(FolderID, True), OpenTypeStr)
End If
TempStr = TempStr & ("</table>" & vbCrLf)
SpecialRS.Close:Set SpecialRS = Nothing
GetArticleTotalSpecialList = TempStr
Else
GetArticleTotalSpecialList = "":SpecialRS.Close:Set SpecialRS = Nothing
Exit Function
End If
End Function
'取得循环频道专题汇总
Function GetCirChannelSpecialList(ColNumber, FolderCss, MenuBgType, MenuBg, SpecialListNumber, RowHeight, TitleLen, OpenType, NavType, Nav, MoreLinkType, MoreLink, SplitPic, DateRule, DateAlign, TitleCss, DateCss)
'on Error Resume Next
If Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "SpecialIndex" Then
Dim SqlStr, FolderRS
Set FolderRS=Server.CreateObject("ADODB.RECORDSET")
SqlStr = "Select FolderName,ID From KS_Class Where DelTF=0 AND TN='0' And ChannelID=1 ORDER BY FolderOrder"
FolderRS.Open SqlStr, Conn, 1, 1
If FolderRS.EOF And FolderRS.BOF Then
FolderRS.Close:Set FolderRS = Nothing
GetCirChannelSpecialList = ""
Exit Function
Else
Dim TempStr, I, MenuBgStr, SpecialListStr,FolderName
TempStr = "<TABLE BORDER=""0"" Cellpadding=""0"" Cellspacing=""2"" Width=""100%"">" & vbCrLf
MenuBgStr = GetMenuBg(MenuBgType, MenuBg, ColNumber)
Do While Not FolderRS.EOF
TempStr = TempStr & "<TR>" & vbCrLf
For I = 1 To ColNumber
TempStr = TempStr & "<TD WIDTH=""" & CInt(100 / CInt(ColNumber)) & "%"" HEIGHT=""150"" VALIGN=""top"">" & vbCrLf
TempStr = TempStr & "<table height=""100%"" width=""100%"" border=""0"" align=""center"" cellPadding=""0"" cellSpacing=""0"">" & vbCrLf
TempStr = TempStr & "<tr><td style=""height: 29;border-top: 1px solid #d2d3d9;border-left: 1px solid #d2d3d9;border-right: 1px solid #d2d3d9;padding-left:30;""" & MenuBgStr & "><strong>"
FolderName = Trim(FolderRS("FolderName"))
TempStr = TempStr & "<span" & GetCss(FolderCss) & ">" & FolderName & "专题</span></strong></td></tr>" & vbCrLf
TempStr = TempStr & "<tr><td style=""border: 1px solid #D2D3D9;line-height: 150%;text-align: left;padding-left:5;padding-right:5;"" vAlign=""top"">" & vbCrLf
'调用频道专题汇总函
SpecialListStr = GetArticleTotalSpecialList(FolderRS("ID"), OpenType, SpecialListNumber, RowHeight, TitleLen, 1, NavType, Nav, MoreLinkType, MoreLink, SplitPic, DateRule, DateAlign, TitleCss, DateCss)
If Trim(SpecialListStr) = "" Then SpecialListStr = "<li>此频道下没有专题</li>"
TempStr = TempStr & SpecialListStr
TempStr = TempStr & "</td></tr>" & vbCrLf
TempStr = TempStr & "</table>" & vbCrLf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -