ks_refreshfunctioncls.asp
来自「1.支持文章」· ASP 代码 · 共 1,023 行 · 第 1/5 页
ASP
1,023 行
Else
CurrFolderFlag = False
End If
If FolderID = "" Then FolderID = "0"
If ArticleProperty <> "" Then
ArticlePropertyStr = " 1=1"
If ArticleProperty = 1 Then
ArticlePropertyStr = " Recommend=1" '推荐文章
ElseIf ArticleProperty = 2 Then
ArticlePropertyStr = " Popular=1" '热门文章
End If
End If
If Lcase(Left(Trim(ArticleSort),2))<>"id" Then
ArticleSort=ArticleSort & ",ID Desc"
End IF
If FolderID = "0" Then
ArticleSql = "SELECT TOP " & AllowMaxNum & " ID,NewsID,Tid,Title,ShowComment,Comment,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname FROM KS_Article WHERE Verific=1 AND DelTF=0 AND " & ArticlePropertyStr & " ORDER BY " & ArticleSort
ElseIf cbool(IncludeSubClass) = True Then
Dim ArticleTid
ArticleTid = GetFolderTid(FolderID) '取子目录ID集合
ArticleSql = "SELECT TOP " & AllowMaxNum & " ID,NewsID,Tid,Title,ShowComment,Comment,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname FROM KS_Article WHERE Tid in (" & ArticleTid & ") AND Verific=1 AND DelTF<>1 AND " & ArticlePropertyStr & " ORDER BY " & ArticleSort
Else
ArticleSql = "SELECT TOP " & AllowMaxNum & " ID,NewsID,Tid,Title,ShowComment,Comment,TitleType,TitleFontColor,TitleFontType,AddDate,InfoPurview,ReadPoint,Fname FROM KS_Article Where Tid='" & FolderID & "' AND Verific=1 AND DelTF<>1 AND " & ArticlePropertyStr & " ORDER BY " & ArticleSort
End If
OpenTypeStr = GetOpenTypeStr(OpenType)
If MoreLink <> "" And FolderID <> "0" And CurrFolderFlag = False Then
MoreLinkStr = GetMoreLink(1, RowHeight, MoreLinkType, MoreLink, KSCMS.GetFolderPath(FolderID, True), OpenTypeStr)
End If
'调用通用不规则文章列表函数
GetNotRuleArticleList = GetCommonNotRuleArticleList(ArticleSql,RowNumber, ShowNumPerRow, MoreLinkStr, OpenTypeStr, RowHeight, NavType, Nav, SplitPic, TitleCss)
End Function
'循环列出文章栏目函数
Function GetCirArticleList(ColNumber, FolderCss, MenuBgType, MenuBg, ShowClassName, OpenType, ArticleListNumber, RowHeight, TitleLen, ArticleSort, NavType, Nav, MoreLinkType, MoreLink, SplitPic, DateRule, DateAlign, TitleCss, ShowPicFlag)
If Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "ArticleFolder" Then
Call KSCMS.DelApplication '刷新前,移除缓存Application
Dim FolderID, SqlStr,FolderRS,ID
Set FolderRS=Server.CreateObject("ADODB.RECORDSET")
FolderID = Trim(Application(Cstr(KSCMS.SiteSN & "RefreshFolderID")))
SqlStr = "Select ID From KS_Class Where DelTF=0 AND TN='" & FolderID & "' ORDER BY FolderOrder"
FolderRS.Open SqlStr, Conn, 1, 1
If FolderRS.EOF And FolderRS.BOF Then
FolderRS.Close:Set FolderRS = Nothing:GetCirArticleList = "": Exit Function
Else
Dim TempStr, I, MenuBgStr, ArticleListStr, OpenTypeStr
TempStr = "<TABLE BORDER=""0"" Cellpadding=""0"" Cellspacing=""2"" Width=""100%"">" & vbCrLf
MenuBgStr = GetMenuBg(MenuBgType, MenuBg, ColNumber):OpenTypeStr = GetOpenTypeStr(OpenType)
Do While Not FolderRS.EOF
TempStr = TempStr & "<TR>" & vbCrLf
For I = 1 To ColNumber
ID = Trim(FolderRS("ID"))
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>"
TempStr = TempStr & KSCMS.GetFolderNameAndLink(ID, OpenTypeStr, FolderCss) & "</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
'调用文章栏目函数
ArticleListStr = GetArticleList(ID, True, ShowClassName, OpenType, 0, ArticleListNumber, RowHeight, TitleLen, ArticleSort, 1, ShowPicFlag, NavType, Nav, MoreLinkType, MoreLink, SplitPic, DateRule, DateAlign, TitleCss, "")
If Trim(ArticleListStr) = "" Then ArticleListStr = "<li>此栏目下没有文章</li>"
TempStr = TempStr & ArticleListStr
TempStr = TempStr & "</td></tr>" & vbCrLf
TempStr = TempStr & "</table>" & vbCrLf
TempStr = TempStr & "</TD>" & vbCrLf
FolderRS.MoveNext
If FolderRS.EOF Then Exit For
Next
TempStr = TempStr & "</TR>" & vbCrLf
'TempStr = TempStr & "<TR><TD HEIGHT=""5"" COLSPAN=""" & ColNumber & """></TD></TR>"
Loop
TempStr = TempStr & "</TABLE>" & vbCrLf
GetCirArticleList = TempStr
End If
Else
GetCirArticleList = ""
End If
End Function
'取得文章分页函数
Function GetLastArticleList(PerPageNumber, RowHeight, ShowClassName, OpenType, TitleLen, ArticleSort, IncludeSubClass, ShowPicFlag, NavType, Nav, SplitPic, DateRule, DateAlign, TitleCss, DateCss)
On Error Resume Next
Dim FolderID, ArticleSql, CommentStr
If Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "ArticleFolder" Or Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "Special" Then
If Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "Special" Then '刷新专题,查询语句不同
ArticleSql = "SELECT * FROM KS_Article WHERE SpecialID='" & Application(Cstr(KSCMS.SiteSN & "CurrSpecialID")) & "' AND Verific=1 And DelTF=0 Order by " & ArticleSort
Else
FolderID = Application(Cstr(KSCMS.SiteSN & "RefreshFolderID"))
If CBool(IncludeSubClass) = True Then
Dim ArticleTid
ArticleTid = GetFolderTid(FolderID) '取子目录ID集合
ArticleSql = "SELECT * FROM KS_Article WHERE Tid in (" & ArticleTid & ") AND Verific=1 AND DelTF<>1 order by " & ArticleSort
Else
ArticleSql = "SELECT * FROM KS_Article Where Tid='" & FolderID & "' AND Verific=1 AND DelTF<>1 order by " & ArticleSort
End If
End If
Dim ArticleRS:Set ArticleRS=Server.CreateObject("ADODB.RECORDSET")
ArticleRS.Open ArticleSql, Conn, 1, 1
If ArticleRS.EOF And ArticleRS.BOF Then
GetLastArticleList = "<p>此栏目下没有文章</p>"
Application(Cstr(KSCMS.SiteSN & "PageArticleList")) = ""
ArticleRS.Close:Set ArticleRS = Nothing:Exit Function
Else
Dim PageNum, I, J, k, TempStr, OpenTypeStr
Dim FolderNameAndLinkStr, TempTitle, NaviStr, ColSpanNum
Dim CurrTid, TitleCssStr, DateCssStr, AddDate
TitleCssStr = GetCss(TitleCss):DateCssStr = GetCss(DateCss):OpenTypeStr = GetOpenTypeStr(OpenType)
RowHeight = GetRowHeight(RowHeight):NaviStr = GetNavi(NavType, Nav):ArticleRS.PageSize = PerPageNumber
PageNum = ArticleRS.PageCount
For I = 1 To PageNum
TempStr = TempStr & "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & vbCrLf
For J = 1 To ArticleRS.PageSize
CurrTid = Trim(ArticleRS("Tid"))
If CBool(ShowClassName) = True Then FolderNameAndLinkStr = "[" & KSCMS.GetFolderNameAndLink(CurrTid, OpenTypeStr, "") & "]"
TempTitle = GetArticleTitle(ArticleRS("Title"), TitleLen, ShowPicFlag, ArticleRS("TitleType"), ArticleRS("TitleFontColor"), ArticleRS("TitleFontType"))
If ArticleRS("ShowComment") = 1 And ArticleRS("Comment") = 1 Then
CommentStr = " <a href=""" & KSCMS.GetDomain & "Common/Comment.asp?ChannelID=1&Classid=" & CurrTid & "&InfoID=" & ArticleRS("NewsID") & """ target=""_blank"">评论</a>"
Else
CommentStr = ""
End If
TempTitle = "<a" & TitleCssStr & " href=""" & (KSCMS.GetInfoUrl(1,ArticleRS)) & """" & OpenTypeStr & " title=""" & ArticleRS("Title") & """>" & TempTitle & "</a>" & CommentStr
TempStr = TempStr & "<tr>" & vbCrLf
TempStr = TempStr & "<td height=""" & RowHeight & """>" & vbCrLf
TempStr = TempStr & "<table width=""100%"" height=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"">" & vbCrLf
TempStr = TempStr & "<tr><td>" & NaviStr & FolderNameAndLinkStr & TempTitle & "</td>"
If CStr(DateRule) <> "0" And CStr("DateRule") <> "" Then
AddDate = ArticleRS("AddDate")
If Year(Now) & Month(Now) & Day(Now) = Year(AddDate) & Month(AddDate) & Day(AddDate) Then
TempStr = TempStr & "<td width=""20%"" nowrap align=" & DateAlign & "><span style=""color:red""" & DateCssStr & ">" & DateFormat(AddDate, DateRule) & "</span></td>"
Else
TempStr = TempStr & "<td width=""20%"" nowrap align=" & DateAlign & "><span" & DateCssStr & ">" & DateFormat(AddDate, DateRule) & "</span></td>"
End If
TempStr = TempStr & "</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 & "</tr>"
ArticleRS.MoveNext:If ArticleRS.EOF Then Exit For
Next
TempStr = TempStr & "<tr><td align=""right"">" & "共 " & ArticleRS.RecordCount & " 篇 页次:<font color=red> " & I & "</font>/" & PageNum & "页 " & ArticleRS.PageSize & " 篇/页 "
TempStr = TempStr & "[NextPage]" '加上分页符
Next
GetLastArticleList = "":Application(Cstr(KSCMS.SiteSN & "PageArticleList")) = TempStr
End If
ArticleRS.Close:Set ArticleRS = Nothing
Else
GetLastArticleList = "":Application(Cstr(KSCMS.SiteSN & "PageArticleList")) = ""
End If
End Function
'取得幻灯片文章
Function GetSlideArticle(FolderID, IncludeSubClass, PicWidth, PicHeight, ArticleListNumber, OpenType, ShowTitle, ShowPicFlag, TitleLen, TitleCss, ChangeTime,SlideType)
Dim ArticleSql, OpenTypeStr
If FolderID = "-1" Then FolderID = Application(Cstr(KSCMS.SiteSN & "RefreshFolderID")) '如果是通用标签,则置刷新目录ID为当前ID
If FolderID = "" Or FolderID = "0" Then
ArticleSql = "SELECT TOP " & ArticleListNumber & " ID,PicUrl,Tid,Title,TitleType,TitleFontColor,TitleFontType,InfoPurview,ReadPoint,Fname FROM KS_Article WHERE Verific=1 AND DelTF=0 AND PicNews=1 AND Slide=1 ORDER BY ID Desc"
ElseIf CBool(IncludeSubClass) = True Then
Dim ArticleTid
ArticleTid = GetFolderTid(FolderID) '取子目录ID集合
ArticleSql = "SELECT TOP " & ArticleListNumber & " ID,PicUrl,Tid,Title,TitleType,TitleFontColor,TitleFontType,InfoPurview,ReadPoint,Fname FROM KS_Article WHERE Tid IN (" & ArticleTid & ") AND Verific=1 AND DelTF<>1 AND PicNews=1 AND Slide=1 ORDER BY ID Desc"
Else
ArticleSql = "SELECT TOP " & ArticleListNumber & " ID,PicUrl,Tid,Title,TitleType,TitleFontColor,TitleFontType,InfoPurview,ReadPoint,Fname FROM KS_Article Where Tid='" & FolderID & "' AND Verific=1 AND DelTF<>1 AND PicNews=1 AND Slide=1 ORDER BY ID Desc"
End If
OpenTypeStr = GetOpenTypeStr(OpenType)
GetSlideArticle = GetCommonSlideArticle(ArticleSql, PicWidth, PicHeight, OpenTypeStr, ShowTitle, ShowPicFlag, TitleLen, TitleCss, ChangeTime,SlideType)
End Function
'取得图片文章列表函数
Function GetPicArticleList(FolderID, IncludeSubClass, PicWidth, PicHeight, OpenType, ShowTitle, ArticleProperty, PicStyle, ContentLen, TitleLen, PicArticleNumber, ArticleSort, ColNumber, TitleCss, ThumbsBorderType, ThumbsBorder)
Dim ArticleSql, ArticlePropertyStr, OpenTypeStr
'如果是通用标签,则置刷新目录ID为当前ID
If FolderID = "-1" Then FolderID = Application(Cstr(KSCMS.SiteSN & "RefreshFolderID"))
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?