📄 cl_function_article.asp
字号:
<%
'===================================================
' CreateLive CMS Version 4.0
' Powered by Aspoo.CoM
'===================================================
' File: Cl_Function_Article.asp
' Date: 2005-10-31
' Mail: support@aspoo.cn, Info@aspoo.cn
' Q Q: 3315263, 596197794
' Msn : support@aspoo.cn, Clw866@hotmail.com
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2005-2007 Aspoo.CoM All Rights Reserved.
'===================================================
Public Sub Article_Setting()
CurrentPath = Cl.Language.selectSingleNode("//CurrentPath").text & "<a href='" & Cl.Web_info(4) & "'>" & Cl.Web_info(0) & "</a> >> <a href='" & Cl.WebDir & Cl.ChannelDir & "'>" & Cl.ChannelName & "</a>"
Cl.Title = Cl.NoHtml(Cl.ChannelName) & " " & Cl.GotTopic(Cl.ChannelReadMe,50) & "[" & Cl.Web_info(1) & "]"
if InfoID>0 then
Set Rs = Cl.Execute("select * From Cl_Article where InfoID=" & InfoID)
if rs.bof and rs.eof then
rs.Close : Set rs=Nothing
Call Cl.OutErr(0,Replace(Cl.Language.selectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.ChannelItemName))
end if
if rs("ChannelID")<>ChannelID Or rs("Deleted")=True Or rs("Status")<>1 Then
rs.Close : Set rs=Nothing
Call Cl.OutErr(0,Replace(Cl.Language.selectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.ChannelItemName))
end If
ClassID = rs("ClassID")
InfoTitle = rs("Title")
if rs("Hot")=False then
if rs("hits")>=Clng(Cl.Web_Setting(14)) then Cl.Execute("Update Cl_Article Set Hot=" & TrueType & " where InfoID=" & InfoID & "")
end if
Template.TemplateID = 0
If CLng(Cl.Channel.selectSingleNode("@info_projectid").text)>0 Then
Template.ProjectID = CLng(Cl.Channel.selectSingleNode("@info_projectid").text)
If CLng(Cl.Channel.selectSingleNode("@info_templateid").text)>0 Then Template.TemplateID = CLng(Cl.Channel.selectSingleNode("@info_templateid").text)
If CLng(Cl.Channel.selectSingleNode("@info_cssid").text)>0 Then Template.CssID = CLng(Cl.Channel.selectSingleNode("@info_cssid").text)
End if
end if
if ClassID>0 Then
Set tClass = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&ClassID&"]")
If tClass Is Nothing Then Call Cl.OutErr(0,Cl.Language.selectSingleNode("//ClassNoFind").text)
ClassName = tClass.selectSingleNode("@classname").text
ParentID = CLng(tClass.selectSingleNode("@parentid").text)
ParentPath = tClass.selectSingleNode("@parentpath").text
ClassDir = tClass.selectSingleNode("@classdir").text
ParentDir = tClass.selectSingleNode("@parentdir").text
RootID = CLng(tClass.selectSingleNode("@rootid").text)
Depth = CLng(tClass.selectSingleNode("@depth").text)
Child = CLng(tClass.selectSingleNode("@child").text)
arrChildID = tClass.selectSingleNode("@arrchildid").text
BrowsePurview=CLng(tClass.selectSingleNode("@browsepurview").text)
VipUser = tClass.selectSingleNode("@vipuser").text
ClassProjectID= CLng(tClass.selectSingleNode("@projectid").text)
ClassTemplateID = CLng(tClass.selectSingleNode("@templateid").text)
ClassCssID = CLng(tClass.selectSingleNode("@cssid").text)
If CLng(Cl.Channel.selectSingleNode("@class_projectid").text)>0 Then
Cl.ProjectID = CLng(Cl.Channel.selectSingleNode("@class_projectid").text)
'Template.TemplateID = CLng(Cl.Channel.selectSingleNode("@class_templateid").text)
Cl.CssID = CLng(Cl.Channel.selectSingleNode("@class_cssid").text)
End if
If ClassProjectID > 0 Then
Cl.ProjectID = ClassProjectID
Cl.CssID = ClassCssID
End if
If ParentID>0 Then
Dim tNode,tParent,i
tParent = Split(ParentPath,",")
For i=1 To UBound(tParent)
Set tNode = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid=" & tParent(i) & "]")
If Not tNode Is Nothing Then
CurrentPath=CurrentPath & " >> <a href='" & tNode.selectSingleNode("@linkurl").text & "'>" & tNode.selectSingleNode("@classname").text & "</a>"
End If
Set tNode=Nothing
Next
tParent = Null
End If
CurrentPath=CurrentPath & " >> <a href='" & tClass.selectSingleNode("@linkurl").text & "'>" & ClassName & "</a>"
Set tClass = Nothing
end if
End Sub
'=================================================
'过程名：ShowClassArticle(sChannelID,sClassID,ModNum,TopNum)
'参 数：
' sChannelID ---- 频道ID
' sClassID ---- 指定栏目，多个用“|”分隔，不指定请留空或0
' ModNum --- 多少个换行
' TopNum --- 最多显示记录数
'=================================================
Function ShowClassArticle(Byval sChannelID,Byval sClassID,Byval ModNum,Byval TopNum)
Dim sqlRoot,rsRoot,ClassCount,iClassID,nClassID
Dim sTemp,strValue,ClassLinkUrl
sChannelID = Cl.GetClng(sChannelID)
sClassID = Trim(sClassID)
ModNum = Cl.GetClng(ModNum)
if sClassID="" or sClassID="0" then
TopNum = Cl.GetClng(TopNum)
if TopNum=0 then TopNum = 6
sqlRoot="select Top "&TopNum&" ClassID,ClassName,ParentPath,ClassDir,ParentDir,RootID,Child,arrChildID,Readme From Cl_Class where ChannelID="&sChannelID&" and ParentID=0 and IsElite="&TrueType&" and IsOuter=0 order by RootID"
Else
sqlRoot="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,RootID,Child,arrChildID,Readme From Cl_Class where ChannelID="&sChannelID&" and IsElite="&TrueType&" and IsOuter=0 and ClassID In ("&Replace(sClassID,"|",",")&") order by RootID"
End if
Set rsRoot= Cl.Execute(sqlRoot)
if rsRoot.bof and rsRoot.eof then
sTemp="还没有任何栏目，请首先添加栏目。"
rsRoot.Close:Set rsRoot=Nothing:Exit Function
end if
sqlRoot=rsRoot.GetRows(-1)
rsRoot.Close:Set rsRoot=Nothing
Dim TemplateHTMLStr
TemplateHTMLStr = Template.GetTemplate(Cl.GetDefaultTemplateID(1,9,Template.ProjectID))
TemplateHTMLStr = Replace(TemplateHTMLStr,"{$webdir}",InstallDir)
TemplateHTMLStr = Replace(TemplateHTMLStr,"{$csspicurl}",Cl.WebDir & Cl.CssPicUrl)
TemplateHTMLStr = Split(TemplateHTMLStr,"@@@")
'If ChannelID=0 Then ChannelID = sChannelID
nClassID = Ubound(sqlRoot,2)
for iClassID=0 to nClassID
ClassID = sqlRoot(0,iClassID)
ClassLinkUrl = Cl.GetClassLinkUrl(sqlRoot(0,iClassID))
strValue=TemplateHTMLStr(1)
strValue=Replace(strValue,"{$channelid}",sChannelID)
strValue=Replace(strValue,"{$classid}",sqlRoot(0,iClassID))
strValue=Replace(strValue,"{$classtitle}",sqlRoot(8,iClassID)&"")
strValue=Replace(strValue,"{$classname}",sqlRoot(1,iClassID))
strValue=Replace(strValue,"{$classfileurl}",ClassLinkUrl)
strValue=Replace(strValue,"{$classlinkurl}",ClassLinkUrl)
strValue=Template.ReplaceFlag(strValue,"showarticle","")
If iClassID<nClassID then
if ((iClassID+1) mod ModNum) = 0 then
strValue = strValue & TemplateHTMLStr(3)
else
strValue = strValue & TemplateHTMLStr(2)
end If
End if
sTemp=sTemp & strValue
Next
ShowClassArticle=Replace(TemplateHTMLStr(0),"{$classarticlebody}",sTemp)
TemplateHTMLStr = Null
sqlRoot=Empty
End Function
'====================================================================================================
'过程：ShowPicArticle(sChannelID,sClassID,sSpecialID,TopNum,TitleLen,ShowType,Cols,ImgWidth,ImgHeight,ContentLen,IsHot,IsElite)
'参数：
' sChannelID ------ 频道ID
' sClassID ------ 栏目ID(0为所有栏目,若大于0，则调用指定栏目及其子栏目)
' sSpecialID ------ 专题ID(0为所有栏目,若大于0，则调用指定地区)
' TopNum ------ 最多显示多少篇
' TitleLen ------ 标题最多字符数
' ShowType ------ 显示方式。0(图),1(图+标),2(图+标+内),3(图+幻),4(图+标+幻)
' Cols ------ 列数。超过此列数就换行
' ImgWidth ------ 图片宽度
' ImgHeight ------ 图片高度
' ContentLen ------ 内容最多字符数
' IsHot ------ 是否是热门(True为是，False为否)
' IsElite ------ 是否是推荐(True为是，False为否)
'====================================================================================================
Function ShowPicArticle(Byval sChannelID,Byval sClassID,Byval sSpecialID, _
Byval TopNum,Byval TitleLen,Byval ShowType,Byval Cols,Byval ImgWidth, _
Byval ImgHeight,Byval ContentLen,Byval IsHot,Byval IsElite)
On Error Resume Next
sChannelID = Clng(sChannelID) : sClassID = Clng(sClassID)
sSpecialID = Clng(sSpecialID) : TopNum = Clng(TopNum)
TitleLen = Clng(TitleLen) : ShowType = Clng(ShowType)
Cols = Clng(Cols) : ImgWidth = Clng(ImgWidth)
ImgHeight = Clng(ImgHeight) : ContentLen = Clng(ContentLen)
IsHot = CBool(IsHot) : IsElite = CBool(IsElite)
if Err then Err.Clear : ShowPicArticle="ShowPicArticle参数错误。":Exit Function
On Error GoTo 0
dim rsPic,sqlPic,tClass,j,strPic
if TopNum<=0 then
sqlPic="Select "
else
sqlPic="Select top "&TopNum&" "
end if
sqlPic=sqlPic & " InfoID,ChannelID,ChannelDir,ClassID,Title,Author,UpdateTime,Editor,FontColor,FontType,Content,OnTop,Hot,Elite,Status,Prefixion,Stars,PaginationType,PicUrl,hits,IsHtml,HtmlFileUrl,Intro from Cl_Article where Deleted="&FalseType&" and Status=1 and PicUrl<>''"
if sChannelID>0 then sqlPic=sqlPic & " and ChannelID="&sChannelID&" "
if sClassID>0 then
set tClass=Cl.Execute("select ClassID,Child,ParentPath,arrChildID from Cl_Class where ChannelID="&sChannelID&" and ClassID=" & sClassID)
if not(tClass.bof and tClass.eof) then
if tClass(1)>0 then
sqlPic=sqlPic & " and ClassID in (" & tClass(3) & ")"
else
sqlPic=sqlPic & " and ClassID=" & sClassID
end if
else
sqlPic=sqlPic & " and ClassID=" & sClassID
end if
set tClass=Nothing
end if
if sSpecialID>0 then sqlPic=sqlPic & " and SpecialID Like '%," & SpecialID & ",%'"
if IsHot=True then sqlPic=sqlPic & " and Hot="&TrueType&" "
if IsElite=True then sqlPic=sqlPic & " and Elite="&TrueType&" "
if IsSqlDataBase=1 then
sqlPic=sqlPic & " order by OnTop Desc,UpdateTime desc,InfoID desc"
Else
sqlPic=sqlPic & " order by OnTop Asc,UpdateTime desc,InfoID desc"
End if
Set rsPic= Server.CreateObject("ADODB.Recordset")
OpenConn : rsPic.open sqlPic,Conn,1,1
if rsPic.bof and rsPic.eof then
strPic = "<img src=""" & Cl.WebDir & "images/NoPic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
rsPic.Close : Set rsPic = Nothing
else
Dim FileType,TitleStr,LinkUrl
if TopNum<=0 or TopNum>=100 then
TotalPut=rsPic.recordcount
if (TotalPut mod PageSize)=0 then
TotalPages = TotalPut \ PageSize
else
TotalPages = TotalPut \ PageSize + 1
end if
if CurrentPage > TotalPages then CurrentPage=TotalPages
if CurrentPage < 1 then CurrentPage=1
rsPic.move (CurrentPage-1)*PageSize
sqlPic = rsPic.GetRows(PageSize)
else
sqlPic=rsPic.GetRows(-1)
end if
rsPic.Close : Set rsPic = Nothing
Select Case ShowType
Case 0
strPic = "<table width=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"" align=""center""><tr>"
for j=0 to Ubound(sqlPic,2)
if CBool(sqlPic(20,j)) then
LinkUrl=Cl.WebDir & sqlPic(21,j)
else
LinkUrl=Cl.WebDir & sqlPic(2,j) & "/ShowInfo.asp?InfoID=" & sqlPic(0,j)
end if
strPic = strPic & "<td align=""center"">"
FileType=right(lcase(sqlPic(18,j)),3)
strPic = strPic & "<a href=""" & LinkUrl & """ title=""" & sqlPic(4,j) & """ target=""_blank"">"
sqlPic(18,j)=Cl.ReplaceDir(sqlPic(18,j))
Select Case FileType
Case "swf"
strPic = strPic & "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0"" width=""" & ImgWidth & """ height=""" & ImgHeight & """><param name=""movie"" value=""" & sqlPic(18,j) & """><param name=""quality"" value=""high""><embed src=""" & sqlPic(18,j) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""" & ImgWidth & """ height=""" & ImgHeight & """></embed></object>"
Case "jpg", "bmp", "png", "gif"
strPic = strPic & "<img src=""" & sqlPic(18,j) & """ width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
Case else
strPic = strPic & "<img src=""" & Cl.WebDir & "images/NoPic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
end Select
strPic = strPic & "</a></td>"
if (j+1) Mod Cols=0 then strPic = strPic & "</tr><tr>"
Next
strPic = strPic & "</tr></table>"
Case 1
strPic = "<table width=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"" align=""center""><tr>"
for j=0 to Ubound(sqlPic,2)
if CBool(sqlPic(20,j)) then
LinkUrl=Cl.WebDir & sqlPic(21,j)
else
LinkUrl=Cl.WebDir & sqlPic(2,j) & "/ShowInfo.asp?InfoID=" & sqlPic(0,j)
end if
strPic = strPic & "<td align=""center"">"
FileType=right(lcase(sqlPic(18,j)),3)
TitleStr=Cl.GotTopic(sqlPic(4,j),TitleLen)
sqlPic(18,j)=Cl.ReplaceDir(sqlPic(18,j))
strPic = strPic & "<a href=""" & LinkUrl & """ title=""" & sqlPic(4,j) & """ target=""_blank"">"
Select Case FileType
Case "swf"
strPic = strPic & "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0"" width=""" & ImgWidth & """ height=""" & ImgHeight & """><param name=""movie"" value=""" & sqlPic(18,j) & """><param name=""quality"" value=""high""><embed src=""" & sqlPic(18,j) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""" & ImgWidth & """ height=""" & ImgHeight & """></embed></object>"
Case "jpg", "bmp", "png", "gif"
strPic = strPic & "<img src=""" & sqlPic(18,j) & """ width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
Case else
strPic = strPic & "<img src=""" & Cl.WebDir & "images/NoPic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
end Select
TitleStr=Cl.GetTitleFont(TitleStr,sqlPic(9,j))
TitleStr=Cl.FormatColor(TitleStr,sqlPic(8,j))
strPic = strPic & "<br />" & TitleStr & "</a>"
strPic = strPic & "</td>"
if (j+1) Mod Cols=0 then strPic = strPic & "</tr><tr>"
Next
strPic = strPic & "</tr></table>"
Case 2
strPic = "<table width=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"" align=""center""><tr>"
for j=0 to Ubound(sqlPic,2)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -