📄 syscode_article.asp
字号:
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='5' 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' algin='center' class='left'><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 & "<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>"
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("asp163")("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("asp163")("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 arrContent(CurrentPage-1)
response.write "</p><p align='center'><b>"
if CurrentPage>1 then
response.write "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & CurrentPage-1 & "'>上一页</a> "
end if
for i=1 to pages
if i=CurrentPage then
response.write "<font color='red'>[" & cstr(i) & "]</font> "
else
response.write "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & i & "'>[" & i & "]</a> "
end if
next
if CurrentPage<pages then
response.write " <a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & CurrentPage+1 & "'>下一页</a>"
end if
response.write "</b></p>"
end if
end sub
'=================================================
'过程名：AutoPagination
'作 用：采用自动分页方式显示文章具体的内容
'参 数：无
'=================================================
sub AutoPagination()
dim ArticleID,strContent,CurrentPage
dim ContentLen,MaxPerPage,pages,i,lngBound
dim BeginPoint,EndPoint
ArticleID=rs("ArticleID")
strContent=rs("Content")
ContentLen=len(strContent)
CurrentPage=trim(request("ArticlePage"))
if ContentLen<=rs("MaxCharPerPage") then
response.write strContent
response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
else
if CurrentPage="" then
CurrentPage=1
else
CurrentPage=Cint(CurrentPage)
end if
pages=ContentLen\rs("MaxCharPerPage")
if rs("MaxCharPerPage")*pages<ContentLen then
pages=pages+1
end if
lngBound=ContentLen '最大误差范围
if CurrentPage<1 then CurrentPage=1
if CurrentPage>pages then CurrentPage=pages
dim lngTemp
dim lngTemp1,lngTemp1_1,lngTemp1_2,lngTemp1_1_1,lngTemp1_1_2,lngTemp1_1_3,lngTemp1_2_1,lngTemp1_2_2,lngTemp1_2_3
dim lngTemp2,lngTemp2_1,lngTemp2_2,lngTemp2_1_1,lngTemp2_1_2,lngTemp2_2_1,lngTemp2_2_2
dim lngTemp3,lngTemp3_1,lngTemp3_2,lngTemp3_1_1,lngTemp3_1_2,lngTemp3_2_1,lngTemp3_2_2
dim lngTemp4,lngTemp4_1,lngTemp4_2,lngTemp4_1_1,lngTemp4_1_2,lngTemp4_2_1,lngTemp4_2_2
dim lngTemp5,lngTemp5_1,lngTemp5_2
dim lngTemp6,lngTemp6_1,lngTemp6_2
if CurrentPage=1 then
BeginPoint=1
else
BeginPoint=rs("MaxCharPerPage")*(CurrentPage-1)+1
lngTemp1_1_1=instr(BeginPoint,strContent,"</table>",1)
lngTemp1_1_2=instr(BeginPoint,strContent,"</TABLE>",1)
lngTemp1_1_3=instr(BeginPoint,strContent,"</Table>",1)
if lngTemp1_1_1>0 then
lngTemp1_1=lngTemp1_1_1
elseif lngTemp1_1_2>0 then
lngTemp1_1=lngTemp1_1_2
elseif lngTemp1_1_3>0 then
lngTemp1_1=lngTemp1_1_3
else
lngTemp1_1=0
end if
lngTemp1_2_1=instr(BeginPoint,strContent,"<table",1)
lngTemp1_2_2=instr(BeginPoint,strContent,"<TABLE",1)
lngTemp1_2_3=instr(BeginPoint,strContent,"<Table",1)
if lngTemp1_2_1>0 then
lngTemp1_2=lngTemp1_2_1
elseif lngTemp1_2_2>0 then
lngTemp1_2=lngTemp1_2_2
elseif lngTemp1_2_3>0 then
lngTemp1_2=lngTemp1_2_3
else
lngTemp1_2=0
end if
if lngTemp1_1=0 and lngTemp1_2=0 then
lngTemp1=BeginPoint
else
if lngTemp1_1>lngTemp1_2 then
lngtemp1=lngTemp1_2
else
lngTemp1=lngTemp1_1+8
end if
end if
lngTemp2_1_1=instr(BeginPoint,strContent,"</p>",1)
lngTemp2_1_2=instr(BeginPoint,strContent,"</P>",1)
if lngTemp2_1_1>0 then
lngTemp2_1=lngTemp2_1_1
elseif lngTemp2_1_2>0 then
lngTemp2_1=lngTemp2_1_2
else
lngTemp2_1=0
end if
lngTemp2_2_1=instr(BeginPoint,strContent,"<p",1)
lngTemp2_2_2=instr(BeginPoint,strContent,"<P",1)
if lngTemp2_2_1>0 then
lngTemp2_2=lngTemp2_2_1
elseif lngTemp2_2_2>0 then
lngTemp2_2=lngTemp2_2_2
else
lngTemp2_2=0
end if
if lngTemp2_1=0 and lngTemp2_2=0 then
lngTemp2=BeginPoint
else
if lngTemp2_1>lngTemp2_2 then
lngtemp2=lngTemp2_2
else
lngTemp2=lngTemp2_1+4
end if
end if
lngTemp3_1_1=instr(BeginPoint,strContent,"</ur>",1)
lngTemp3_1_2=instr(BeginPoint,strContent,"</UR>",1)
if lngTemp3_1_1>0 then
lngTemp3_1=lngTemp3_1_1
elseif lngTemp3_1_2>0 then
lngTemp3_1=lngTemp3_1_2
else
lngTemp3_1=0
end if
lngTemp3_2_1=instr(BeginPoint,strContent,"<ur",1)
lngTemp3_2_2=instr(BeginPoint,strContent,"<UR",1)
if lngTemp3_2_1>0 then
lngTemp3_2=lngTemp3_2_1
elseif⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -