-- 作者：张医生
-- 发布时间：2005-4-25 13:23:37
-- 351日期右对齐、标题稿纸效果
提供日期右对齐、标题稿纸效果等! 351
将下面的过程相应替换即可。
下面的代码有三个功能：
1、让首页的最新内容三天内日期是红色，否则是灰色，天数可以自己改；
2、日期右对齐，绝对你想怎么对就怎么对，适应各种类型网站的需要；
3、标题稿纸效果，你可以选用CSS定义虚线，也可以选用图片作为背景，用CSS当然简单些了，但缺少多样及个性，而背景却要下载图片(图片自己去找，好象有人提供过)，但也随心所欲，所以各有所长。 \'=================================================
\'过程名：ShowNewArticle
\'作 用：显示最新文章
\'参 数：ArticleNum ----最多显示多少篇文章
\' TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowNewArticle(ArticleNum,TitleLen)
dim sqlNew,rsNew
if ArticleNum>0 and ArticleNum<=100 then
sqlNew="select top " & ArticleNum
else
sqlNew="select top 10 "
end if
sqlNew=sqlNew & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=False and A.Passed=True order by A.articleid desc"
Set rsNew= Server.CreateObject("ADODB.Recordset")
rsNew.open sqlNew,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsNew.bof and rsNew.eof then
response.write "<img src=\'skin/1/xiao.gif\'>没有文章"
else
do while not rsNew.eof
\'--------------------------------稿纸效果修改开始--------这个是用CSS定义的虚线
response.write "<table border=0 width=\'100%\' cellspacing=0 cellpadding=1 ><tr><td>"
response.write "<img src=\'images/article_common.gif\'><a href=\'" & rsNew("LayoutFileName") & "?ArticleID=" & rsNew("articleid") &"\' title=\'标题：" & rsNew("Title") & vbcrlf & "作者：" & rsNew("Author") & vbcrlf & "时间：" & rsNew("UpdateTime") & vbcrlf & "点击：" & rsNew("Hits") & "\' target=\'_blank\'>" & gotTopic(rsNew("title"),TitleLen) & "</a>" if datediff("d",rsNew("UpdateTime"),date())<3 then
response.write("</td><td align=\'right\' nowrap style=\'width:1%\'><font color=red>" & month(rsnew("updateTime")) & "-" & day(rsnew("updateTime")) & "</font>")
else
response.write("</td><td align=\'right\' nowrap style=\'width:1%\'><font color=#999999>" & month(rsnew("updateTime")) & "-" & day(rsnew("updateTime")) & "</font>")
end if
response.write "</td></tr><tr><td colspan=\'2\'><table width=\'100%\' border=0 cellspacing=0 cellpadding=0 style=\'height:1; border-bottom-width: 1px; border-bottom-style: dotted; border-bottom-color: #cccccc\'><tr><td></td></tr></table></td></tr></table>"
\'--------------------------------稿纸效果修改结束--------
rsNew.movenext
loop
end if
rsNew.close
set rsNew=nothing
end sub \'=================================================
\'过程名：ShowHot
\'作 用：显示热门文章
\'参 数：ArticleNum ----最多显示多少篇文章
\' TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowHot(ArticleNum,TitleLen)
dim sqlHot,rsHot
if ArticleNum>0 and ArticleNum<=100 then
sqlHot="select top " & ArticleNum
else
sqlHot="select top 10 "
end if
sqlHot=sqlHot & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=False and A.Passed=True And A.Hits>=" & HitsOfHot & " order by A.ArticleID desc"
Set rsHot= Server.CreateObject("ADODB.Recordset")
rsHot.open sqlHot,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsHot.bof and rsHot.eof then
response.write "<img src=\'skin/1/xiao.gif\'>无热门文章"
else
do while not rsHot.eof
\'--------------------------------稿纸效果修改开始--------午夜兰花
response.write "<table border=0 width=\'100%\' cellspacing=0 cellpadding=1><tr><td>"
response.Write "<img src=\'skin/1/xiao.gif\'><a href=\'" & rsHot("LayoutFileName") & "?ArticleID=" & rsHot("articleid") &"\' title=\'文章标题：" & rsHot("Title") & vbcrlf & "作 者：" & rsHot("Author") & vbcrlf & "更新时间：" & rsHot("UpdateTime") & vbcrlf & "点击次数：" & rsHot("Hits") & "\' target=\'_blank\'>" & gotTopic(rsHot("title"),TitleLen) & "</a>[<font color=red>" & rsHot("hits") & "</font>]<br>"
response.write "</td></tr><tr><td><table width=\'100%\' border=0 cellspacing=0 cellpadding=0><tr><td height=1 background=\'images/bg_dian.gif\'></td></tr></table></td></tr></table>"
\'--------------------------------稿纸效果修改结束--------午夜兰花
rsHot.movenext
loop
end if
rsHot.close
set rsHot=nothing
end sub \'=================================================
\'过程名：ShowElite
\'作 用：显示推荐文章
\'参 数：ArticleNum ----最多显示多少篇文章
\' TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowElite(ArticleNum,TitleLen)
dim sqlElite,rsElite
if ArticleNum>0 and ArticleNum<=100 then
sqlElite="select top " & ArticleNum
else
sqlElite="select top 10 "
end if
sqlElite=sqlElite & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=False and A.Passed=True And A.Elite=True order by A.articleid desc"
Set rsElite= Server.CreateObject("ADODB.Recordset")
rsElite.open sqlElite,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsElite.bof and rsElite.eof then
response.write "<img src=\'skin/1/xiao.gif\'>无推荐文章"
else
do while not rsElite.eof
\'--------------------------------稿纸效果修改开始--------午夜兰花
response.write "<table border=0 width=\'100%\' cellspacing=0 cellpadding=1><tr><td>"
response.Write "<img src=\'skin/1/xiao.gif\'><a href=\'" & rsElite("LayoutFileName") & "?ArticleID=" & rsElite("articleid") &"\' title=\'文章标题：" & rsElite("Title") & vbcrlf & "作 者：" & rsElite("Author") & vbcrlf & "更新时间：" & rsElite("UpdateTime") & vbcrlf & "点击次数：" & rsElite("Hits") & "\' target=\'_blank\'>" & gotTopic(rsElite("title"),TitleLen) & "</a>[<font color=red>" & rsElite("hits") & "</font>]<br>"
response.write "</td></tr><tr><td><table width=\'100%\' align=\'center\' border=0 cellspacing=0 cellpadding=0><tr><td height=1 background=\'images/bg_dian.gif\'></td></tr></table></td></tr></table>"
\'--------------------------------稿纸效果修改结束--------午夜兰花
rsElite.movenext
loop
end if
rsElite.close
set rsElite=nothing
end sub \'=================================================
\'过程名：ShowCorrelative
\'作 用：显示相关文章
\'参 数：ArticleNum ----最多显示多少篇文章
\' TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowCorrelative(ArticleNum,TitleLen)
dim rsCorrelative,sqlCorrelative
dim strKey,arrKey,i
if ArticleNum>0 and ArticleNum<=100 then
sqlCorrelative="select top " & ArticleNum
else
sqlCorrelative="Select Top 5 "
end if
strKey=mid(rs("Key"),2,len(rs("Key"))-2)
if instr(strkey,"|")>1 then
arrKey=split(strKey,"|")
strKey="((A.Key like \'%|" & arrKey(0) & "|%\')"
for i=1 to ubound(arrKey)
strKey=strKey & " or (A.Key like \'%|" & arrKey(i) & "|%\')"
next
strKey=strKey & ")"
else
strKey="(A.Key like \'%|" & strKey & "|%\')"
end if
sqlCorrelative=sqlCorrelative & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName From Article A inner join Layout L on L.LayoutID=A.LayoutID Where A.Deleted=False and A.Passed=True and " & strKey & " and A.ArticleID<>" & ArticleID & " Order by A.ArticleID desc"
Set rsCorrelative= Server.CreateObject("ADODB.Recordset")
rsCorrelative.open sqlCorrelative,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsCorrelative.bof and rsCorrelative.Eof then
response.write "<img src=\'skin/1/xiao.gif\'>没有相关文章"
else
do while not rsCorrelative.eof
\'--------------------------------稿纸效果修改开始--------午夜兰花
response.write "<table border=0 width=\'100%\' cellspacing=0 cellpadding=1><tr><td>"
response.write "<img src=\'skin/1/xiao.gif\'><a href=\'" & rsCorrelative("LayoutFileName") & "?ArticleID=" & rsCorrelative("ArticleID") & "\' title=\'文章标题：" & rsCorrelative("Title") & vbcrlf & "作 者：" & rsCorrelative("Author") & vbcrlf & "更新时间：" & rsCorrelative("UpdateTime") & vbcrlf & "点击次数：" & rsCorrelative("Hits") & "\'>" & gotTopic(rsCorrelative("Title"),TitleLen) & "</a><br>"
response.write "</td></tr><tr><td><table width=\'95%\'align=\'center\' border=0 cellspacing=0 cellpadding=0><tr><td height=1 background=\'images/bg_dian.gif\'></td></tr></table></td></tr></table>"
\'--------------------------------稿纸效果修改结束--------午夜兰花
rsCorrelative.movenext
loop
end if
rsCorrelative.close
set rsCorrelative=nothing
end sub
|
-- 作者：张医生
-- 发布时间：2005-4-25 13:36:08
--
\'以下内容参考了此前在论坛对此问题有所提及的几个朋友的解决方法，特此表示感谢，我本人是完全不懂asp的菜鸟，全凭兴趣苦心钻研得出结果，需要的朋友可去我网站上看。注：只对文章版块做了相应修改，由于本人工作有限，逛论坛的时间不多，如对我的修改（非美化）有兴趣的朋友可在此跟贴，我看到了会尽快回复。
\'相关图片一起列如下，请自己对照，有问题再提出。
\'另：本人的求助贴，请朋友们帮忙解决：http://bbs.asp163.net/dispbbs.asp?boardID=24&ID=56695&page=1
\'=================================================
\'过程名：ArticleContent
\'作 用：显示文档属性、标题、作者、更新日期、点击数等信息
\'参 数：intTitleLen ----标题最多字符数，一个汉字=两个英文字符
\' ShowProperty ----是否显示文档属性（固顶/推荐/普通），True为显示，False为不显示
\' ShowIncludePic ---是否显示“[图文]”字样，True为显示，False为不显示
\' ShowAuthor -------是否显示文档作者，True为显示，False为不显示
\' ShowDateType -----显示更新日期的样式，0为不显示，1为显示年月日，2为只显示月日。
\' ShowHits ---------是否显示文档点击数，True为显示，False为不显示
\' ShowHot ----------是否显示热门文档标志，True为显示，False为不显示
\'=================================================
sub ArticleContent(intTitleLen,ShowProperty,ShowIncludePic,ShowAuthor,ShowDateType,ShowHits,ShowHot)
dim i,strTemp,TitleStr,Author,AuthorName,AuthorEmail
i=0
do while not rsArticle.eof
strTemp="<table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>"
if ShowProperty=True then
if rsArticle("OnTop")=true then
strTemp = strTemp & "<img src=\'images/article_ontop.gif\' alt=\'固顶文档\'> "
elseif rsArticle("Elite")=true then
strTemp = strTemp & "<img src=\'images/article_elite.gif\' alt=\'推荐文档\'> "
else
strTemp = strTemp & "<img src=\'images/article_common.gif\' alt=\'普通文档\'> "
end if
end if
if ShowIncludePic=True and rsArticle("IncludePic")=true then
strTemp = strTemp & "<font color=blue>[图文]</font>"
end if
Author=rsArticle("Author")
if instr(Author,"|")>0 then
AuthorName=left(Author,instr(Author,"|")-1)
AuthorEmail=right(Author,len(Author)-instr(Author,"|")-1)
else
AuthorName=Author
AuthorEmail=""
end if
strTemp = strTemp & "<a href=\'" & rsArticle("LayoutFileName") & "?ArticleID=" & rsArticle("articleid") & "\' title=\'文档标题：" & rsArticle("Title") & vbcrlf & "文档作者：" & AuthorName & vbcrlf & "更新时间：" & rsArticle("UpdateTime") & vbcrlf & "点击次数：" & rsArticle("Hits") & "\' target=\'_blank\'>"
TitleStr=gotTopic(rsArticle("title"),intTitleLen)
if rsArticle("TitleFontType")=1 then
TitleStr="<b>" & TitleStr & "</b>"
elseif rsArticle("TitleFontType")=2 then
TitleStr="<em>" & TitleStr & "</em>"
elseif rsArticle("TitleFontType")=3 then
TitleStr="<b><em>" & TitleStr & "</em></b>"
end if
if rsArticle("TitleFontColor")<>"" then
TitleStr="<font color=\'" & rsArticle("TitleFontColor") & "\'>" & TitleStr & "</font>"
end if
strTemp=strTemp & TitleStr & "</a>"
if ShowHot=True and rsArticle("Hits")>=HitsOfHot then
strTemp= strTemp & "<img src=\'images/hot.gif\' alt=\'热点文档\'>"
end if
if ShowAuthor=True or ShowDateType>0 or ShowHits=True then
strTemp = strTemp & "</td><td align=right>["
if ShowAuthor=True then
if AuthorEmail="" then
strTemp=strTemp & AuthorName
else
strTemp=strTemp & "<a href=\'mailt" & AuthorEmail & "\'>" & AuthorName & "</a>"
end if
end if
if ShowDateType>0 then
if ShowAuthor=True then
strTemp=strTemp & "|"
end if
if CDate(FormatDateTime(rsArticle("UpdateTime"),2))=date() then
strTemp = strTemp & "<font color=red>"
else
strTemp= strTemp & "<font color=#999999>"
end if
if ShowDateType=1 then
strTemp= strTemp & month(rsArticle("UpdateTime")) & "-" & day(rsArticle("UpdateTime")) & "</font>"
else
strTemp=strTemp & FormatDateTime(rsArticle("UpdateTime"),1) & "</font>"
end if
end if
if ShowHits=True then
if ShowAuthor=True or ShowDateType>0 then
strTemp=strTemp & "|"
end if
strTemp=strTemp & rsArticle("Hits")
end if
strTemp=strTemp & "]"
end if
strTemp= strTemp & "</td></tr>"
strTemp= strTemp & "<tr><td colspan=\'2\' height=\'5\'><table width=\'100%\' align=\'center\' border=0 cellspacing=0 cellpadding=0 style=\'height:1; border-bottom-width: 1px; border-bottom-style: dotted; border-bottom-color: #cccccc\'><tr><td></td></tr></table></td></tr></table>"
response.write strTemp
rsArticle.movenext
i=i+1
if i>=MaxPerPage then exit do
loop
end sub \'=================================================
\'过程名：ShowUserArticle
\'作 用：分页显示用户文章标题等信息
\'参 数：TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowUserArticle(TitleLen)
if TitleLen<0 or TitleLen>200 then
TitleLen=50
end if sqlArticle=sqlArticle & "select A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
sqlArticle=sqlArticle & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
sqlArticle=sqlArticle & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True and Editor=\'" & UserName & "\'"
if SpecialID>0 then
sqlArticle=sqlArticle & " and A.SpecialID=" & SpecialID
end if
if ClassId>0 then
sqlArticle=sqlArticle & " and A.ClassID=" & ClassID
end if
sqlArticle=sqlArticle & " order by A.OnTop,A.ArticleID desc" Set rsArticle= Server.CreateObject("ADODB.Recordset")
rsArticle.open sqlArticle,conn,1,1
if rsArticle.bof and rsArticle.eof then
totalput=0
response.Write("<br><li>没有任何文章</li>")
else
totalput=rsArticle.recordcount
if currentpage<1 then
currentpage=1
end if
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
call ArticleContent(TitleLen,True,True,True,2,True,True)
else
if (currentPage-1)*MaxPerPage<totalPut then
rsArticle.move (currentPage-1)*MaxPerPage
dim bookmark
bookmark=rsArticle.bookmark
call ArticleContent(TitleLen,True,True,True,2,True,True)
else
currentPage=1
call ArticleContent(TitleLen,True,True,True,2,True,True)
end if
end if
end if
rsArticle.close
set rsArticle=nothing
end sub 效果：http://www.glr.cn
http://www.glr.cn/Article_Show.asp?ArticleID=640
|
-- 作者：张医生
-- 发布时间：2005-4-25 13:36:45
--
\'=================================================
\'过程名：ShowSearchResult
\'作 用：分页显示搜索结果
\'参 数：无
\'=================================================
sub ShowSearchResult()
dim arrClassID,trs
sqlSearch=sqlSearch & "select A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,A.Content,"
sqlSearch=sqlSearch & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
sqlSearch=sqlSearch & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True"
if ClassID>0 then
if Child>0 then
arrClassID=ClassID
if ParentID>0 then
set trs=conn.execute("select ClassID from ArticleClass where ParentID=" & ClassID & " or ParentPath like \'%" & ParentPath & "," & ClassID & ",%\' and Child=0 and LinkUrl=\'\' and BrowsePurview>=" & UserLevel)
else
set trs=conn.execute("select ClassID from ArticleClass where RootID=" & RootID & " and Child=0 and LinkUrl=\'\' and BrowsePurview>=" & UserLevel)
end if
do while not trs.eof
arrClassID=arrClassID & "," & trs(0)
trs.movenext
loop
set trs=nothing
sqlSearch=sqlSearch & " and A.ClassID in (" & arrClassID & ")"
else
sqlSearch=sqlSearch & " and A.ClassID=" & ClassID
end if
end if
if keyword<>"" then
select case strField
case "Title"
sqlSearch=sqlSearch & " and A.Title like \'%" & keyword & "%\' "
case "Content"
sqlSearch=sqlSearch & " and A.Content like \'%" & keyword & "%\' "
case "Author"
sqlSearch=sqlSearch & " and A.Author like \'%" & keyword & "%\' "
case "Editor"
sqlSearch=sqlSearch & " and A.Editor like \'%" & keyword & "%\' "
case else
sqlSearch=sqlSearch & " and A.Title like \'%" & keyword & "%\' "
end select
end if
sqlSearch=sqlSearch & " order by A.Articleid desc"
Set rsSearch= Server.CreateObject("ADODB.Recordset")
rsSearch.open sqlSearch,conn,1,1
if rsSearch.eof and rsSearch.bof then
totalput=0
response.write "<p align=\'center\'><br><br>没有或没有找到任何文章</p>"
else
totalput=rsSearch.recordcount
if currentpage<1 then
currentpage=1
end if
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
call SearchResultContent()
else
if (currentPage-1)*MaxPerPage<totalPut then
rsSearch.move (currentPage-1)*MaxPerPage
dim bookmark
bookmark=rsSearch.bookmark
call SearchResultContent()
else
currentPage=1
call SearchResultContent()
end if
end if
end if
rsSearch.close
set rsSearch=nothing
end sub sub SearchResultContent()
dim i,strTemp,content
i=1
do while not rsSearch.eof
strTemp=""
strTemp=strTemp & cstr(MaxPerPage*(CurrentPage-1)+i) & ".<a href=\'" & rsSearch("LayoutFileName") & "?ArticleID=" & rsSearch("articleid") & "\'>"
if strField="Title" then
strTemp=strTemp & "<b>" & replace(rsSearch("title"),""&keyword&"","<font color=red>"&keyword&"</font>") & "</b></font></a>"
else
strTemp=strTemp & "<b>" & rsSearch("title") & "</b>"
end if
if strField="Author" then
strTemp=strTemp & " [" & replace(rsSearch("Author"),""&keyword&"","<font color=red>"&keyword&"</font>") & "]"
else
strTemp=strTemp & " [" & rsSearch("Author") & "]"
end if
strTemp=strTemp & "[" & FormatDateTime(rsSearch("UpdateTime"),1) & "][" & rsSearch("Hits") & "]"
content=left(replace(replace(nohtml(rsSearch("content")), ">", ">"), "<", "<"),100)
if strField="Content" then
strTemp=strTemp & "<div style=\'padding:10px 20px\'>" & replace(content,""&keyword&"","<font color=red>"&keyword&"</font>") & "……</div>"
else
strTemp=strTemp & "<div style=\'padding:10px 20px\'>" & content & "……</div>"
end if
strTemp=strTemp & "</a>"
response.write strTemp
i=i+1
if i>MaxPerPage then exit do
rsSearch.movenext
loop
end sub \'=================================================
\'过程名：ShowNewArticle
\'作 用：显示最新文章
\'参 数：ArticleNum ----最多显示多少篇文章
\' TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowNewArticle(ArticleNum,TitleLen)
dim sqlNew,rsNew
if ArticleNum>0 and ArticleNum<=100 then
sqlNew="select top " & ArticleNum
else
sqlNew="select top 10 "
end if
sqlNew=sqlNew & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=False and A.Passed=True order by A.articleid desc"
Set rsNew= Server.CreateObject("ADODB.Recordset")
rsNew.open sqlNew,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsNew.bof and rsNew.eof then
response.write "<img src=\'images/article_common.gif\'>没有文章"
else
do while not rsNew.eof
\'--------------------------------稿纸效果修改开始--------这个是用CSS定义的虚线
response.write "<table border=0 width=\'100%\' cellspacing=0 cellpadding=1 ><tr><td>"
response.write "<img src=\'images/article_common.gif\'> <a href=\'" & rsNew("LayoutFileName") & "?ArticleID=" & rsNew("articleid") &"\' title=\'标题：" & rsNew("Title") & vbcrlf & "作者：" & rsNew("Author") & vbcrlf & "时间：" & rsNew("UpdateTime") & vbcrlf & "点击：" & rsNew("Hits") & "\' target=\'_blank\'>" & gotTopic(rsNew("title"),TitleLen) & "</a>" if datediff("d",rsNew("UpdateTime"),date())<3 then
response.write("</td><td align=\'right\' nowrap style=\'width:1%\'>" & "［" & "<font color=red>" & month(rsnew("updateTime")) & "-" & day(rsnew("updateTime")) & "</font>" & "］")
else
response.write("</td><td align=\'right\' nowrap style=\'width:1%\'>" & "［" & "<font color=#999999>" & month(rsnew("updateTime")) & "-" & day(rsnew("updateTime")) & "</font>" & "］")
end if
response.write "</td></tr><tr><td colspan=\'2\'><table width=\'100%\' border=0 cellspacing=0 cellpadding=0 style=\'height:1; border-bottom-width: 1px; border-bottom-style: dotted; border-bottom-color: #cccccc\'><tr><td></td></tr></table></td></tr></table>"
\'--------------------------------稿纸效果修改结束--------
rsNew.movenext
loop
end if
rsNew.close
set rsNew=nothing
end sub \'=================================================
\'过程名：ShowHot
\'作 用：显示热门文章
\'参 数：ArticleNum ----最多显示多少篇文章
\' TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowHot(ArticleNum,TitleLen)
dim sqlHot,rsHot
if ArticleNum>0 and ArticleNum<=100 then
sqlHot="select top " & ArticleNum
else
sqlHot="select top 10 "
end if
sqlHot=sqlHot & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=False and A.Passed=True And A.Hits>=" & HitsOfHot & " order by A.ArticleID desc"
Set rsHot= Server.CreateObject("ADODB.Recordset")
rsHot.open sqlHot,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsHot.bof and rsHot.eof then
response.write "<img src=\'images/article_common.gif\'>无热门文章"
else
do while not rsHot.eof
\'--------------------------------稿纸效果修改开始
response.write "<table border=0 width=\'100%\' cellspacing=0 cellpadding=1 ><tr><td nowrap>"
response.Write "<img src=\'images/article_common.gif\'> <a href=\'" & rsHot("LayoutFileName") & "?ArticleID=" & rsHot("articleid") &"\' title=\'文章标题：" & rsHot("Title") & vbcrlf & "作 者：" & rsHot("Author") & vbcrlf & "更新时间：" & rsHot("UpdateTime") & vbcrlf & "点击次数：" & rsHot("Hits") & "\' target=\'_blank\'>" & gotTopic(rsHot("title"),TitleLen) & "</a>[<font color=red>" & rsHot("hits") & "</font>]<br>"
response.write "</td></tr><tr><td height=\'5\'><table width=\'100%\' border=0 cellspacing=0 cellpadding=0 style=\'height:1; border-bottom-width: 1px; border-bottom-style: dotted; border-bottom-color: #cccccc\'><tr><td></td></tr></table></td></tr></table>"
\'--------------------------------稿纸效果修改结束
rsHot.movenext
loop
end if
rsHot.close
set rsHot=nothing
end sub \'=================================================
\'过程名：ShowElite
\'作 用：显示推荐文章
\'参 数：ArticleNum ----最多显示多少篇文章
\' TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowElite(ArticleNum,TitleLen)
dim sqlElite,rsElite
if ArticleNum>0 and ArticleNum<=100 then
sqlElite="select top " & ArticleNum
else
sqlElite="select top 10 "
end if
sqlElite=sqlElite & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=False and A.Passed=True And A.Elite=True order by A.articleid desc"
Set rsElite= Server.CreateObject("ADODB.Recordset")
rsElite.open sqlElite,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsElite.bof and rsElite.eof then
response.write "<img src=\'images/article_common.gif\'>无推荐文章"
else
do while not rsElite.eof
\'--------------------------------稿纸效果修改开始
response.write "<table border=0 width=\'100%\' cellspacing=0 cellpadding=1 ><tr><td nowrap>"
response.Write "<img src=\'images/article_common.gif\'> <a href=\'" & rsElite("LayoutFileName") & "?ArticleID=" & rsElite("articleid") &"\' title=\'文章标题：" & rsElite("Title") & vbcrlf & "作 者：" & rsElite("Author") & vbcrlf & "更新时间：" & rsElite("UpdateTime") & vbcrlf & "点击次数：" & rsElite("Hits") & "\' target=\'_blank\'>" & gotTopic(rsElite("title"),TitleLen) & "</a>[<font color=red>" & rsElite("hits") & "</font>]<br>"
response.write "</td></tr><tr><td height=\'5\'><table width=\'100%\' align=\'center\' border=0 cellspacing=0 cellpadding=0 style=\'height:1; border-bottom-width: 1px; border-bottom-style: dotted; border-bottom-color: #cccccc\'><tr><td></td></tr></table></td></tr></table>"
\'--------------------------------稿纸效果修改结束
rsElite.movenext
loop
end if
rsElite.close
set rsElite=nothing
end sub \'=================================================
\'过程名：ShowCorrelative
\'作 用：显示相关文章
\'参 数：ArticleNum ----最多显示多少篇文章
\' TitleLen ----标题最多字符数，一个汉字=两个英文字符
\'=================================================
sub ShowCorrelative(ArticleNum,TitleLen)
dim rsCorrelative,sqlCorrelative
dim strKey,arrKey,i
if ArticleNum>0 and ArticleNum<=100 then
sqlCorrelative="select top " & ArticleNum
else
sqlCorrelative="Select Top 5 "
end if
strKey=mid(rs("Key"),2,len(rs("Key"))-2)
if instr(strkey,"|")>1 then
arrKey=split(strKey,"|")
strKey="((A.Key like \'%|" & arrKey(0) & "|%\')"
for i=1 to ubound(arrKey)
strKey=strKey & " or (A.Key like \'%|" & arrKey(i) & "|%\')"
next
strKey=strKey & ")"
else
strKey="(A.Key like \'%|" & strKey & "|%\')"
end if
sqlCorrelative=sqlCorrelative & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName From Article A inner join Layout L on L.LayoutID=A.LayoutID Where A.Deleted=False and A.Passed=True and " & strKey & " and A.ArticleID<>" & ArticleID & " Order by A.ArticleID desc"
Set rsCorrelative= Server.CreateObject("ADODB.Recordset")
rsCorrelative.open sqlCorrelative,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsCorrelative.bof and rsCorrelative.Eof then
response.write "<img src=\'images/article_common.gif\'>没有相关文章"
else
do while not rsCorrelative.eof
\'--------------------------------稿纸效果修改开始
response.write "<table border=0 width=\'100%\' cellspacing=0 cellpadding=1 ><tr><td nowrap>"
response.write "<img src=\'images/article_common.gif\'> <a href=\'" & rsCorrelative("LayoutFileName") & "?ArticleID=" & rsCorrelative("ArticleID") & "\' title=\'文章标题：" & rsCorrelative("Title") & vbcrlf & "作 者：" & rsCorrelative("Author") & vbcrlf & "更新时间：" & rsCorrelative("UpdateTime") & vbcrlf & "点击次数：" & rsCorrelative("Hits") & "\'>" & gotTopic(rsCorrelative("Title"),TitleLen) & "</a><br>"
response.write "</td></tr><tr><td height=\'5\'><table width=\'95%\'align=\'center\' border=0 cellspacing=0 cellpadding=0 style=\'height:1; border-bottom-width: 1px; border-bottom-style: dotted; border-bottom-color: #cccccc\'><tr><td></td></tr></table></td></tr></table>"
\'--------------------------------稿纸效果修改结束
rsCorrelative.movenext
loop
end if
rsCorrelative.close
set rsCorrelative=nothing
end sub 效果：http://www.glr.cn
http://www.glr.cn/Article_Show.asp?ArticleID=707
|
-- 作者：张医生
-- 发布时间：2005-4-25 13:37:56
--
\'=================================================
\'过程名：ArticleContent
\'作 用：显示文档属性、标题、作者、更新日期、点击数等信息
\'参 数：intTitleLen ----标题最多字符数，一个汉字=两个英文字符
\' ShowProperty ----是否显示文档属性（固顶/推荐/普通），True为显示，False为不显示
\' ShowIncludePic ---是否显示“[图文]”字样，True为显示，False为不显示
\' ShowAuthor -------是否显示文档作者，True为显示，False为不显示
\' ShowDateType -----显示更新日期的样式，0为不显示，1为显示年月日，2为只显示月日。
\' ShowHits ---------是否显示文档点击数，True为显示，False为不显示
\' ShowHot ----------是否显示热门文档标志，True为显示，False为不显示
\'=================================================
sub ArticleContent(intTitleLen,ShowProperty,ShowIncludePic,ShowAuthor,ShowDateType,ShowHits,ShowHot)
dim i,strTemp,TitleStr,Author,AuthorName,AuthorEmail
i=0
do while not rsArticle.eof
strTemp="<table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>"
if ShowProperty=True then
if rsArticle("OnTop")=true then
strTemp = strTemp & "<img src=\'images/article_ontop.gif\' alt=\'固顶文档\'> "
elseif rsArticle("Elite")=true then
strTemp = strTemp & "<img src=\'images/article_elite.gif\' alt=\'推荐文档\'> "
else
strTemp = strTemp & "<img src=\'images/article_common.gif\' alt=\'普通文档\'> "
end if
end if
if ShowIncludePic=True and rsArticle("IncludePic")=true then
strTemp = strTemp & "<font color=blue>[图文]</font>"
end if
Author=rsArticle("Author")
if instr(Author,"|")>0 then
AuthorName=left(Author,instr(Author,"|")-1)
AuthorEmail=right(Author,len(Author)-instr(Author,"|")-1)
else
AuthorName=Author
AuthorEmail=""
end if
strTemp = strTemp & "<a href=\'" & rsArticle("LayoutFileName") & "?ArticleID=" & rsArticle("articleid") & "\' title=\'文档标题：" & rsArticle("Title") & vbcrlf & "文档作者：" & AuthorName & vbcrlf & "更新时间：" & rsArticle("UpdateTime") & vbcrlf & "点击次数：" & rsArticle("Hits") & "\' target=\'_blank\'>"
TitleStr=gotTopic(rsArticle("title"),intTitleLen)
if rsArticle("TitleFontType")=1 then
TitleStr="<b>" & TitleStr & "</b>"
elseif rsArticle("TitleFontType")=2 then
TitleStr="<em>" & TitleStr & "</em>"
elseif rsArticle("TitleFontType")=3 then
TitleStr="<b><em>" & TitleStr & "</em></b>"
end if
if rsArticle("TitleFontColor")<>"" then
TitleStr="<font color=\'" & rsArticle("TitleFontColor") & "\'>" & TitleStr & "</font>"
end if
strTemp=strTemp & TitleStr & "</a>"
if ShowHot=True and rsArticle("Hits")>=HitsOfHot then
strTemp= strTemp & "<img src=\'images/hot.gif\' alt=\'热点文档\'>"
end if
if ShowAuthor=True or ShowDateType>0 or ShowHits=True then
strTemp = strTemp & "</td><td align=right>["
if ShowAuthor=True then
if AuthorEmail="" then
strTemp=strTemp & AuthorName
else
strTemp=strTemp & "<a href=\'mailt" & AuthorEmail & "\'>" & AuthorName & "</a>"
end if
end if
if ShowDateType>0 then
if ShowAuthor=True then
strTemp=strTemp & "|"
end if
if CDate(FormatDateTime(rsArticle("UpdateTime"),2))=date() then
strTemp = strTemp & "<font color=red>"
else
strTemp= strTemp & "<font color=#999999>"
end if
if ShowDateType=1 then
strTemp= strTemp & month(rsArticle("UpdateTime")) & "-" & day(rsArticle("UpdateTime")) & "</font>"
else
strTemp=strTemp & FormatDateTime(rsArticle("UpdateTime"),1) & "</font>"
end if
end if
if ShowHits=True then
if ShowAuthor=True or ShowDateType>0 then
strTemp=strTemp & "|"
end if
strTemp=strTemp & rsArticle("Hits")
end if
strTemp=strTemp & "]"
end if
strTemp= strTemp & "</td></tr>"
strTemp= strTemp & "<tr><td colspan=\'2\' height=\'5\'><table width=\'100%\' align=\'center\' border=0 cellspacing=0 cellpadding=0 style=\'height:1; border-bottom-width: 1px; border-bottom-style: dotted; border-bottom-color: #cccccc\'><tr><td></td></tr></table></td></tr></table>"
response.write strTemp
rsArticle.movenext
i=i+1
if i>=MaxPerPage then exit do
loop
end sub
效果：http://www.glr.cn/Article_Class2.asp?ClassID=2 说明：原样拷贝第一、二楼的代码替换掉原有代码即可实现文章频道所有页面的签纸效果。 最新文章调用处多了一个“［”，会在日期变灰后表现出来，请此前引用代码的朋友注意修改。9月10日后引用的不会出现此问题。
|