📄 ks.labelcls.asp
字号:
Function GetRolls(ChannelID,FolderID, I_S_C, M_Dir, SqlSort, M_Width, M_Height, OpenType, ShowTitle, Width, Height, M_Speed, Num, T_Len, T_Css, BorderType, Border,SpecialID)
Dim SqlStr,Param
If FolderID = "-1" Then FolderID = Application(KS.SiteSN & "RefreshFolderID")
If FolderID = "" Or FolderID = "0" Then Param="" Else If CBool(I_S_C) = True Then Param="Tid In (" & KS.GetFolderTid(FolderID) & ") And" Else Param="Tid='" & FolderID & "' And"
Select Case KS.C_S(ChannelID,6)
Case 1:SqlStr = "SELECT top " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,Changes,PicUrl FROM " & KS.C_S(ChannelID,2) &" Where " & Param & " Rolls=1 And PicNews=1 AND Verific=1 AND DelTF=0 And " & KS.GetSpecialPara(SpecialID)& " order by IsTop Desc," & SqlSort
Case 2:SqlStr = "SELECT top " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,PhotoUrl FROM " & KS.C_S(ChannelID,2) &" Where " & Param & " Rolls=1 AND Verific=1 AND DelTF=0 And " & KS.GetSpecialPara(SpecialID) & " order by " & SqlSort
Case 3:SqlStr = "SELECT top " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,PhotoUrl FROM " & KS.C_S(ChannelID,2) &" Where " & Param & " Rolls=1 AND Verific=1 AND DelTF=0 And " & KS.GetSpecialPara(SpecialID) & " order by " & SqlSort
Case 4:SqlStr = "SELECT top " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,PhotoUrl FROM KS_Flash Where " & Param & " Rolls=1 AND Verific=1 AND DelTF=0 And " & KS.GetSpecialPara(SpecialID)& " order by " & SqlSort
Case 5:SqlStr = "SELECT top " & Num & " ID,Title,Tid,0,0,Fname,0,PhotoUrl FROM KS_Product Where " & Param & " Rolls=1 AND Verific=1 AND DelTF=0 And " & KS.GetSpecialPara(SpecialID)& " order by " & SqlSort
Case 7:SqlStr = "SELECT top " & Num & " ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,PhotoUrl FROM KS_Movie Where " & Param & " Rolls=1 AND Verific=1 AND DelTF=0 And " & KS.GetSpecialPara(SpecialID)& " order by " & SqlSort
End Select
GetRolls=KS_Rolls(ChannelID,SqlStr,M_Dir, M_Width, M_Height, OpenType, ShowTitle, Width, Height, M_Speed, T_Len, T_Css, BorderType, Border)
End Function
'==========================================================================文章发布中心通用函数声明==============================
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'函数名:KS_A_L
'作 用:通用栏目文章列表
'参 数:SqlStr 待查询的SQL语句,M_L_S更多链接字串,O_T_S链接打开类型,等
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function KS_A_L(ChannelID,SqlStr, M_L_S, S_C_N, O_T_S, R_H, T_Len, Col, PicTF, NavType, Nav, SplitPic, DateRule, DateAlign, T_Css, DateCss,NewTF,HotTF,P_T,DivID,DivCss,UlID,ULCss,LiID,LICss)
' On Error Resume Next
Dim K,I, C_N_Link, NaviStr,ColSpanNum, TempTitle,SQL,N
Dim RS:Set RS=Conn.Execute(SqlStr)
If RS.EOF Then KS_A_L="":RS.Close:Set RS=Nothing:Exit Function
SQL=RS.GetRows(-1):RS.Close:Set RS = Nothing
Dim TotalNum:TotalNum=Ubound(SQL,2)
Dim Title, T_CssStr, DateCssStr,NewImgStr,HotImgStr,DateStr
T_CssStr = KS.GetCss(T_Css):DateCssStr = KS.GetCss(DateCss):R_H = KS.G_R_H(R_H):NaviStr = KS.GetNavi(NavType, Nav)
If P_T=2 Then
KS_A_L = "<div"&KS.GetCssID(DivID)&KS.GetCss(DivCss) &">" & vbCrLf & " <ul"&KS.GetCssID(UlID)&KS.GetCss(ULCss) &">" & vbCrLf
For K=0 To TotalNum
If CBool(S_C_N) = True Then C_N_Link = "[" & KS.GetClassNP(SQL(2,K)) & "]"
Title = SQL(1,K)
TempTitle = GetArticleTitle(Title, T_Len, PicTF, SQL(12,K), SQL(13,K), SQL(14,K))
If Cbool(NewTF)=True And (Year(SQL(7,K))&Month(SQL(7,K))&Day(SQL(7,K)) =Year(Now)&Month(Now)&Day(Now)) Then NewImgStr="<img src=""" & DomainStr &"images/new.gif"" border=""0""/>" Else NewImgStr=""
If Cbool(HotTF)=True And SQL(8,K)=1 Then HotImgStr="<img src=""" & DomainStr & "images/hot.gif"" border=""0""/>" Else HotImgStr=""
DateStr=KS.GetDCDateStr(SQL(7,K),DateRule,DateCssStr)
TempTitle = "<a" & T_CssStr & " href=""" & KS.GetInfoUrl(ChannelID,SQL(2,K),SQL(0,K),SQL(5,K),SQL(3,K),SQL(4,K),SQL(6,K)) & """" & O_T_S & " title=""" & Title & """>" & TempTitle & "</a>"
KS_A_L = KS_A_L & (" <li"&KS.GetCssID(LIID)&KS.GetCss(LICss)&">" & NaviStr & C_N_Link & TempTitle &NewImgStr&HotImgStr& DateStr & "</li>" & vbCrLf)
Next
KS_A_L = KS_A_L & M_L_S& vbCrLf
KS_A_L = KS_A_L & " </ul>" & vbCrLf
KS_A_L = KS_A_L & ("</div>" & vbCrLf)
Else
KS_A_L = "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & vbCrLf
For K=0 To TotalNum
KS_A_L = KS_A_L & "<tr>" & vbCrLf
For I = 1 To Col
If CBool(S_C_N) = True Then C_N_Link = "<span>[" & KS.GetClassNP(SQL(2,N)) & "]</span>"
Title = SQL(1,N)
TempTitle = GetArticleTitle(Title, T_Len, PicTF, SQL(12,N), SQL(13,N), SQL(14,N))
If Cbool(NewTF)=True And (Year(SQL(7,N))&Month(SQL(7,N))&Day(SQL(7,N)) =Year(Now)&Month(Now)&Day(Now)) Then NewImgStr="<img src=""" & DomainStr &"images/new.gif"" border=""0""/>" Else NewImgStr=""
If Cbool(HotTF)=True And SQL(8,N)=1 Then HotImgStr="<img src=""" & DomainStr & "images/hot.gif"" border=""0""/>" Else HotImgStr=""
DateStr=KS.GetDateStr(SQL(7,N),DateRule,DateAlign,DateCssStr,Col,ColSpanNum)
TempTitle = "<a" & T_CssStr & " href=""" & KS.GetInfoUrl(ChannelID,SQL(2,N),SQL(0,N),SQL(5,N),SQL(3,N),SQL(4,N),SQL(6,N)) & """" & O_T_S & " title=""" & Title & """>" & TempTitle & "</a>"
If Col=1 Then
KS_A_L = KS_A_L & (" <td height=""" & R_H & """>" & (NaviStr & C_N_Link & TempTitle &NewImgStr&HotImgStr& DateStr) & "</td>" & vbCrLf)
Else
KS_A_L = KS_A_L & ("<td width=""" & CInt(100 / CInt(Col)) & "%"" height=""" & R_H & """>" & vbCrLf)
KS_A_L = KS_A_L & ("<table width=""100%"" height=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"">" & vbCrLf)
KS_A_L = KS_A_L & ("<tr><td> " & NaviStr & C_N_Link & TempTitle &NewImgStr&HotImgStr & DateStr)
KS_A_L = KS_A_L & ("</td></tr>" & vbcrlf &" </table>" & vbCrLf & " </td>" & vbCrLf)
End If
N=N+1
If N>=TotalNum+1 Then Exit For
Next
KS_A_L = KS_A_L & "</tr>" & vbCrLf
KS_A_L = KS_A_L & KS.GetSplitPic(SplitPic,ColSpanNum)
If N>=TotalNum+1 Then Exit For
Next
KS_A_L = KS_A_L & M_L_S & ("</table>" & vbCrLf)
End If
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'函数名:KS_C_NotRule
'作 用:通用不规则栏目文章列表
'参 数:ArtilceSql 待查询的SQL语句,M_L_S更多链接字串,OpenTypStr链接打开类型,等
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function KS_C_NotRule(ChannelID,SqlStr,RowNumber, ShowNumPerRow, M_L_S, O_T_S, R_H, NavType, Nav, SplitPic, T_Css,P_T,DivID,DivCss,UlID,ULCss,LiID,LICss)
' On Error Resume Next
Dim I, C_N_Link, NaviStr,K,SQL
Dim PreComment,PreShowComment,PreClassID,PreInfoID
Dim RS:Set RS=Conn.Execute(SqlStr)
If RS.EOF Then KS_C_NotRule="":RS.Close:Set RS=Nothing:Exit Function
SQL=RS.GetRows(-1):RS.Close:Set RS = Nothing
Dim CurrTid,LinkStr,Title, T_CssStr,EndStr
T_CssStr = KS.GetCss(T_Css):R_H = KS.G_R_H(R_H):NaviStr = KS.GetNavi(NavType, Nav)
If Cint(P_T)=2 Then
KS_C_NotRule ="<div"&KS.GetCssID(DivID)&KS.GetCss(DivCss) &">" & vbCrLf & " <ul"&KS.GetCssID(UlID)&KS.GetCss(ULCss) &">" & vbCrLf & "<li"&KS.GetCssID(LIID)&KS.GetCss(LICss)&">"
EndStr="</li>"
Else
KS_C_NotRule = "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"" align=""center"">" & vbCrLf & "<tr><td height=""" & R_H &""">" & vbCrLf
EndStr="</td></tr>"
End If
Dim II:ii=0:Dim CC:cc=0:Dim Row,str
RowNumber=Cint(RowNumber):ShowNumPerRow=Cint(ShowNumPerRow)
KS_C_NotRule= KS_C_NotRule & NaviStr
For K=0 To Ubound(SQL,2)
CurrTid = SQL(2,K):Title = Trim(SQL(1,K))
LinkStr=T_CssStr & " href=""" & KS.GetInfoUrl(ChannelID,SQL(2,K),SQL(0,K),SQL(5,K),SQL(3,K),SQL(4,K),SQL(6,K)) & """" & O_T_S & " title=""" & Title & """"
ii=ii + KS.strLength(Title)
if ii>=ShowNumPerRow then
cc=ii - ShowNumPerRow:cc=KS.strLength(Title) - cc:row=row+1:ii=0
IF row=RowNumber then
IF cc<=5 And PreShowComment = 1 And PreComment = 1 Then
KS_C_NotRule=KS_C_NotRule & "<a href=""" & DomainStr & "plus/Comment.asp?ChannelID=" & ChannelID & "&Classid=" & PreClassID & "&InfoID=" & PreInfoID & """ target=""_blank"">" & KS.GotTopic("评论",cc) & "</a>"&EndStr
Else
KS_C_NotRule=KS_C_NotRule & "<a" & LinkStr &">"& KS.GotTopic(Title,cc)&"</a>"&EndStr
End IF
KS_C_NotRule = KS_C_NotRule & (KS.GetSplitPic(SplitPic, 1))
PreComment=SQL(11,K):PreShowComment=SQL(10,K):PreClassID=CurrTid:PreInfoID=SQL(9,K)
Else
IF cc<=5 And PreShowComment = 1 And PreComment = 1 Then
KS_C_NotRule=KS_C_NotRule & "<a href=""" & DomainStr & "plus/Comment.asp?ChannelID=" & ChannelID & "&Classid=" & PreClassID & "&InfoID=" & PreInfoID & """ target=""_blank"">" & KS.GotTopic("评论",cc) &"</a>"&EndStr
else
KS_C_NotRule=KS_C_NotRule & "<a" & LinkStr &">"& KS.GotTopic(Title,cc)&"</a>"&EndStr
end if
KS_C_NotRule = KS_C_NotRule & (KS.GetSplitPic(SplitPic, 1))
PreComment=SQL(11,K):PreShowComment=SQL(10,K):PreClassID=CurrTid:PreInfoID=SQL(9,K)
If Cint(P_T)=2 Then
KS_C_NotRule=KS_C_NotRule & "<li"&KS.GetCssID(LIID)&KS.GetCss(LICss)&">" & NaviStr
else
KS_C_NotRule=KS_C_NotRule & "<td height=""" & R_H &""">" & NaviStr
end if
End If
Else
KS_C_NotRule=KS_C_NotRule & "<a" & LinkStr &">"& Title&"</a> "
ii=ii + 1
PreComment=SQL(11,K):PreShowComment=SQL(10,K):PreClassID=CurrTid:PreInfoID=SQL(9,K)
End IF
if row>=RowNumber then exit For
Next
KS_C_NotRule = KS_C_NotRule & M_L_S
If Cint(P_T)=2 Then
KS_C_NotRule = KS_C_NotRule & ("</ul>" & vbCrLf &"</div>" & vbcrlf)
Else
KS_C_NotRule = KS_C_NotRule & ("</table>" & vbCrLf)
End if
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'函数名:KS_R_A
'作 用: 通用滚动文章函数
'参 数: SqlStr 待查询的SQL语句,OpenTypStr链接打开类型,等
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function KS_R_A(ChannelID,SqlStr, M_Width, M_Height, M_Speed, M_Dir, O_T_S, T_Len, MarqueeStyle, DateRule, M_Bgcolor, T_Css, DateCss)
Dim SQL,K,RS:Set RS=Conn.Execute(SqlStr)
If RS.EOF Then KS_R_A="":RS.Close:Set RS=Nothing:Exit Function
SQL=RS.GetRows(-1):RS.Close:Set RS = Nothing
Dim TempTitle, CurrTid, TitleStr,T_CssStr, DateCssStr
T_CssStr = KS.GetCss(T_Css): DateCssStr = KS.GetCss(DateCss)
If MarqueeStyle = 1 Then '纵向间隔滚动
KS_R_A = " <div id=""Rolls1"" style=""width:" & M_Width & "px;"">"
For K=0 To Ubound(SQL,2)
CurrTid = SQL(2,K):TitleStr =SQL(1,K)
TempTitle = GetArticleTitle(TitleStr, T_Len, False, SQL(8,K), SQL(9,K), SQL(10,K))
TempTitle = "<li><a" & T_CssStr & " href=""" & (KS.GetInfoUrl(ChannelID,SQL(2,K),SQL(0,K),SQL(5,K),SQL(3,K),SQL(4,K),SQL(6,K))) & """" & O_T_S & " title=""" & TitleStr & """>" & TempTitle & "</a>"
If DateRule <> "0" And DateRule <> "" Then
KS_R_A = KS_R_A & (TempTitle & " <span" & DateCssStr & ">" & KS.DateFormat(SQL(7,K), DateRule) & "</span></li>" & vbCrLf)
Else
KS_R_A = KS_R_A & (TempTitle & "</li>" & vbCrLf)
End If
Next
KS_R_A = KS_R_A & "</div><div id=""Rolls2"" style=""z-index: 1; visibility: hidden; position: absolute""></div>" & vbCrLf
KS_R_A = KS_R_A & "<script>" & vbCrLf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -