📄 cl_function_article.asp
字号:
strPic = strPic & "<td align=""center"">"
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
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><td valign=""top"" algin=""center"" class=""left""><a href=""" & LinkUrl & """>" & left(Cl.NoHtml(sqlPic(10,j)),ContentLen) & "……</a></td>"
if (j+1) Mod Cols=0 then strPic = strPic & "</tr><tr>"
Next
strPic = strPic & "</tr></table>"
Case 3, 4
Dim sImgID,FirstPicUrl
sImgID=Cl.CreatePass(3) & "Cl" & ImgWidth & ImgHeight & ContentLen' & IsHot & IsElite
strPic = "<script type=""text/javascript"">" & vbcrlf
strPic = strPic & "<!--" & vbcrlf
strPic = strPic & "var AImg"&sImgID&"=new Array();" & vbcrlf
strPic = strPic & "var AImg"&sImgID&"link=new Array();" & vbcrlf
strPic = strPic & "var AImg"&sImgID&"title=new Array();" & vbcrlf
strPic = strPic & "var adNum"&sImgID&"=0;" & vbcrlf
For j=0 to Ubound(sqlPic,2)
if j=0 then FirstPicUrl=Cl.ReplaceDir(sqlPic(18,j))
TitleStr = Cl.GotTopic(sqlPic(4,j),TitleLen)
TitleStr = Cl.GetTitleFont(TitleStr,sqlPic(9,j))
TitleStr = Cl.FormatColor(TitleStr,sqlPic(8,j))
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 & "AImg"&sImgID&"link[" & cStr(j) & "]=""" & LinkUrl & """;" & vbcrlf
strPic = strPic & "AImg"&sImgID&"[" & cStr(j) & "]=""" & Cl.ReplaceDir(Cl.GetPicUrl(sqlPic(18,j))) & """;" & vbcrlf
strPic = strPic & "AImg"&sImgID&"title[" & cStr(j) & "]=""" & Replace(TitleStr,Chr(34),"\" & Chr(34)) & """;" & vbcrlf
Next
strPic = strPic & "var preloadimg"&sImgID&"=new Array();" & vbcrlf
strPic = strPic & "for (i=1;i<AImg"&sImgID&".length;i++){preloadimg"&sImgID&"[i]=new Image();preloadimg"&sImgID&"[i].src=AImg"&sImgID&"[i];}" & vbcrlf
strPic = strPic & "function set"&sImgID&"Transition(){" & vbcrlf
strPic = strPic & "if (document.all){AImg"&sImgID&"rotator.filters.revealTrans.Transition=Math.floor(Math.random()*23);AImg"&sImgID&"rotator.filters.revealTrans.apply();}" & vbcrlf
strPic = strPic & "}" & vbcrlf
strPic = strPic & "function play"&sImgID&"Transition(){" & vbcrlf
strPic = strPic & "if (document.all)AImg"&sImgID&"rotator.filters.revealTrans.play()" & vbcrlf
strPic = strPic & "}" & vbcrlf
strPic = strPic & "function next"&sImgID&"Img(){" & vbcrlf
strPic = strPic & "if(adNum"&sImgID&"<AImg"&sImgID&".length-1)adNum"&sImgID&"++ ;" & vbcrlf
strPic = strPic & "else adNum"&sImgID&"=0;" & vbcrlf
strPic = strPic & "set"&sImgID&"Transition();" & vbcrlf
strPic = strPic & "document.images.AImg"&sImgID&"rotator.src=AImg"&sImgID&"[adNum"&sImgID&"];" & vbcrlf
strPic = strPic & "play"&sImgID&"Transition();" & vbcrlf
if ShowType=4 then
strPic = strPic & "document.getElementById('title"&sImgID&"').innerHTML=""<a href='"" + AImg"&sImgID&"link[adNum"&sImgID&"] + ""'>"" + AImg"&sImgID&"title[adNum"&sImgID&"] +""</a>"";" & vbcrlf
End if
strPic = strPic & "theTimer=setTimeout(""next"&sImgID&"Img()"", 5000);" & vbcrlf
strPic = strPic & "}" & vbcrlf
strPic = strPic & "function jump2"&sImgID&"url(){" & vbcrlf
strPic = strPic & "jumpUrl=AImg"&sImgID&"link[adNum"&sImgID&"];jumpTarget=""_blank"";" & vbcrlf
strPic = strPic & "if (jumpUrl != ''){" & vbcrlf
strPic = strPic & "if (jumpTarget != '')window.open(jumpUrl,jumpTarget);" & vbcrlf
strPic = strPic & "else location.href=jumpUrl;" & vbcrlf
strPic = strPic & "}" & vbcrlf
strPic = strPic & "}" & vbcrlf
strPic = strPic & "function display"&sImgID&"Msg(){" & vbcrlf
strPic = strPic & "status=AImg"&sImgID&"link[adNum"&sImgID&"];" & vbcrlf
strPic = strPic & "document.returnValue = true;" & vbcrlf
strPic = strPic & "}" & vbcrlf
strPic = strPic & "//-->" & vbcrlf
strPic = strPic & "</script>" & vbcrlf
strPic = strPic & "<div class=""infopic""><a onmouseover=""display"&sImgID&"Msg();return document.returnValue;"" href=""javascript:jump2"&sImgID&"url();""><img style=""filter: revealTrans(duration=2,transition=20)"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" src=""" & FirstPicUrl & """ name=""AImg"&sImgID&"rotator"" alt="""" /></a></div>" & vbcrlf
if ShowType=4 then
strPic = strPic & "<div class=""infotitle"" id=""title"&sImgID&"""></div>" & vbcrlf
strPic = strPic & "<script type=""text/javascript"">document.getElementById('title"&sImgID&"').innerHTML=""<a href='"" + AImg"&sImgID&"link[0] + ""'>"" + AImg"&sImgID&"title[0] +""</a>"";setTimeout(""next"&sImgID&"Img()"", 3000);</script>"
Else
strPic = strPic & "<script type=""text/javascript"">setTimeout(""next"&sImgID&"Img()"", 3000);</script>"
end if
Case 5, 6
strPic = "<script type=""text/javascript"">" & vbcrlf
strPic = strPic & "<!--" & vbcrlf
'strPic = strPic & "if (navigator.appName == ""Netscape""){" & vbcrlf
'strPic = strPic & "document.write('<a href="""&Cl.WebDir & sqlPic(2,j) & "/ShowInfo.asp?InfoID=" & sqlPic(0,j)&"""><img src="""&Cl.ReplaceDir(sqlPic(18,j))&""" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"">')" & vbcrlf
'if ShowType=6 Then
'strPic = strPic & "document.write('<br />"&Cl.GotTopic(sqlPic(4,j),TitleLen)&"</a>')" & vbcrlf
'End If
'strPic = strPic & "document.write('</a>')" & vbcrlf
'strPic = strPic & "}" & vbcrlf
'strPic = strPic & "else" & vbcrlf
'strPic = strPic & "{" & vbcrlf
strPic = strPic & "var textcolor='0X000000';" '文字颜色(0xFFFFFF)
strPic = strPic & "var bgcolor='0xFFCCCC';" '文字背景颜色(0xFF6600)
strPic = strPic & "var bgalpha=10;" '文字背景颜色透明度:0-100值,0表示全部透明(60)
strPic = strPic & "var bgposition=2;" '文字位置:0顶端,1底部,2顶端浮动(0)
strPic = strPic & "var btncolor='0x256F96';" '按键颜色(0xFF6600)
strPic = strPic & "var btnncolor='0xFFFF00';" '按键当前颜色(0x000033)
strPic = strPic & "var autotime=3;" '自动播放时间(8)
strPic = strPic & "var tween=3;" '图片过渡效果:0亮度,1透明度,2模糊,3运动模糊(2)
strPic = strPic & "var swfwidth=" & Imgwidth & ";var swfheight=" & ImgHeight & ";"
strPic = strPic & "var pics='';var links='';var texts='';var flashvar='';" & vbcrlf
for j=0 to Ubound(sqlPic,2)
If j>0 Then strPic = strPic & "pics += '|';links += '|';texts += '|';"
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
TitleStr = Replace(Cl.GotTopic(sqlPic(4,j),TitleLen),"'","\'")
strPic = strPic & "pics += '" & Cl.ReplaceDir(Cl.GetPicUrl(sqlPic(18,j))) & "';links += '" & LinkUrl & "';texts += '" & TitleStr & "';" & vbcrlf
Next
if ShowType=5 Then strPic = strPic & "texts='';"
strPic = strPic & "flashvar='bcastr_file='+pics+'&bcastr_link='+links+'&bcastr_title='+texts;"
strPic = strPic & "flashvar+='&TitleTextColor='+textcolor+'&TitleBgColor='+bgcolor;"
strPic = strPic & "flashvar+='&TitleBgAlpha='+bgalpha+'&TitleBgPosition='+bgposition;"
strPic = strPic & "flashvar+='&BtnDefaultColor='+btncolor+'&BtnOverColor='+btnncolor;"
strPic = strPic & "flashvar+='&AutoPlayTime='+autotime+'&Tween='+tween;" & vbcrlf
strPic = strPic & "document.write('<object classid=""clsid:d27cdb6e-ae6d-11cf-96b8-444553540000"" codebase=""http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0"" width=""'+ swfwidth +'"" height=""'+ swfheight +'"">');" & vbcrlf
strPic = strPic & "document.write('<param name=""movie"" value=""" & InstallDir & "Images/Bcastr31.swf""><param name=""quality"" value=""high"">');" & vbcrlf
strPic = strPic & "document.write('<param name=""menu"" value=""false""><param name=""wmode"" value=""opaque"">');" & vbcrlf
strPic = strPic & "document.write('<param name=""FlashVars"" value=""'+flashvar+'"">');" & vbcrlf
strPic = strPic & "document.write('<embed src=""" & InstallDir & "Images/Bcastr31.swf"" wmode=""opaque"" FlashVars=""'+flashvar+'"" menu=""false"" quality=""high"" width=""'+ swfwidth +'"" height=""'+ swfheight +'"" type=""application/x-shockwave-flash"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" />'); " & vbcrlf
strPic = strPic & "document.write('</object>');" & vbcrlf
'strPic = strPic & "}" & vbcrlf
strPic = strPic & "//-->" & vbcrlf
strPic = strPic & "</script>" & vbcrlf
end Select
end if
ShowPicArticle=strPic
sqlPic=Empty
End Function
'====================================================================================================
'过程：ShowArticle(sChannelID,sClassID,sSpecialID,TopNum,TitleLen,ShowClassName,ShowProperty,ShowPrefix,ShowAuthor,ShowDateType,ShowHits,ShowHot,IsElite,IsHot,UserName,CssStyle)
'参数：
' sChannelID ------ 频道ID
' sClassID ------ 栏目ID(0为全部，如果大于0，则调用指定栏目及其子栏目)
' sSpecialID ------ 专题ID(0为全部，如果大于0，刚调用指定地区)
' TopNum ------ 最多记录数，0为全部(用于分页显示)
' TitleLen ------ 标题最多字符数
' ShowClassName ------ 是否显示栏目名称(True为显示，False为不显示)
' ShowProperty ------ 是否显示文章属性(固顶/推荐/普通)，(True为显示，False为不显示)
' ShowPrefix ------ 是否显示前缀如：[推荐][图文][注意]字样(True为显示，False为不显示)
' ShowAuthor ------ 是否显示文章作者，True为显示，False为不显示)
' ShowDateType ------ 显示更新日期的样式
' ---- 0(不显示)
' ---- 1(2004-10-01 23:45:45)
' ---- 2(年-月-日 时:分:秒)
' ---- 3(2004-10-01)
' ---- 4(2004\10\01)
' ---- 5(10-01 23:45)
' ---- 6(2004年10月01日)
' ---- 7(10-01)
' ---- 8(20041001234545)
' ShowHits ------ 是否显示文章点击数(True为显示，False为不显示)
' ShowHot ------ 是否显示热门文章标志(True为显示，False为不显示)
' IsHot ------ 是否热门(True为是，False为否)
' IsElite ------ 是否推荐(True为是，False为否)
' UserName ------ 指定某用户(不指定请留空值或0)
' CssClassName ------ CSS样式
'====================================================================================================
Function ShowArticle(Byval sChannelID,Byval sClassID,Byval sSpecialID, _
Byval TopNum,Byval TitleLen,Byval ShowClassName,Byval ShowProperty, _
Byval ShowPrefix,Byval ShowAuthor,Byval ShowDateType,Byval ShowHits, _
Byval ShowHot,Byval IsHot,Byval IsElite,Byval sUserName,Byval CssClassName)
On Error ReSume Next
sChannelID = Clng(sChannelID) : sClassID = Clng(sClassID)
sSpecialID = Clng(sSpecialID) : TopNum = Clng(TopNum)
TitleLen = Clng(TitleLen) : ShowClassName = CBool(ShowClassName)
ShowProperty = CBool(ShowProperty) : ShowPrefix = CBool(ShowPrefix)
ShowAuthor = CBool(ShowAuthor) : ShowDateType = Clng(ShowDateType)
ShowHits = CBool(ShowHits) : ShowHot = CBool(ShowHot)
IsHot = CBool(IsHot) : IsElite = CBool(IsElite)
sUserName = Trim(sUserName) : CssClassName = Trim(CssClassName)
if Err then Err.Clear : ShowArticle="ShowArticle参数错误。" : Exit Function
On Error GoTo 0
Dim rsInfo,SQLInfo,WhereStr
if TopNum<=0 then
SqlInfo="Select "
else
SqlInfo="Select Top "&TopNum&" "
end if
SqlInfo = SqlInfo & "InfoID, ChannelID, ChannelDir, ClassID, Prefixion, Title, FontColor, FontType, Author, CopyFrom, Editor, UpdateTime, Censor, Stars, OnTop, Hot, Elite, Hits, InfoPoint, InfoMoney, IsLink, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Article "
WhereStr=" where Deleted="&FalseType&" and Status=1 "
if sChannelID>0 then WhereStr = WhereStr & " and ChannelID="&sChannelID&" "
if sClassID>0 then
Dim tClass
Set tClass=Cl.Execute("select Child,arrChildID from Cl_Class where ClassID=" & sClassID)
if not(tClass.bof and tClass.eof) then
if tClass(0)>0 then
WhereStr=WhereStr & " and ClassID in (" & tClass(1) & ")"
else
WhereStr=WhereStr & " and ClassID=" & sClassID
end if
else
WhereStr=WhereStr & " and ClassID=" & sClassID
end if
Set tClass=Nothing
end if
if sSpecialID>0 then WhereStr=WhereStr & " and SpecialID Like '%," & sSpecialID & ",%'"
if IsElite=True then WhereStr=WhereStr & " and Elite="&TrueType
if IsHot=True then WhereStr=WhereStr & " and Hot="&TrueType
if sUserName<>"" and sUserName<>"0" then WhereStr=WhereStr & " and Editor='" & sUserName & "'"
'Response.write WhereStr
'Response.end
if IsSqlDataBase=1 then
SqlInfo=SqlInfo & WhereStr & " order by OnTop Desc,UpdateTime desc,InfoID desc"
Else
SqlInfo=SqlInfo & WhereStr & " order by OnTop Asc,UpdateTime desc,InfoID desc"
End if
Set rsInfo=Cl.Execute(SqlInfo)
if rsInfo.bof and rsInfo.eof then
ShowArticle="<br /><li>当前没有记录！</li>"
rsInfo.close:set rsInfo=Nothing : Exit Function
End If
if TopNum<=0 or TopNum>=50 then
Dim rsTotalPut
Set rsTotalPut= Cl.Execute("Select count(InfoID) from Cl_Article " & WhereStr)
TotalPut = rsTotalPut(0)
rsTotalPut.Close : Set rsTotalPut=Nothing
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
rsInfo.move (CurrentPage-1)*PageSize
SqlInfo=rsInfo.GetRows(PageSize)
else
SqlInfo=rsInfo.GetRows(-1)
end if
rsInfo.close:set rsInfo=Nothing
Dim sTemp,Linkurl,i,tClassName
Dim TitleStr,Author,AuthorName,AuthorEmail,sTitleLen
sTemp = "<ul class="""&CssClassName&""">" & VbCrlf
For i=0 to Ubound(SqlInfo,2)
sTitleLen = TitleLen
sTemp = sTemp & "<li>"'
if ShowProperty=True Then
sTemp = sTemp & "<span class=""property"">"
if SqlInfo(14,i)=True then
sTemp = sTemp & "<img src=""" & InstallDir & "Images/ArticleOntop.gif"" alt=""固顶"" /> "
elseif SqlInfo(16,i)=True then
sTemp = sTemp & "<img src=""" & InstallDir & "Images/ArticleElite.gif"" alt=""推荐"" /> "
else
sTemp = sTemp & "<img src=""" & InstallDir & "Images/ArticleCommon.gif"" alt=""普通"" /> "
end If
sTemp = sTemp & "</span>"
end if
if ShowClassName=True and SqlInfo(3,i)<>sClassID Then
tClassName = Cl.GetClassName(SqlInfo(3,i))
sTemp=sTemp & "<span class=""classname"">[<a href=""" & Cl.WebDir & SqlInfo(2,i) & "/ShowClass.asp?ClassID="&SqlInfo(3,i)&""">" & tClassName & "</a>] </span>"
sTitleLen=sTitleLen-Cl.strLength(tClassName)-1
end if
if ShowPrefix=True and SqlInfo(4,i)<>"" then
sTemp = sTemp & "<span class=""prefix"">"&SqlInfo(4,i)&"</span>"
sTitleLen=sTitleLen-Cl.strLength(SqlInfo(4,i))-2
end if
if CBool(SqlInfo(21,i)) then
LinkUrl=Cl.WebDir & SqlInfo(22,i)
else
LinkUrl=Cl.WebDir & SqlInfo(2,i) & "/ShowInfo.asp?InfoID="&SqlInfo(0,i)
end if
sTemp = sTemp & "<span class=""title""><a href=""" & LinkUrl & """ title=""" & SqlInfo(5,i) & """ target=""_blank"">"
TitleStr=Cl.GotTopic(SqlInfo(5,i),sTitleLen)
TitleStr=Cl.GetTitleFont(TitleStr,SqlInfo(7,i))
TitleStr=Cl.FormatColor(TitleStr,SqlInfo(6,i))
sTemp=sTemp & TitleStr & "</a></span>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -