dvbbs
收藏本页
联系我们
论坛帮助
dvbbs

>> 电脑网络管理、网页制作、免费素材、经验交流、软硬件......
搜一搜更多此类问题 
肿瘤咨询在线论坛站务服务『 电脑网络 』 → 351日期右对齐、标题稿纸效果

您是本帖的第 3138 个阅读者
树形 打印
标题:
351日期右对齐、标题稿纸效果
张医生
帅哥哟,离线,有人找我吗?
头衔:专家
等级:管理员
威望:10
文章:4704
积分:9428
注册:2002年5月26日
楼主
 点击这里发送电子邮件给张医生

发贴心情
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


做人难,  做医生更难;  做好人难,  做好医生更难。
ip地址已设置保密
2005-4-25 13:23:37
张医生
帅哥哟,离线,有人找我吗?
头衔:专家
等级:管理员
威望:10
文章:4704
积分:9428
注册:2002年5月26日
2
 点击这里发送电子邮件给张医生

发贴心情

'以下内容参考了此前在论坛对此问题有所提及的几个朋友的解决方法,特此表示感谢,我本人是完全不懂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='固顶文档'>&nbsp;"
   elseif rsArticle("Elite")=true then
    strTemp = strTemp & "<img src='images/article_elite.gif' alt='推荐文档'>&nbsp;"
   else
    strTemp = strTemp & "<img src='images/article_common.gif' alt='普通文档'>&nbsp;"
   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


做人难,  做医生更难;  做好人难,  做好医生更难。
ip地址已设置保密
2005-4-25 13:36:08
张医生
帅哥哟,离线,有人找我吗?
头衔:专家
等级:管理员
威望:10
文章:4704
积分:9428
注册:2002年5月26日
3
 点击这里发送电子邮件给张医生

发贴心情

'=================================================
'过程名: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 & "&nbsp;[" & replace(rsSearch("Author"),""&keyword&"","<font color=red>"&keyword&"</font>") & "]"
  else
   strTemp=strTemp & "&nbsp;[" & rsSearch("Author") & "]"
  end if
  strTemp=strTemp & "[" & FormatDateTime(rsSearch("UpdateTime"),1) & "][" & rsSearch("Hits") & "]"
  content=left(replace(replace(nohtml(rsSearch("content")), ">", "&gt;"), "<", "&lt;"),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'>&nbsp;<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'>&nbsp;<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'>&nbsp;<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'>&nbsp;<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


做人难,  做医生更难;  做好人难,  做好医生更难。
ip地址已设置保密
2005-4-25 13:36:45
张医生
帅哥哟,离线,有人找我吗?
头衔:专家
等级:管理员
威望:10
文章:4704
积分:9428
注册:2002年5月26日
4
 点击这里发送电子邮件给张医生

发贴心情

'=================================================
'过程名: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='固顶文档'>&nbsp;"
   elseif rsArticle("Elite")=true then
    strTemp = strTemp & "<img src='images/article_elite.gif' alt='推荐文档'>&nbsp;"
   else
    strTemp = strTemp & "<img src='images/article_common.gif' alt='普通文档'>&nbsp;"
   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日后引用的不会出现此问题。


做人难,  做医生更难;  做好人难,  做好医生更难。
ip地址已设置保密
2005-4-25 13:37:56

 4   4   1/1页      1    
网上贸易 创造奇迹! 阿里巴巴 Alibaba
Copyright ©2000 - 2002 chinaonco.net
Powered By Dvbbs Version 7.1.0 Sp1
页面执行时间 0.12500 秒, 4 次数据查询