📄 ks_refreshfunctioncls.asp
字号:
Dim AllowMaxNum:AllowMaxNum=1000 '限定允许在1000条，内调用
'如果是通用标签,则置刷新目录ID为当前ID
If FolderID = "-1" Then
FolderID = Application(Cstr(KSCMS.SiteSN & "RefreshFolderID"))
CurrFolderFlag = True
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,Changes 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,Changes 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,Changes 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 ID FROM KS_Article WHERE SpecialID like '%" & Application(Cstr(KSCMS.SiteSN & "CurrSpecialID")) & "%' AND Verific=1 And DelTF=0 Order by ID Desc"
Else
FolderID = Application(Cstr(KSCMS.SiteSN & "RefreshFolderID"))
If CBool(IncludeSubClass) = True Then
Dim ArticleTid
ArticleTid = GetFolderTid(FolderID) '取子目录ID集合
ArticleSql = "SELECT ID FROM KS_Article WHERE Tid in (" & ArticleTid & ") AND Verific=1 AND DelTF<>1 order by ID Desc"
Else
ArticleSql = "SELECT ID FROM KS_Article Where Tid='" & FolderID & "' AND Verific=1 AND DelTF<>1 order by ID Desc"
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
PerPageNumber=cint(PerPageNumber)
Dim PageNum, I, J, k, TempStr, OpenTypeStr
Dim FolderNameAndLinkStr, TempTitle, NaviStr, ColSpanNum
Dim CurrTid, AddDate,SqlStr
OpenTypeStr = GetOpenTypeStr(OpenType)
dim totalput,TempIDArrStr
TotalPut = ArticleRS.recordcount
if (TotalPut mod PerPageNumber)=0 then
PageNum = TotalPut \ PerPageNumber
else
PageNum = TotalPut \ PerPageNumber + 1
end if
For I = 1 To PageNum
ArticleRS.Move (I - 1) * PerPageNumber,1
TempIDArrStr = ""
For J = 1 To PerPageNumber
TempIDArrStr = TempIDArrStr &ArticleRS(0) & ","
ArticleRS.MoveNext
If ArticleRS.EOF Then Exit For
Next
TempIDArrStr = Left(TempIDArrStr, Len(TempIDArrStr) - 1)
SqlStr = "SELECT * FROM KS_Article Where ID in (" & TempIDArrStr & ") AND Verific=1 AND DelTF=0 order by " & ArticleSort
TempStr = TempStr & "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & vbCrLf
TempStr = TempStr & "<tr>" & vbCrLf
TempStr = TempStr & "<td>" & vbCrLf
TempStr = TempStr & GetCommonArticleList(SqlStr, "", ShowClassName, OpenTypeStr, RowHeight, TitleLen, 1, ShowPicFlag, NavType, Nav, SplitPic, DateRule, DateAlign, TitleCss, DateCss)
TempStr = TempStr & "</td>" & vbCrLf & "</tr>"
TempStr = TempStr & "<tr><td align=""right"" height=""25"">" & "共 " & TotalPut & " 篇 页次:<font color=red> " & I & "</font>/" & PageNum & "页 " & PerPageNumber & " 篇/页 "
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,Changes 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,Changes 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,Changes 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"))
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 = "" Or FolderID = "0" Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -