📄 ks_refreshcls.asp
字号:
DetailListStr = DetailListStr & ClassRS(0)
ClassRS.Close
Set ClassRS = Nothing
DetailListStr = DetailListStr & "</b></td></tr>"
DetailListStr = DetailListStr & GetClassSiteList(RClassID)
DetailListStr = DetailListStr & "</table></td></tr></table>"
End If
Else '按常规等方式查看
Const MaxPerPage = 20 '每页显示数量
If KSCMS.G("page") <> "" Then
CurrentPage = KSCMS.ChkClng(KSCMS.G("page"))
Else
CurrentPage = 1
End If
DetailListStr = "<TABLE WIDTH=""100%"" Cellpadding=""0"" Cellspacing=""0"" Class=""table_border""><TR><TD>"
Para = " Where Verific=1 And Locked=0"
If LinkType = 0 Or LinkType = 1 Then
Para = Para & " And LinkType=" & LinkType
End If
If RClassID <> 0 Then
Para = Para & " And FolderID=" & RClassID
End If
If KeyWord <> "" Then
Para = Para & " And SiteName like '%" & KeyWord & "%' Or Description like '%" & KeyWord & "%'"
End If
If ViewKind = 3 Then
Para = Para & " And Recommend=1 Order By Hits Desc"
ElseIf ViewKind = 1 Then
Para = Para & " Order By Hits Desc"
Else
Para = Para & " Order By AddDate Desc"
End If
ObjRS.Open "Select * From KS_Link" & Para, Conn, 1, 1
If ObjRS.EOF And ObjRS.BOF Then
If RClassID = 0 Then
DetailListStr = DetailListStr & "还没有加入任何友情链接!"
Else
DetailListStr = DetailListStr & "没有该类别的友情链接站点!"
End If
Else
totalPut = ObjRS.RecordCount
If CurrentPage < 1 Then CurrentPage = 1
If (CurrentPage - 1) * MaxPerPage > totalPut Then
If (totalPut Mod MaxPerPage) = 0 Then
CurrentPage = totalPut \ MaxPerPage
Else
CurrentPage = totalPut \ MaxPerPage + 1
End If
End If
If CurrentPage = 1 Then
DetailListStr = DetailListStr & GetDetailListStr(ObjRS, totalPut, MaxPerPage, CurrentPage, RClassID)
Else
If (CurrentPage - 1) * MaxPerPage < totalPut Then
ObjRS.Move (CurrentPage - 1) * MaxPerPage
DetailListStr = DetailListStr & GetDetailListStr(ObjRS, totalPut, MaxPerPage, CurrentPage, RClassID)
Else
CurrentPage = 1
DetailListStr = DetailListStr & GetDetailListStr(ObjRS, totalPut, MaxPerPage, CurrentPage, RClassID)
End If
End If
End If
ObjRS.Close
Set ObjRS = Nothing
DetailListStr = DetailListStr & "</TD></TR></TABLE>"
End If
FileContent = Replace(FileContent, "{$GetLinkDetail}", DetailListStr)
End If
ReplaceListContent = FileContent
End Function
'结合上面ReplaceListContent函数使用
Function GetDetailListStr(ObjRS, totalPut, MaxPerPage, CurrentPage, RClassID)
Dim AddDate, I, RecommendStr,LinkID
Do While Not ObjRS.EOF
AddDate = ObjRS("AddDate")
LinkID = ObjRS("LinkID")
If ObjRS("Recommend") = 1 Then
RecommendStr = " <font color=""red"">推荐</font>"
Else
RecommendStr = ""
End If
GetDetailListStr = GetDetailListStr & "<TABLE cellSpacing=1 cellPadding=4 width=100% align=center bgColor=#ffffff border=0>"
GetDetailListStr = GetDetailListStr & "<TBODY>"
GetDetailListStr = GetDetailListStr & "<TR Class=""link_table_title"" height=20>"
If ObjRS("LinkType") = 0 Then
GetDetailListStr = GetDetailListStr & "<TD width=""14%""><a href=""Index.asp?LinkType=0"" title=""按文字链接查看"">文字链接</a></TD>"
Else
GetDetailListStr = GetDetailListStr & "<TD width=""14%""><a href=""Index.asp?LinkType=1"" title=""按LOGO链接查看"">LOGO链接</a></TD>"
End If
GetDetailListStr = GetDetailListStr & "<TD width=""36%""><A href = ""ToLink.asp?LinkID=" & LinkID & """ target=""_blank"" title=""网站名称""><B>" & ObjRS("SiteName") & "</B> " & RecommendStr & "</A></TD>"
GetDetailListStr = GetDetailListStr & "<TD width=""15%"">"
Dim ClassRS:Set ClassRS = Conn.Execute("Select FolderID,FolderName From KS_LinkFolder Where FolderID=" & ObjRS("FolderID"))
GetDetailListStr = GetDetailListStr & "<a href=""Index.asp?ViewKind=2&ClassID=" & ClassRS(0) & """ Title=""网站类别"">" & ClassRS(1) & "</a>"
ClassRS.Close:Set ClassRS = Nothing
GetDetailListStr = GetDetailListStr & "</TD>"
GetDetailListStr = GetDetailListStr & "<TD width=""12%"" nowrap><a href=""mailto:" & ObjRS("Email") & """ Title=""网站站长"">" & ObjRS("WebMaster") & "</a></TD>"
GetDetailListStr = GetDetailListStr & "<TD width=""15%"" nowrap>" & Year(AddDate) & "-" & Month(AddDate) & "-" & Day(AddDate) & "</TD>"
GetDetailListStr = GetDetailListStr & "<TD width=""15%"" nowrap>点击 <B>" & ObjRS("Hits") & "</B> 次</TD>"
GetDetailListStr = GetDetailListStr & "</TR>"
GetDetailListStr = GetDetailListStr & "<TR height=40>"
GetDetailListStr = GetDetailListStr & "<TD Style = ""BORDER-RIGHT: #efefef 1px dotted; BORDER-LEFT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted"" align=middle width=""14%""><table border=0><tr><td>"
If ObjRS("LinkType") = 0 Then
GetDetailListStr = GetDetailListStr & "<A href = ""ToLink.asp?LinkID=" & LinkID & """ target=""_blank""><IMG height=31 src=""/Skin/Default/NoLinkLogo.gif"" alt=" & ObjRS("SiteName") & " width=88 border=0></A></td></tr>"
Else
GetDetailListStr = GetDetailListStr & "<A href = ""ToLink.asp?LinkID=" & LinkID & """ target=""_blank""><IMG height=31 src=""" & ObjRS("Logo") & """ alt=" & ObjRS("SiteName") & " width=88 border=0></A></td></tr>"
End If
GetDetailListStr = GetDetailListStr & "<tr><td align=""center""><a href=""FriendLinkModify.asp?LinkID=" & LinkID & """>修改</a> <a href=""FriendLinkDel.asp?LinkID=" & LinkID & """>删除</a></td></tr></table></TD>"
GetDetailListStr = GetDetailListStr & "<TD style=""BORDER-RIGHT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted"" title=""网站简介"" colSpan=5>"
If Trim(ObjRS("Description")) = "" Then
GetDetailListStr = GetDetailListStr & "暂无简介"
Else
GetDetailListStr = GetDetailListStr & Trim(ObjRS("Description"))
End If
GetDetailListStr = GetDetailListStr & "</TD></TR><TR><TD colSpan=6 height=3></TD></TR></TBODY>"
GetDetailListStr = GetDetailListStr & "</TABLE>"
ObjRS.MoveNext
I = I + 1
If I >= MaxPerPage Then Exit Do
Loop
GetDetailListStr = GetDetailListStr & "<table width=""100%"" aling=""center""><tr><td align=right>" & KSCMS.ShowPagePara(totalPut, MaxPerPage, "Index.asp", True, "个站点", CurrentPage, "ClassID=" & RClassID & "&LinkType=" & KSCMS.G("LinkType") & "&ViewKind=" & KSCMS.G("ViewKind")) & "</td></tr></table>"
End Function
'结合上面ReplaceListContent函数使用
Function GetClassSiteList(FolderID)
Dim ObjRS:Set ObjRS=Server.CreateObject("ADODB.Recordset")
Dim SiteName,I
FolderID = KSCMS.ChkClng(FolderID)
GetClassSiteList = "<tr><td>"
ObjRS.Open "Select * From KS_Link Where FolderID=" & FolderID & "And Verific=1 And Locked=0", Conn, 1, 1
If ObjRS.EOF And ObjRS.BOF Then
GetClassSiteList = GetClassSiteList & "该类别下没有任何站点!"
Else
GetClassSiteList = GetClassSiteList & "<table width=""100%"" border=""0"">"
Do While Not ObjRS.EOF
GetClassSiteList = GetClassSiteList & "<tr>"
For I = 1 To 6
SiteName = ObjRS("SiteName")
GetClassSiteList = GetClassSiteList & "<td><a href = ""ToLink.asp?LinkID=" & ObjRS("LinkID") & """ target='blank' title='" & SiteName & "'>" & SiteName & "</a></td>"
ObjRS.MoveNext
If ObjRS.EOF Then Exit For
Next
GetClassSiteList = GetClassSiteList & "</tr>"
Loop
GetClassSiteList = GetClassSiteList & "</table>"
End If
GetClassSiteList = GetClassSiteList & "</td></tr>"
ObjRS.Close:Set ObjRS = Nothing
End Function
'*********************************************************************************************************
'函数名：ReplaceNewsContent
'作 用：替换文章内容页标签为内容
'参 数：RefreshRS Recordset数据集,FileContent待替换的内容,ArticleContent文章内容
'*********************************************************************************************************
Function ReplaceNewsContent(RefreshRS, FileContent, ArticleContent)
Dim TempStr, Domain, CommonDir,ArticleDir
On Error Resume Next '容错代码
Domain = DomainStr
CommonDir = Domain & "Common/" '存放[发表评论]，[发给好友]等的文件夹
ArticleDir=Domain & "Article/"
'判断是否有GetSize,若有给文章内容加上ID
If InStr(FileContent, "{$GetArticleSize}") <> 0 Then
ArticleContent = "<Span ID=""ArticleContentArea"">" & ArticleContent & "</Span>"
TempStr = "<SCRIPT Language=Javascript>" & _
"function ContentSize(size)" & _
"{document.all.ArticleContentArea.style.fontSize=size+""px"";}" & _
"</SCRIPT>"
TempStr = TempStr & "【字体：<A href=""javascript:ContentSize(16)"">大</A> <A href=""javascript:ContentSize(14)"">中</A> <A href=""javascript:ContentSize(12)"">小</A>】"
FileContent = Replace(FileContent, "{$GetArticleSize}", TempStr)
End If
FileContent = Replace(FileContent, "{$GetArticleContent}", ArticleContent)
If InStr(FileContent, "{$GetArticleAction}") <> 0 Then
TempStr = "【<A href=""" & CommonDir & "Comment.asp?ChannelID=1&Classid=" & RefreshRS("Tid") & "&InfoID=" & RefreshRS("NewsID") & """ target=""_blank"">发表评论</A>】【<A href=""" & CommonDir & "SendMail.asp?ArticleID=" & RefreshRS("NewsID") & """ target=""_blank"">告诉好友</A>】【<A href=""" & CommonDir & "Print.asp?ArticleID=" & RefreshRS("NewsID") & """ target=""_blank"">打印此文</A>】【<A href=""" & Domain & "Member/User_Favorite.asp?Action=Add&ChannelID=1&InfoID=" & RefreshRS("NewsID") & """ target=""_blank"">收藏此文</A>】【<A href=""javascript:window.close();"">关闭窗口</A>】"
FileContent = Replace(FileContent, "{$GetArticleAction}", TempStr)
End If
FileContent = Replace(FileContent, "{$GetArticleID}", RefreshRS("NewsID"))
FileContent = Replace(FileContent, "{$GetArticleShortTitle}", RefreshRS("Title"))
FileContent = Replace(FileContent, "{$GetArticleUrl}", KSCMS.GetInfoUrl(1,RefreshRS))
FileContent = Replace(FileContent, "{$GetArticleKeyWord}", RefreshRS("KeyWords"))
IF RefreshRS("FullTitle")="" Or IsNull(RefreshRS("FullTitle")) Then
FileContent = Replace(FileContent, "{$GetArticleTitle}", RefreshRS("Title"))
Else
FileContent = Replace(FileContent, "{$GetArticleTitle}", RefreshRS("FullTitle"))
End IF
If Not IsNull(RefreshRS("SubTitle")) Then
FileContent = Replace(FileContent, "{$GetSubArticleTitle}", RefreshRS("SubTitle"))
Else
FileContent = Replace(FileContent, "{$GetSubArticleTitle}", "")
End If
If Not IsNull(RefreshRS("Author")) And Trim(RefreshRS("Author")) <> "" Then
FileContent = Replace(FileContent, "{$GetArticleAuthor}", RefreshRS("Author"))
Else
FileContent = Replace(FileContent, "{$GetArticleAuthor}", "佚名")
End If
If Not IsNull(RefreshRS("Editor")) Then
FileContent = Replace(FileContent, "{$GetArticleEditor}", RefreshRS("Editor"))
Else
FileContent = Replace(FileContent, "{$GetArticleEditor}", RefreshRS("ArticleInput"))
End If
If Not IsNull(RefreshRS("ArticleInput")) Then
FileContent = Replace(FileContent, "{$GetArticleInput}", RefreshRS("ArticleInput"))
Else
FileContent = Replace(FileContent, "{$GetArticleInput}", "")
End If
If InStr(FileContent, "{$GetArticleOrigin}") <> 0 Then
If Not IsNull(RefreshRS("Origin")) And Trim(RefreshRS("Origin")) <> "" Then
FileContent = Replace(FileContent, "{$GetArticleOrigin}", KMRFObj.GetOrigin(RefreshRS("Origin")))
Else
FileContent = Replace(FileContent, "{$GetArticleOrigin}", "本站原创")
End If
End If
'文章属性
If InStr(FileContent, "{$GetArticleProperty}") <> 0 Then
TempStr = ""
If CInt(RefreshRS("Recommend")) = 1 Then
TempStr = TempStr & ("<span title=""推荐文章"" style=""cursor:default""><font color=""green"">荐</font></span> ")
End If
If CInt(RefreshRS("Popular")) = 1 Then
TempStr = TempStr & ("<span title=""热门文章"" style=""cursor:default""><font color=""red"">热</font></span> ")
End If
If CInt(RefreshRS("Strip")) = 1 Then
TempStr = TempStr & ("<span title=""今日头条"" style=""cursor:default""><font color=""#0000ff"">头</font></span> ")
End If
If CInt(RefreshRS("Rolls")) = 1 Then
TempStr = TempStr & ("<span title=""滚动文章"" style=""cursor:default""><font color=""#F709F7"">滚</font></span> ")
End If
If CInt(RefreshRS("Slide")) = 1 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -