📄 func_info.asp
字号:
response.write "『<a href='UserInfo.asp?UserID=" & rsCommentUser(0) & "' title='姓名：" & rsCommentUser(1) & vbcrlf & "信箱：" & rsCommentUser(2) & vbcrlf & "Oicq：" & rsCommentUser(3) & vbcrlf & "主页：" & rsCommentUser(4)&"'><font color='blue'>" & rsComment("UserName") & "</font></a>』"
end if
else
response.write "<li>游客『<span title='姓名：" & rsComment("UserName") & vbcrlf & "信箱：" & rsComment("Email") & vbcrlf & "Oicq：" & rsComment("Oicq") & vbcrlf & "主页：" & rsComment("Homepage")&"' style='cursor:hand'><font color='blue'>" & rsComment("UserName") & "</font></span>』"
end if
response.write "于" & rsComment("WriteTime") & "发表评论：</li>"
response.write "</td><td align=right>评分："&rsComment("Score")&"分</td></tr>"
response.write "<tr><td colspan='2'>"
response.write " " & rsComment("Content") & "<br>"
if rsComment("ReplyContent")<>"" then
response.write " <font color='009900'>★</font> 管理员『<font color='blue'>" & rsComment("ReplyName") & "</font>』于 " & rsComment("ReplyTime") & " 回复道： " & rsComment("ReplyContent") & "<br>"
end if
response.write "<br></td></tr>"
rsComment.movenext
loop
response.write "<tr><td colspan='2' align='right'>"
response.write "<a href='info_CommentShow.asp?ArticleID=" & ArticleID & "' target='_blank'>查看关于此文章的所有评论</a>"
response.write "</td></tr></table>"
end if
end sub
'=================================================
'过程名：ShowPrevArticle
'作 用：显示上一篇文章
'参 数：TitleLen ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowPrevArticle(TitleLen)
dim rsPrev,sqlPrev
sqlPrev="Select Top 1 A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName From Article A inner join Layout L on A.LayoutID=L.LayoutID Where Deleted=False and Passed=True and ClassID=" & rs("ClassID") & " and ArticleID<" & rs("ArticleID")& " order by ArticleID DESC"
Set rsPrev= Server.CreateObject("ADODB.Recordset")
rsPrev.open sqlPrev,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsPrev.Eof then
response.write "没有了"
else
response.write "<a href='" & rsPrev("LayoutFileName") & "?ArticleID=" & rsPrev("ArticleID")& "' title='文章标题：" & rsPrev("Title") & vbcrlf & "作 者：" & rsPrev("Author") & vbcrlf & "更新时间：" & rsPrev("UpdateTime") & vbcrlf & "点击次数：" & rsPrev("Hits") &"'>" & gotTopic(rsPrev("Title"),TitleLen) & "</a>"
end if
rsPrev.close
set rsPrev=nothing
end sub
'=================================================
'过程名：ShowNextArticle
'作 用：显示上一篇文章
'参 数：TitleLen ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowNextArticle(TitleLen)
dim rsNext,sqlNext
sqlNext="Select Top 1 A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName From Article A inner join Layout L on A.LayoutID=L.LayoutID Where Deleted=False and Passed=True and ClassID=" & rs("ClassID") & " and ArticleID>" & rs("ArticleID")& " order by ArticleID ASC"
Set rsNext= Server.CreateObject("ADODB.Recordset")
rsNext.open sqlNext,conn,1,1
if TitleLen<0 or TitleLen>255 then TitleLen=50
if rsNext.Eof then
response.write "没有了"
else
response.write "<a href='"& rsNext("LayoutFileName") & "?ArticleID="&rsNext("ArticleID")& "' title='文章标题：" & rsNext("Title") & vbcrlf & "作 者：" & rsNext("Author") & vbcrlf & "更新时间：" & rsNext("UpdateTime") & vbcrlf & "点击次数：" & rsNext("Hits") &"'>" & gotTopic(rsNext("Title"),TitleLen) & "</a>"
end if
rsNext.close
set rsNext=nothing
end sub
'=================================================
'过程名：ShowPicArticle
'作 用：显示图片文章
'参 数：intClassID ----栏目ID，0为所有栏目，若大于0，则显示指定栏目及其子栏目的图片文章
' ArticleNum ----最多显示多少篇文章
' TitleLen ----标题最多字符数，一个汉字=两个英文字符
' ShowType ----显示方式。1为只有图片+标题，2为图片+标题+内容简介
' Cols ----列数。超过此列数就换行。
' ImgWidth ----图片宽度
' ImgHeight ----图片高度
' ContentLen ----内容最多字符数
' Hot ----是否是热门文章
' Elite ----是否是推荐文章
'=================================================
sub ShowPicArticle(intClassID,ArticleNum,TitleLen,ShowType,Cols,ImgWidth,ImgHeight,ContentLen,Hot,Elite)
dim sqlPic,i,tClass,trs,arrClassID
if ArticleNum<0 or ArticleNum>=50 then
ArticleNum=5
end if
if ShowType<>1 and ShowType<>2 then
ShowType=1
end if
if Cols<=0 or Cols>=10 then
Cols=5
end if
if ImgWidth<0 or ImgWidth>500 then
ImgWidth=150
end if
if ImgHeight<0 or ImgHeight>500 then
ImgHeight=150
end if
if Hot<>True and Hot<>False then
Hot=False
end if
if Elite<>True and Elite<>False then
Elite=False
end if
sqlPic="select top " & ArticleNum
sqlPic=sqlPic & " A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
if ShowType=2 then
sqlPic=sqlPic & "A.Content,"
end if
sqlPic=sqlPic & " 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"
sqlPic=sqlPic & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True and DefaultPicUrl<>''"
if intClassID>0 then
set tClass=conn.execute("select ClassID,Child,ParentPath from ArticleClass where ClassID=" & intClassID)
if not(tClass.bof and tClass.eof) then
if tClass(1)>0 then
arrClassID=ClassID
set trs=conn.execute("select ClassID from ArticleClass where ParentID=" & tClass(0) & " or ParentPath like '%" & tClass(2) & "," & tClass(0) & ",%' and Child=0 and LinkUrl=''")
do while not trs.eof
arrClassID=arrClassID & "," & trs(0)
trs.movenext
loop
set trs=nothing
sqlPic=sqlPic & " and A.ClassID in (" & arrClassID & ")"
else
sqlPic=sqlPic & " and A.ClassID=" & tClass(0)
end if
set trs=nothing
else
sqlPic=sqlPic & " and A.ClassID=" & tClass(0)
end if
set tClass=nothing
end if
if Hot=True then
sqlPic=sqlPic & " and A.Hits>=" & HitsOfHot
end if
if Elite=True then
sqlPic=sqlPic & " and A.Elite=True "
end if
sqlPic=sqlPic & " order by A.OnTop,A.ArticleID desc"
set rsPic=Server.CreateObject("ADODB.Recordset")
rsPic.open sqlPic,conn,1,1
strPic= "<table width='100%' cellpadding='0' cellspacing='2' border='0' align='center'><tr valign='top'>"
if rsPic.bof and rsPic.eof then
strPic= strPic & "<td align='center'><img src='images/NoPic.jpg' width='" & ImgWidth & "' height='" & ImgHeight & "' border='0'><br>没有图片信息</td>"
else
i=0
if ShowType=1 then
do while not rsPic.eof
strPic=strPic & "<td align='center'>"
call GetPicArticleTitle(TitleLen,ImgWidth,ImgHeight)
strPic=strPic & "</td>"
rsPic.movenext
i=i+1
if ((i mod Cols=0) and (not rsPic.eof)) then strPic=strPic & "</tr><tr valign='top'>"
loop
elseif ShowType=2 then
do while not rsPic.eof
strPic=strPic & "<td align='center'>"
call GetPicArticleTitle(TitleLen,ImgWidth,ImgHeight)
strPic=strPic & "</td><td valign='top' style='padding:5px,0px,5px,0px'><a href='" & rsPic("LayoutFileName") & "?ArticleID=" & rsPic("ArticleID") & "'>" & left(nohtml(rsPic("Content")),ContentLen) & "...</a></td>"
rsPic.movenext
i=i+1
if ((i mod Cols=0) and (not rsPic.eof)) then strPic=strPic & "</tr><tr valign='top'>"
loop
end if
end if
strPic=strPic & "</tr></table>"
response.write strPic
rsPic.close
end sub
'=================================================
'过程名：GetPicArticleTitle
'作 用：显示图片文章的标题
'参 数：intTitleLen ----标题最多字符数，一个汉字=两个英文字符
' intImgWidth ----图片宽度
' intImgHeight ----图片高度
'=================================================
sub GetPicArticleTitle(intTitleLen,intImgWidth,intImgHeight)
dim FileType,TitleStr
FileType=right(lcase(rsPic("DefaultPicUrl")),3)
TitleStr=gotTopic(rsPic("Title"),intTitleLen)
strPic=strPic & "<span class='TitleStr'><a href='" & rsPic("LayoutFileName") & "?ArticleID=" & rsPic("ArticleID") & "' title='文章标题：" & rsPic("Title") & vbcrlf & "作 者：" & rsPic("Author") & vbcrlf & "更新时间：" & rsPic("UpdateTime") & vbcrlf & "点击次数：" & rsPic("Hits") & "' target='_blank'>"
if FileType="swf" then
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='" & intImgWidth & "' height='" & intImgHeight & "'><param name='movie' value='" & rsPic("DefaultPicUrl") & "'><param name='quality' value='high'><embed src='" & rsPic("DefaultPicUrl") & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='" & intImgWidth & "' height='" & intImgHeight & "'></embed></object>"
elseif fileType="jpg" or fileType="bmp" or fileType="png" or fileType="gif" then
strPic=strPic & "<img src='" & rsPic("DefaultPicUrl") & "' width='" & intImgWidth & "' height='" & intImgHeight & "' border='0'>"
else
strPic=strPic & "<img src='images/NoPic2.jpg' width='" & intImgWidth & "' height='" & intImgHeight & "' border='0'>"
end if
if rsPic("TitleFontType")=1 then
TitleStr="<b>" & TitleStr & "</b>"
elseif rsPic("TitleFontType")=2 then
TitleStr="<em>" & TitleStr & "</em>"
elseif rsPic("TitleFontType")=3 then
TitleStr="<b><em>" & TitleStr & "</em></b>"
end if
if rsPic("TitleFontColor")<>"" then
TitleStr="<font color='" & rsPic("TitleFontColor") & "'>" & TitleStr & "</font>"
end if
strPic=strPic & "<br>" & TitleStr & "</a></span><br><br>"
end sub
'=================================================
'过程名：ShowArticleContent
'作 用：显示文章具体的内容，可以分页显示
'参 数：无
'=================================================
sub ShowArticleContent()
if rs("ReadLevel")<=999 then
if UserLogined<>True then
FoundErr=True
ErrMsg=ErrMsg & "<br> 你还没注册？或者没有登录？这篇文章要求至少是本站的注册用户才能阅读！<br><br>"
ErrMsg=ErrMsg & " 如果你还没注册，请赶紧<a href='User_Reg.asp'><font color=red>点此注册</font></a>吧！<br><br>"
ErrMsg=ErrMsg & " 如果你已经注册但还没登录，请赶紧<a href='User_Login.asp'><font color=red>点此登录</font></a>吧！<br><br>"
else
if UserLevel>rs("ReadLevel") then
FoundErr=True
ErrMsg=ErrMsg & "<p align='center'><br><br><font color=red><b>对不起，你的权限不够，不能阅读此文章!</b></font></p>"
else
if ChargeType=1 and rs("ReadPoint")>0 then
if Request.Cookies("luyeweb")("Pay_Article" & ArticleID)<>"yes" then
if UserPoint<rs("ReadPoint") then
FoundErr=True
ErrMsg=ErrMsg &"<p align='center'><br><br>对不起，阅读本文需要消耗 <b><font color=red>" & rs("ReadPoint") & "</font></b> 点！"
ErrMsg=ErrMsg &"而你目前只有 <b><font color=blue>" & UserPoint & "</font></b> 点可用。点数不足，无法阅读本文。请与我们联系进行充值。</p>"
else
if lcase(trim(request("Pay")))="yes" then
Conn_User.execute "update " & db_User_Table & " set " & db_User_UserPoint & "=" & db_User_UserPoint & "-" & rs("ReadPoint") & " where " & db_User_Name & "='" & UserName & "'"
response.Cookies("luyeweb")("Pay_Article" & ArticleID)="yes"
else
FoundErr=True
ErrMsg=ErrMsg &"<p align='center'><br><br>阅读本文需要消耗 <b><font color=red>" & rs("ReadPoint") & "</font></b> 点！"
ErrMsg=ErrMsg &"你目前尚有 <b><font color=blue>" & UserPoint & "</font></b> 点可用。阅读本文后，你将剩下 <b><font color=green>" & UserPoint-rs("ReadPoint") & "</font></b> 点"
ErrMsg=ErrMsg &"<br><br>你确实愿意花费 <b><font color=red>" & rs("ReadPoint") & "</font></b> 点来阅读本文吗？"
ErrMsg=ErrMsg &"<br><br><a href='"& strFileName & "?Pay=yes&ArticleID=" & ArticleID & "'>我愿意</a> <a href='index.asp'>我不愿意</a></p>"
end if
end if
end if
elseif ChargeType=2 then
if ValidDays<=0 then
FoundErr=True
ErrMsg=ErrMsg & "<p align='center'><br><br><font color=red>对不起，本文为收费内容，而您的有效期已经过期，所以无法阅读本文。请与我们联系进行充值。</font></p>"
end if
end if
end if
end if
end if
if FoundErr=True then
ErrMsg="<p align=left><b>内容预览：</b><br><br>" & left(nohtml(rs("Content")),300) & "……</p>" & ErrMsg
response.write ErrMsg
exit sub
end if
dim PaginationType
PaginationType=rs("PaginationType")
select case PaginationType
case 0 '不分页显示
response.write rs("Content")
case 1 '自动分页显示
call AutoPagination()
case 2 '手动分页显示
call ManualPagination()
end select
end sub
'=================================================
'过程名：ManualPagination
'作 用：采用手动分页方式显示文章具体的内容
'参 数：无
'=================================================
sub ManualPagination()
dim ArticleID,strContent,CurrentPage
dim ContentLen,MaxPerPage,pages,i
dim arrContent
ArticleID=rs("ArticleID")
strContent=rs("Content")
ContentLen=len(strContent)
CurrentPage=trim(request("ArticlePage"))
if Instr(strContent,"[NextPage]")<=0 then
response.write strContent
response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
else
arrContent=split(strContent,"[NextPage]")
pages=Ubound(arrContent)+1
if CurrentPage="" then
CurrentPage=1
else
CurrentPage=Cint(CurrentPage)
end if
if CurrentPage<1 then CurrentPage=1
if CurrentPage>pages then CurrentPage=pages
response.write arrConten⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -