📄 ks_refreshfunctioncls.asp
字号:
GetCommonSlideArticle = GetCommonSlideArticle & ("}" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("function LoopShowSlidePic() {" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("if(this.PicNum<this.AllPic.length-1) this.PicNum++ ;" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("else this.PicNum=0;" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("this.Img.filters.revealTrans.Transition=this.Effect;" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("this.Img.filters.revealTrans.apply();" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("this.Img.src=this.AllPic[this.PicNum].ImgUrl;" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("this.Img.filters.revealTrans.play();" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("this.Url.href=this.AllPic[this.PicNum].LinkUrl;" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("if(this.Title) this.Title.innerHTML='<a href=""'+this.AllPic[this.PicNum].LinkUrl+'"" " & OpenTypeStr & ">'+this.AllPic[this.PicNum].Title+'</a>';" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("this.Img.timer=setTimeout(this.ID+"".LoopShow()"",this.TimeOut);" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("}" & vbCrLf)
'新建幻灯片文章对象
GetCommonSlideArticle = GetCommonSlideArticle & ("var SlidePic = new SlidePic(""SlidePic"");" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("SlidePic.Width = " & PicWidth & ";" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("SlidePic.Height = " & PicHeight & ";" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("SlidePic.TimeOut = " & ChangeTime & ";" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("SlidePic.Effect = 23;" & vbCrLf)
If CBool(ShowTitle) = False Then
GetCommonSlideArticle = GetCommonSlideArticle & ("SlidePic.TitleLen = 0;" & vbCrLf)
Else
GetCommonSlideArticle = GetCommonSlideArticle & ("SlidePic.TitleLen = 1;" & vbCrLf)
End If
Do While Not ArticleRS.EOF
PicUrl = Trim(ArticleRS("PicUrl"))
If UCase(Left(PicUrl, 4)) <> "HTTP" Then PicUrl = Domain & PicUrl
CurrTid = ArticleRS("Tid")
TempTitle = GetArticleTitle(ArticleRS("Title"), TitleLen, ShowPicFlag, ArticleRS("TitleType"), ArticleRS("TitleFontColor"), ArticleRS("TitleFontType"))
TempTitle = "<span" & TitleCssStr & ">" & TempTitle & "</span>"
GetCommonSlideArticle = GetCommonSlideArticle & "var NewItem = new NewSlide();" & vbCrLf
GetCommonSlideArticle = GetCommonSlideArticle & "NewItem.ImgUrl = '" & PicUrl & "';" & vbCrLf
GetCommonSlideArticle = GetCommonSlideArticle & "NewItem.LinkUrl= '" & KSCMS.GetInfoUrl(1,ArticleRS) & "';" & vbCrLf
GetCommonSlideArticle = GetCommonSlideArticle & "NewItem.Title = '" & TempTitle & "';" & vbCrLf
GetCommonSlideArticle = GetCommonSlideArticle & "SlidePic.Add(NewItem);" & vbCrLf
ArticleRS.MoveNext
Loop
GetCommonSlideArticle = GetCommonSlideArticle & ("SlidePic.Show();" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("//-->" & vbCrLf)
GetCommonSlideArticle = GetCommonSlideArticle & ("</Script>" & vbCrLf)
ArticleRS.Close:Set ArticleRS = Nothing
GetCommonSlideArticle = GetCommonSlideArticle
Else
GetCommonSlideArticle = "":ArticleRS.Close:Set ArticleRS = Nothing
End If
End IF
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'函数名: GetCommonPicArticleList
'作 用: 通用图片文章函数
'参 数: ArtilceSql 待查询的SQL语句,OpenTypStr链接打开类型,等
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function GetCommonPicArticleList(ArticleSql, PicWidth, PicHeight, OpenTypeStr, ShowTitle, PicStyle, ContentLen, TitleLen, ColNumber, TitleCss, ThumbsBorderType, ThumbsBorder)
Dim ReturnStr
Dim ArticleRS:Set ArticleRS=Server.CreateObject("ADODB.RECORDSET")
ArticleRS.Open ArticleSql, Conn, 1, 1
If Not ArticleRS.EOF Then
Dim TempPicStr, TempTitleStr, I, Domain, CurrTid,Title, TitleCssStr
Domain = KSCMS.GetConfig("WebUrl"):TitleCssStr = GetCss(TitleCss)
ReturnStr = "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & vbCrLf
Do While Not ArticleRS.EOF
ReturnStr = ReturnStr & "<tr>" & vbCrLf
For I = 1 To ColNumber
CurrTid = ArticleRS("Tid")
Title = ArticleRS("Title"):TempPicStr = Trim(ArticleRS("PicUrl"))
If UCase(Left(TempPicStr, 4)) <> "HTTP" Then TempPicStr = Domain & TempPicStr
'-------------------------------加边框开始-------------------------------------------------
Dim TempThumbsBorder
If ThumbsBorderType = 1 And ThumbsBorder <> "" Then
TempThumbsBorder = TempPicStr '得到原图片
TempPicStr = ThumbsBorder '将原图片设定为透明边框
Else
TempThumbsBorder = ThumbsBorder:TempPicStr = TempPicStr
End If
Dim LinkAndPicStr: LinkAndPicStr = "<a href=""" & KSCMS.GetInfoUrl(1,ArticleRS) & """" & OpenTypeStr & " title=""" & Title & """><Img Src=""" & TempPicStr & """ border=""0"" width=""" & PicWidth & """ height=""" & PicHeight & """ align=""absmiddle""></a>"
'给图片加边框
TempPicStr = GetPhotoBorder(LinkAndPicStr, ThumbsBorderType, TempThumbsBorder)
'-----------------------------------图片加边框结束-------------------------------------------------------------------
TempTitleStr = GetArticleTitle(Title, TitleLen, False, ArticleRS("TitleType"), ArticleRS("TitleFontColor"), ArticleRS("TitleFontType"))
TempTitleStr = "<a" & TitleCssStr & " href=""" & (KSCMS.GetInfoUrl(1,ArticleRS)) & """" & OpenTypeStr & " title=""" & Title & """>" & TempTitleStr & "</a>"
ReturnStr = ReturnStr & ("<td width=""" & CInt(100 / CInt(ColNumber)) & "%"">" & vbCrLf)
Select Case CInt(PicStyle)
Case 1 '样式一
ReturnStr = ReturnStr & ("<table border=""0"" cellspacing=""0"" cellpadding=""0"" width=""100%""> ")
ReturnStr = ReturnStr & ("<tr><td align=center>" & TempPicStr & "</td></tr>" & vbCrLf)
If CBool(ShowTitle) = True Then
ReturnStr = ReturnStr & ("<tr><td align=center>" & TempTitleStr & "</td></tr>" & vbCrLf)
End If
ReturnStr = ReturnStr & ("</table>")
Case 2 '样式二
ReturnStr = ReturnStr & "<TABLE cellSpacing=""0"" cellPadding=""0"" width=""100%"" border=""0"">" & vbCrLf
ReturnStr = ReturnStr & " <TBODY>" & vbCrLf
ReturnStr = ReturnStr & " <TR>" & vbCrLf
ReturnStr = ReturnStr & " <TD align=center>" & vbCrLf
ReturnStr = ReturnStr & "<TABLE align=center cellSpacing=0 cellPadding=0 border=0>" & vbCrLf
ReturnStr = ReturnStr & "<TBODY><TR><TD width=110 align=center>" & TempPicStr & "</TD></TR></TBODY>" & vbCrLf
ReturnStr = ReturnStr & "</TABLE></TD>" & vbCrLf
ReturnStr = ReturnStr & "<TD> <TABLE width=""100%"" border=""0"">" & vbCrLf
ReturnStr = ReturnStr & "<TBODY>"
If CBool(ShowTitle) = True Then
ReturnStr = ReturnStr & "<TR><TD>" & TempTitleStr & "</TD></TR>" & vbCrLf
End If
ReturnStr = ReturnStr & "<TR><TD>" & KSCMS.GotTopic(Replace(Replace(Replace(LoseHtml(ArticleRS("ArticleContent")), vbCrLf, ""), "[NextPage]", ""), " ", ""), ContentLen) & "……</TD></TR>" & vbCrLf
ReturnStr = ReturnStr & "</TBODY>" & vbCrLf
ReturnStr = ReturnStr & "</TABLE></TD>" & vbCrLf
ReturnStr = ReturnStr & " </TR>" & vbCrLf
ReturnStr = ReturnStr & "</TBODY></TABLE>" & vbCrLf
Case 3 '样式三
ReturnStr = ReturnStr & "<TABLE cellSpacing=""0"" cellPadding=""0"" width=""100%"" border=""0"">" & vbCrLf
ReturnStr = ReturnStr & " <TBODY>" & vbCrLf
ReturnStr = ReturnStr & " <TR>" & vbCrLf
ReturnStr = ReturnStr & "<TD> <TABLE width=""100%"" border=""0"">" & vbCrLf
ReturnStr = ReturnStr & "<TBODY>"
If CBool(ShowTitle) = True Then
ReturnStr = ReturnStr & "<TR><TD>" & TempTitleStr & "</TD></TR>" & vbCrLf
End If
ReturnStr = ReturnStr & "<TR><TD>" & KSCMS.GotTopic(Replace(Replace(Replace(LoseHtml(ArticleRS("ArticleContent")), vbCrLf, ""), "[NextPage]", ""), " ", ""), ContentLen) & "……</TD></TR>" & vbCrLf
ReturnStr = ReturnStr & "</TBODY>" & vbCrLf
ReturnStr = ReturnStr & "</TABLE></TD>" & vbCrLf
ReturnStr = ReturnStr & " <TD align=center>" & vbCrLf
ReturnStr = ReturnStr & "<TABLE align=center cellSpacing=0 cellPadding=0 border=0>" & vbCrLf
ReturnStr = ReturnStr & "<TBODY><TR><TD width=110 align=center>" & TempPicStr & "</TD></TR></TBODY>" & vbCrLf
ReturnStr = ReturnStr & "</TABLE></TD>" & vbCrLf
ReturnStr = ReturnStr & " </TR>" & vbCrLf
ReturnStr = ReturnStr & "</TBODY></TABLE>" & vbCrLf
End Select
ReturnStr = ReturnStr & ("</td>" & vbCrLf)
ArticleRS.MoveNext:If ArticleRS.EOF Then Exit For
Next
ReturnStr = ReturnStr & ("</tr>" & vbCrLf)
ReturnStr = ReturnStr & ("<tr><td colspan=""" & ColNumber & """ height=""5""></td></tr>")
Loop
GetCommonPicArticleList = ReturnStr & ("</table>" & vbCrLf)
ArticleRS.Close:Set ArticleRS = Nothing
Else
GetCommonPicArticleList = "":ArticleRS.Close:Set ArticleRS = Nothing
End If
End Function
'=======================================================================================通用函数结束=============================
'取得栏目文章列表
Function GetArticleList(FolderID, IncludeSubClass, ShowClassName, OpenType, ArticleProperty, ArticleListNumber, RowHeight, TitleLen, ArticleSort, ColNumber, ShowPicFlag, NavType, Nav, MoreLinkType, MoreLink, SplitPic, DateRule, DateAlign, TitleCss, DateCss)
Dim ArticleSql, ArticlePropertyStr,MoreLinkStr, OpenTypeStr,CurrFolderFlag
'如果是通用标签,则置刷新目录ID为当前ID
If FolderID = "-1" Then
FolderID = Application(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 " & ArticleListNumber & " 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 " & ArticleListNumber & " 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 " & ArticleListNumber & " 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(ColNumber, RowHeight, MoreLinkType, MoreLink, KSCMS.GetFolderPath(FolderID, True), OpenTypeStr)
End If
'调用通用文章列表函数
GetArticleList = GetCommonArticleList(ArticleSql, MoreLinkStr, ShowClassName, OpenTypeStr, RowHeight, TitleLen, ColNumber, ShowPicFlag, NavType, Nav, SplitPic, DateRule, DateAlign, TitleCss, DateCss)
End Function
'取得不规则栏目文章列表
Function GetNotRuleArticleList(FolderID, IncludeSubClass, OpenType, ArticleProperty, RowNumber, ShowNumPerRow, RowHeight, ArticleSort, NavType, Nav, MoreLinkType, MoreLink, SplitPic, TitleCss)
Dim ArticleSql, ArticlePropertyStr
Dim MoreLinkStr, OpenTypeStr
Dim CurrFolderFlag
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -