<%@language=vbscript codepage=936 %>
<%
option explicit
response.buffer=true
'强制浏览器重新访问服务器下载页面，而不是从缓存读取页面
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
%>
<%
dim strChannel,sqlChannel,rsChannel,ChannelUrl,ChannelName,UseCreateHTML,FileExt_Item,ChannelDir
dim ArticleID,ArticleTitle
dim FileName,strFileName,MaxPerPage,ShowSmallClassType
dim totalPut,CurrentPage,TotalPages
dim BeginTime,EndTime
dim founderr, errmsg
dim ClassID,SpecialID,keyword,strField,SpecialName
dim rs,sql,sqlArticle,rsArticle,sqlSearch,rsSearch,rsPic,sqlSpecial,rsSpecial,sqlUser,rsUser
dim tClass,ClassName,RootID,ParentID,Depth,ParentPath,Child,SkinID,LayoutID,LayoutFileName,ChildID,tID,tChild,ClassDir
dim tSpecial
dim strPic,AnnounceCount
dim PageTitle,strPath,strPathSplit,strPageTitle
dim strClassTree
UserLogined=CheckUserLogined()
BeginTime=Timer
ArticleID=trim(request("ArticleID"))
ClassID=trim(request("ClassID"))
SpecialID=trim(request("SpecialID"))
strField=trim(request("Field"))
keyword=trim(request("keyword"))
strPathSplit=" >> "
'UserLevel=request.Cookies("asp163")("UserLevel")
sub biemin()
dim SCRIPT_NAME
SCRIPT_NAME = Request.ServerVariables("SCRIPT_NAME")
if instrrev(SCRIPT_NAME,"/") > 0 then
SCRIPT_NAME=mid(SCRIPT_NAME,instrrev(SCRIPT_NAME,"/")+1)
end if
dim rs
Set rs= Server.CreateObject("ADODB.Recordset")
rs.open "select ClassID from ArticleClass where (Repetition+'.asp')='"&SCRIPT_NAME&"'",conn,1,3
if not rs.eof then
ClassID=rs("ClassID")
end if
rs.close
set rs = nothing
end sub
if ArticleId="" then
ArticleID=0
else
ArticleID=Clng(ArticleID)
end if
if ClassID<>"" then
ClassID=CLng(ClassID)
else
call biemin()
end if
if ClassID="" then
ClassID=0
end if
if SpecialID="" then
SpecialID=0
else
SpecialID=CLng(SpecialID)
end if
if UserLevel="" then
UserLevel=5000
else
UserLevel=Cint(UserLevel)
end if
strPath= " " & SiteName & ""
strPageTitle= SiteTitle
if ShowSiteChannel="Yes" then
strChannel= "| "
sqlChannel="select * from Channel order by OrderID"
set rsChannel=server.CreateObject("adodb.recordset")
rsChannel.open sqlChannel,conn,1,1
do while not rsChannel.eof
if rsChannel("ChannelID")=ChannelID then
ChannelUrl=rsChannel("LinkUrl")
ChannelName=rsChannel("ChannelName")
ChannelDir=rsChannel("ChannelDir")
strChannel=strChannel & "" & ChannelName & " | "
else
strChannel=strChannel & "" & rsChannel("ChannelName") & " | "
end if
rsChannel.movenext
loop
rsChannel.close
set rsChannel=nothing
if trim(ChannelName)<>"" then
strPath=strPath & strPathSplit & "" & ChannelName & ""
strPageTitle=strPageTitle & strPathSplit & ChannelName
end if
end if
if ArticleID>0 then
sql="select * from article where ArticleID=" & ArticleID & ""
Set rs= Server.CreateObject("ADODB.Recordset")
rs.open sql,conn,1,3
if rs.bof and rs.eof then
FoundErr=True
ErrMsg=ErrMsg & "
你要找的文章不存在，或者已经被管理员删除！
"
else
if rs("Passed")=False then
FoundErr=True
ErrMsg=ErrMsg & "
你要找的文章尚未被管理员审核！
"
else
ClassID=rs("ClassID")
SpecialID=rs("SpecialID")
SkinID=rs("SkinID")
LayoutID=rs("LayoutID")
ArticleTitle=rs("Title")
rs("Hits")=rs("Hits")+1
rs.update
if rs("hits")>=HitsOfHot then
rs("Hot")=True
rs.update
end if
end if
end if
end if
if FoundErr=True then
Call WriteErrMsg()
response.end
end if
if ClassID>0 then
sql="select C.ClassName,C.RootID,C.ParentID,C.Depth,C.ParentPath,C.Child,C.SkinID,L.LayoutID,L.LayoutFileName,C.BrowsePurview,C.ClassDir From ArticleClass C"
sql=sql & " inner join Layout L on C.LayoutID=L.LayoutID where C.ClassID=" & ClassID
set tClass=conn.execute(sql)
if tClass.bof and tClass.eof then
FoundErr=True
ErrMsg=ErrMsg & "
找不到指定的栏目
"
else
if tClass(9)
对不起，你没有浏览本栏目的权限！
"
ErrMsg=ErrMsg & "你不是" & CheckLevel(tClass(9)) & "！"
else
ClassName=tClass(0)
RootID=tClass(1)
ParentID=tClass(2)
Depth=tClass(3)
ParentPath=tClass(4)
Child=tClass(5)
if ArticleID<=0 then
SkinID=tClass(6)
LayoutID=tClass(7)
end if
LayoutFileName=tClass(8)
ClassDir=tClass(10)
strPath=strPath & strPathSplit
strPageTitle=strPageTitle & strPathSplit
if ParentID>0 then
dim sqlPath,rsPath
sqlPath="select ArticleClass.ClassID,ArticleClass.ClassName,Layout.LayoutFileName,Layout.LayoutID From ArticleClass"
sqlPath= sqlPath & " inner join Layout on ArticleClass.LayoutID=Layout.LayoutID where ArticleClass.ClassID in (" & ParentPath & ") order by ArticleClass.Depth"
set rsPath=server.createobject("adodb.recordset")
rsPath.open sqlPath,conn,1,1
do while not rsPath.eof
strPath=strPath & "" & rsPath(1) & "" & strPathSplit
strPageTitle=strPageTitle & rsPath(1) & strPathSplit
rsPath.movenext
loop
rsPath.close
set rsPath=nothing
end if
strPath=strPath & "" & ClassName & ""
strPageTitle=strPageTitle & ClassName
end if
end if
end if
if FoundErr=True then
Call WriteErrMsg()
response.end
end if
if SpecialID>0 then
sql="select S.SpecialID,S.SpecialName,S.SkinID,S.LayoutID,L.LayoutFileName,S.BrowsePurview from Special S inner join Layout L on L.LayoutID=S.LayoutID where S.SpecialID=" & SpecialID
set tSpecial=conn.execute(sql)
if tSpecial.bof and tSpecial.eof then
founderr=True
ErrMsg=ErrMsg & "
找不到指定的栏目
"
else
if tSpecial(5)
对不起，你没有浏览本专题的权限！
"
ErrMsg=ErrMsg & "你不是" & CheckLevel(tSpecial(5)) & "！"
else
SpecialName=tSpecial(1)
if ArticleID<=0 then
SkinID=tSpecial(2)
LayoutID=tSpecial(3)
end if
LayoutFilename=tSpecial(4)
strPath=strPath & strPathSplit & "[专题]" & SpecialName & ""
strPageTitle=strPageTitle & strPathSplit & "[专题]" & SpecialName
end if
end if
end if
if FoundErr=True then
Call WriteErrMsg()
response.end
end if
if keyword<>"" then
keyword=ReplaceBadChar(keyword)
end if
if request("page")<>"" then
currentPage=cint(request("page"))
else
currentPage=1
end if
'=================================================
'过程名：ShowRootClass
'作 用：显示一级栏目（无特殊效果）
'参 数：无
'=================================================
sub ShowRootClass()
dim sqlRoot,rsRoot
sqlRoot="select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,C.LinkUrl From ArticleClass C"
sqlRoot= sqlRoot & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=0 and C.ShowOnTop=True order by C.RootID"
Set rsRoot= Server.CreateObject("ADODB.Recordset")
rsRoot.open sqlRoot,conn,1,1
if rsRoot.bof and rsRoot.eof then
response.Write("还没有任何栏目，请首先添加栏目。")
else
if ClassID>0 then
response.write "| "&ChannelName&"首页 |"
else
response.write "| "&ChannelName&"首页 |"
end if
do while not rsRoot.eof
if rsRoot(4)<>"" then
response.write " " & rsRoot(1) & " |"
else
if rsRoot(2)=RootID then
response.Write " " & rsRoot(1) & " |"
else
response.Write " " & rsRoot(1) & " |"
end if
end if
rsRoot.movenext
loop
end if
rsRoot.close
set rsRoot=nothing
if ShowMyStyle="Yes" then
response.write " 自选风格 |"
end if
end sub
dim pNum,pNum2
pNum=1
pNum2=0
'=================================================
'过程名：ShowRootClass_Menu
'作 用：显示一级栏目（下拉菜单效果）
'参 数：无
'=================================================
sub ShowRootClass_Menu()
response.write "" & vbcrlf
end sub
sub GetClassMenu(ID,ShowType)
dim sqlClass,rsClass,k
if pNum=1 then
response.write "stm_bp('p" & pNum & "',[1,4,0,0,2,3,6,7,100,'progid:DXImageTransform.Microsoft.Fade(overlap=.5,enabled=0,Duration=0.43)',-2,'',-2,67,2,3,'#999999','#ffffff','',3,1,1,'#aca899']);" & vbcrlf
else
if ShowType=0 then
response.write "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,4,0,0,2,3,6]);" & vbcrlf
else
response.write "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbcrlf
end if
end if
k=0
sqlClass="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child,C.Readme From ArticleClass C"
sqlClass= sqlClass & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=" & ID & " order by C.OrderID asc"
Set rsClass= Server.CreateObject("ADODB.Recordset")
rsClass.open sqlClass,conn,1,1
do while not rsClass.eof
if rsClass(5)<>"" then
if rsClass(6)>0 then
response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(5) & "','_blank','" & rsClass(5) & "','" & rsClass(7) & "','','',6,0,0,'images/arrow_r.gif','images/arrow_w.gif',7,7,0,0,1,'#ffffff',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#000000','#000000','#ffffff','9pt 宋体']);" & vbcrlf
pNum=pNum+1
pNum2=pNum2+1
call GetClassMenu(rsClass(0),1)
else
response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(5) & "','_blank','" & rsClass(5) & "','" & rsClass(7) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
end if
else
if rsClass(6)>0 then
response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(3) & "?ClassID=" & rsClass(0) & "','_self','" & rsClass(3) & "?ClassID=" & rsClass(0) & "','" & rsClass(7) & "','','',6,0,0,'images/arrow_r.gif','images/arrow_w.gif',7,7,0,0,1,'#ffffff',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#000000','#000000','#ffffff','9pt 宋体']);" & vbcrlf
pNum=pNum+1
pNum2=pNum2+1
call GetClassMenu(rsClass(0),1)
else
response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(3) & "?ClassID=" & rsClass(0) & "','_self','" & rsClass(3) & "?ClassID=" & rsClass(0) & "','" & rsClass(7) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
end if
end if
k=k+1
rsClass.movenext
loop
rsClass.close
set rsClass=nothing
response.write "stm_ep();" & vbcrlf
end sub
'=================================================
'过程名：ShowJumpClass
'作 用：显示“跳转栏目到…”下拉列表框
'参 数：无
'=================================================
sub ShowJumpClass()
response.write ""
end sub
'=================================================
'过程名：ShowClass_Tree
'作 用：显示所有栏目（树形目录效果）
'参 数：无
'=================================================
sub ShowClass_Tree()
dim arrShowLine(20)
for i=0 to ubound(arrShowLine)
arrShowLine(i)=False
next
dim rsClass,sqlClass,tmpDepth,i
sqlClass="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child From ArticleClass C"
sqlClass= sqlClass & " inner join Layout L on C.LayoutID=L.LayoutID order by C.RootID,C.OrderID"
set rsClass=server.CreateObject("adodb.recordset")
rsClass.open sqlClass,conn,1,1
if rsClass.bof and rsClass.bof then
strClassTree="没有任何栏目"
else
strClassTree=""
do while not rsClass.eof
tmpDepth=rsClass(2)
if rsClass(4)>0 then
arrShowLine(tmpDepth)=True
else
arrShowLine(tmpDepth)=False
end if
if tmpDepth>0 then
for i=1 to tmpDepth
if i=tmpDepth then
if rsClass(4)>0 then
strClassTree=strClassTree & ""
else
strClassTree=strClassTree & ""
end if
else
if arrShowLine(i)=True then
strClassTree=strClassTree & ""
else
strClassTree=strClassTree & ""
end if
end if
next
end if
if rsClass(6)>0 then
strClassTree=strClassTree & ""
else
strClassTree=strClassTree & ""
end if
if rsClass(5)="" then
strClassTree=strClassTree & ""
else
strClassTree=strClassTree & ""
end if
if rsClass(2)=0 then
strClassTree=strClassTree & "" & rsClass(1) & ""
else
strClassTree=strClassTree & rsClass(1)
end if
'if rsClass(5)<>"" then
' strClassTree=strClassTree & "(外)"
'end if
strClassTree=strClassTree & ""
if rsClass(6)>0 then
strClassTree=strClassTree & "（" & rsClass(6) & "）"
end if
strClassTree=strClassTree & " "
rsClass.movenext
loop
end if
rsClass.close
set rsClass=nothing
response.write strClassTree
end sub
'=================================================
'过程名：ShowChildClass
'作 用：显示当前栏目的下一级子栏目
'=================================================
sub ShowChildClass()
dim sqlChild,rsChild,i,format,tempClassID
if Child = 0 and ParentID <> 0 then
tempClassID = ParentID
else
tempClassID = ClassID
end if
format = "
"
sqlChild="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child From ArticleClass C"
sqlChild= sqlChild & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=" & tempClassID & " order by C.OrderID"
Set rsChild= Server.CreateObject("ADODB.Recordset")
rsChild.open sqlChild,conn,1,1
if rsChild.bof and rsChild.eof then
'response.write "没有任何子栏目"
else
dim Childnum,temp
do while not rsChild.eof
if rsChild(6)>0 then
Childnum = "(" & rsChild(6) & ")"
end if
if rsChild(5)<>"" then
temp = replace(format,"{classurl}",InstallDir & rsChild(5))
else
temp = replace(format,"{classurl}",ClassFilePath(rsChild(0)))
end if
response.write replace(replace(temp,"{classname}",rsChild(1)),"{childnum}",Childnum)
rsChild.movenext
loop
end if
rsChild.close
set rsChild=nothing
end sub
'=================================================
'过程名：ShowClassNavigation
'作 用：显示栏目导航
'参 数：无
'=================================================
sub ShowClassNavigation()
dim rsNavigation,sqlNavigation,strNavigation,PrevRootID,i
sqlNavigation="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.RootID,C.LinkUrl,C.Child,C.Readme From ArticleClass C"
sqlNavigation= sqlNavigation & " inner join Layout L on C.LayoutID=L.LayoutID where C.Depth<=1 order by C.RootID,C.OrderID"
Set rsNavigation= Server.CreateObject("ADODB.Recordset")
rsNavigation.open sqlNavigation,conn,1,1
if rsNavigation.bof and rsNavigation.eof then
response.write "没有任何栏目"
else
strNavigation="
"
PrevRootID=rsNavigation(4)
rsNavigation.movenext
i=1
do while not rsNavigation.eof
if PrevRootID=rsNavigation(4) then
if i mod 6=0 then
strNavigation=strNavigation & " "
end if
strNavigation=strNavigation & "" & rsNavigation(1) & " "
i=i+1
else
strNavigation=strNavigation & "
"
i=1
end if
PrevRootID=rsNavigation(4)
rsNavigation.movenext
loop
strNavigation=strNavigation & "
"
response.write strNavigation
end if
rsNavigation.close
set rsNavigation=nothing
end sub
'=================================================
'过程名：ShowSpecial
'作 用：以竖向列表方式显示专题名称
'参 数：SpecialNum ------最多显示多少个专题名称
'=================================================
sub ShowSpecial(SpecialNum)
dim i
i=1
if SpecialNum<=0 or SpecialNum>100 then
SpecialNum=10
end if
sqlSpecial="select S.SpecialID,S.SpecialName,L.LayoutFileName from Special S inner join Layout L on L.LayoutID=S.LayoutID where S.BrowsePurview>=" & UserLevel & " order by S.OrderID"
Set rsSpecial= Server.CreateObject("ADODB.Recordset")
rsSpecial.open sqlSpecial,conn,1,1
totalPut=rsSpecial.recordcount
if rsSpecial.bof and rsSpecial.eof then
response.Write " 没有任何专题栏目"
else
rsSpecial.movefirst
do while not rsSpecial.eof
response.Write("
"
end if
end sub
'=================================================
'过程名：ShowAllSpecial
'作 用：分页显示所有专题
'参 数：无
'=================================================
sub ShowAllSpecial()
sqlSpecial="select S.SpecialID,S.SpecialName,L.LayoutFileName from Special S inner join Layout L on L.LayoutID=S.LayoutID where S.BrowsePurview>=" & UserLevel & " order by S.OrderID"
Set rsSpecial= Server.CreateObject("ADODB.Recordset")
rsSpecial.open sqlSpecial,conn,1,1
totalPut=rsSpecial.recordcount
if rsSpecial.bof and rsSpecial.eof then
response.Write " 没有任何专题栏目"
else
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 SpecialContent()
else
if (currentPage-1)*MaxPerPage" & rsSpecial(1) & " ")
rsSpecial.movenext
i=i+1
if i>=MaxPerPage then exit do
loop
end sub
'=================================================
'过程名：ShowSiteCount
'作 用：显示站点统计信息
'参 数：无
'=================================================
sub ShowSiteCount()
dim sqlCount,rsCount
Set rsCount= Server.CreateObject("ADODB.Recordset")
sqlCount="select count(ArticleID) from Article where Deleted=False"
rsCount.open sqlCount,conn,1,1
response.write "文章总数：" & rsCount(0) & "篇 "
rsCount.close
sqlCount="select count(ArticleID) from Article where Passed=False and Deleted=False"
rsCount.open sqlCount,conn,1,1
response.write "待审文章：" & rsCount(0) & "篇 "
rsCount.close
sqlCount="select count(CommentID) from ArticleComment"
rsCount.open sqlCount,conn,1,1
response.write "评论总数：" & rsCount(0) & "条 "
rsCount.close
sqlCount="select count(SpecialID) from Special"
rsCount.open sqlCount,conn,1,1
response.write "专题总数：" & rsCount(0) & "个 "
rsCount.close
sqlCount="select sum(Hits) from article"
rsCount.open sqlCount,conn,1,1
response.write "文章阅读：" & rsCount(0) & "人次 "
rsCount.close
set rsCount=nothing
end sub
'=================================================
'过程名：ShowArticle
'作 用：分页显示文章标题等信息
'参 数：TitleLen ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowArticle(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 "
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("
没有任何文章
")
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 "
elseif rsArticle("Elite")=true then
strTemp = strTemp & " "
else
strTemp = strTemp & " "
end if
end if
if ShowIncludePic=True and rsArticle("IncludePic")=true then
strTemp = strTemp & "[图文]"
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 & ""
TitleStr=gotTopic(rsArticle("title"),intTitleLen)
if rsArticle("TitleFontType")=1 then
TitleStr="" & TitleStr & ""
elseif rsArticle("TitleFontType")=2 then
TitleStr="" & TitleStr & ""
elseif rsArticle("TitleFontType")=3 then
TitleStr="" & TitleStr & ""
end if
if rsArticle("TitleFontColor")<>"" then
TitleStr="" & TitleStr & ""
end if
strTemp=strTemp & TitleStr & ""
if ShowAuthor=True or ShowDateType>0 or ShowHits=True then
strTemp = strTemp & " ("
if ShowAuthor=True then
if AuthorEmail="" then
strTemp=strTemp & AuthorName
else
strTemp=strTemp & "" & AuthorName & ""
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 & ""
else
strTemp= strTemp & ""
end if
if ShowDateType=1 then
strTemp= strTemp & month(rsArticle("UpdateTime")) & "月" & day(rsArticle("UpdateTime")) & "日"
else
strTemp=strTemp & FormatDateTime(rsArticle("UpdateTime"),1) & ""
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
if ShowHot=True and rsArticle("Hits")>=HitsOfHot then
strTemp= strTemp & ""
end if
strTemp= strTemp & " "
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("
没有任何文章
")
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)*MaxPerPage0 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 "
没有或没有找到任何文章
"
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"
if strField="Title" then
strTemp=strTemp & "" & replace(rsSearch("title"),""&keyword&"",""&keyword&"") & ""
else
strTemp=strTemp & "" & rsSearch("title") & ""
end if
if strField="Author" then
strTemp=strTemp & " [" & replace(rsSearch("Author"),""&keyword&"",""&keyword&"") & "]"
else
strTemp=strTemp & " [" & rsSearch("Author") & "]"
end if
strTemp=strTemp & "[" & FormatDateTime(rsSearch("UpdateTime"),1) & "][" & rsSearch("Hits") & "]"
content=left(replace(replace(nohtml(rsSearch("content")), ">", ">"), "<", "<"),200)
if strField="Content" then
strTemp=strTemp & "
"
end if
strTemp=strTemp & ""
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 "
"
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 "
"
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 "
"
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 "没有相关文章"
else
do while not rsCorrelative.eof
response.write "
"
rsCorrelative.movenext
loop
end if
rsCorrelative.close
set rsCorrelative=nothing
end sub
'=================================================
'过程名：ShowComment
'作 用：显示相关评论
'参 数：CommentNum ----最多显示多少个评论
'=================================================
sub ShowComment(CommentNum)
dim rsComment,sqlComment,rsCommentUser
if CommentNum>0 and CommentNum<=100 then
sqlComment="select top " & CommentNum
else
sqlComment="select top 10 "
end if
sqlComment=sqlComment & " * from ArticleComment where ArticleID=" & ArticleID & " order by CommentID desc"
Set rsComment= Server.CreateObject("ADODB.Recordset")
rsComment.open sqlComment,conn,1,1
if rsComment.bof and rsComment.eof then
response.write " 没有任何评论"
else
response.write "
"
do while not rsComment.eof
response.write "
"
if rsComment("UserType")=1 then
response.write "
会员"
set rsCommentUser=Conn_User.execute("select " & db_User_ID & "," & db_User_Name & "," & db_User_Email & "," & db_User_QQ & "," & db_User_Homepage & " from " & db_User_Table & " where " & db_User_Name & "='" & rsComment("UserName") & "'")
if rsCommentUser.bof and rsCommentUser.eof then
response.write rsComment("UserName")
else
response.write "『" & rsComment("UserName") & "』"
end if
else
response.write "
游客『" & rsComment("UserName") & "』"
end if
response.write "于" & rsComment("WriteTime") & "发表评论：
"
response.write "
评分："&rsComment("Score")&"分
"
response.write "
"
response.write " " & rsComment("Content") & " "
if rsComment("ReplyContent")<>"" then
response.write " ★ 管理员『" & rsComment("ReplyName") & "』于 " & rsComment("ReplyTime") & " 回复道： " & rsComment("ReplyContent") & " "
end if
response.write "
"
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 "" & gotTopic(rsPrev("Title"),TitleLen) & ""
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 "" & gotTopic(rsNext("Title"),TitleLen) & ""
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= "
"
if rsPic.bof and rsPic.eof then
strPic= strPic & "
没有任何图片文章
"
else
i=0
if ShowType=1 then
do while not rsPic.eof
strPic=strPic & "
"
end if
end if
end if
elseif ChargeType=2 then
if ValidDays<=0 then
FoundErr=True
ErrMsg=ErrMsg & "
对不起，本文为收费内容，而您的有效期已经过期，所以无法阅读本文。请与我们联系进行充值。
"
end if
end if
end if
end if
end if
if FoundErr=True then
ErrMsg="
内容预览：
" & left(nohtml(rs("Content")),300) & "……
" & 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 "
[1]
"
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 "
"
if CurrentPage>1 then
response.write "上一页 "
end if
for i=1 to pages
if i=CurrentPage then
response.write "[" & cstr(i) & "] "
else
response.write "[" & i & "] "
end if
next
if CurrentPage下一页"
end if
response.write "
"
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 "
[1]
"
else
if CurrentPage="" then
CurrentPage=1
else
CurrentPage=Cint(CurrentPage)
end if
pages=ContentLen\rs("MaxCharPerPage")
if rs("MaxCharPerPage")*pagespages 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,"",1)
lngTemp1_1_2=instr(BeginPoint,strContent,"",1)
lngTemp1_1_3=instr(BeginPoint,strContent,"",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,"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,"",1)
lngTemp2_1_2=instr(BeginPoint,strContent,"",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,"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,"",1)
lngTemp3_1_2=instr(BeginPoint,strContent,"",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,"0 then
lngTemp3_2=lngTemp3_2_1
elseif lngTemp3_2_2>0 then
lngTemp3_2=lngTemp3_2_2
else
lngTemp3_2=0
end if
if lngTemp3_1=0 and lngTemp3_2=0 then
lngTemp3=BeginPoint
else
if lngTemp3_1>lngTemp3_2 then
lngtemp3=lngTemp3_2
else
lngTemp3=lngTemp3_1+5
end if
end if
if lngTemp1BeginPoint and lngTemp<=BeginPoint+lngBound then
BeginPoint=lngTemp
else
lngTemp4_1_1=instr(BeginPoint,strContent,"",1)
lngTemp4_1_2=instr(BeginPoint,strContent,"",1)
if lngTemp4_1_1>0 then
lngTemp4_1=lngTemp4_1_1
elseif lngTemp4_1_2>0 then
lngTemp4_1=lngTemp4_1_2
else
lngTemp4_1=0
end if
lngTemp4_2_1=instr(BeginPoint,strContent,"0 then
lngTemp4_2=lngTemp4_2_1
elseif lngTemp4_2_2>0 then
lngTemp4_2=lngTemp4_2_2
else
lngTemp4_2=0
end if
if lngTemp4_1=0 and lngTemp4_2=0 then
lngTemp4=BeginPoint
else
if lngTemp4_1>lngTemp4_2 then
lngtemp4=lngTemp4_2
else
lngTemp4=lngTemp4_1+5
end if
end if
if lngTemp4>BeginPoint and lngTemp4<=BeginPoint+lngBound then
BeginPoint=lngTemp4
else
lngTemp5_1=instr(BeginPoint,strContent,"0 then
lngTemp5=lngTemp5_1
elseif lngTemp5_2>0 then
lngTemp5=lngTemp5_2
else
lngTemp5=BeginPoint
end if
if lngTemp5>BeginPoint and lngTemp5",1)
lngTemp6_2=instr(BeginPoint,strContent," ",1)
if lngTemp6_1>0 then
lngTemp6=lngTemp6_1
elseif lngTemp6_2>0 then
lngTemp6=lngTemp6_2
else
lngTemp6=0
end if
if lngTemp6>BeginPoint and lngTemp6=ContentLen then
EndPoint=ContentLen
else
lngTemp1_1_1=instr(EndPoint,strContent,"",1)
lngTemp1_1_2=instr(EndPoint,strContent,"",1)
lngTemp1_1_3=instr(EndPoint,strContent,"",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(EndPoint,strContent,"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=EndPoint
else
if lngTemp1_1>lngTemp1_2 then
lngtemp1=lngTemp1_2-1
else
lngTemp1=lngTemp1_1+7
end if
end if
lngTemp2_1_1=instr(EndPoint,strContent,"",1)
lngTemp2_1_2=instr(EndPoint,strContent,"",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(EndPoint,strContent,"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=EndPoint
else
if lngTemp2_1>lngTemp2_2 then
lngTemp2=lngTemp2_2-1
else
lngTemp2=lngTemp2_1+3
end if
end if
lngTemp3_1_1=instr(EndPoint,strContent,"",1)
lngTemp3_1_2=instr(EndPoint,strContent,"",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(EndPoint,strContent,"0 then
lngTemp3_2=lngTemp3_2_1
elseif lngTemp3_2_2>0 then
lngTemp3_2=lngTemp3_2_2
else
lngTemp3_2=0
end if
if lngTemp3_1=0 and lngTemp3_2=0 then
lngTemp3=EndPoint
else
if lngTemp3_1>lngTemp3_2 then
lngtemp3=lngTemp3_2-1
else
lngTemp3=lngTemp3_1+4
end if
end if
if lngTemp1EndPoint and lngTemp<=EndPoint+lngBound then
EndPoint=lngTemp
else
lngTemp4_1_1=instr(EndPoint,strContent,"",1)
lngTemp4_1_2=instr(EndPoint,strContent,"",1)
if lngTemp4_1_1>0 then
lngTemp4_1=lngTemp4_1_1
elseif lngTemp4_1_2>0 then
lngTemp4_1=lngTemp4_1_2
else
lngTemp4_1=0
end if
lngTemp4_2_1=instr(EndPoint,strContent,"0 then
lngTemp4_2=lngTemp4_2_1
elseif lngTemp4_2_2>0 then
lngTemp4_2=lngTemp4_2_2
else
lngTemp4_2=0
end if
if lngTemp4_1=0 and lngTemp4_2=0 then
lngTemp4=EndPoint
else
if lngTemp4_1>lngTemp4_2 then
lngtemp4=lngTemp4_2-1
else
lngTemp4=lngTemp4_1+4
end if
end if
if lngTemp4>EndPoint and lngTemp4<=EndPoint+lngBound then
EndPoint=lngTemp4
else
lngTemp5_1=instr(EndPoint,strContent,"0 then
lngTemp5=lngTemp5_1-1
elseif lngTemp5_2>0 then
lngTemp5=lngTemp5_2-1
else
lngTemp5=EndPoint
end if
if lngTemp5>EndPoint and lngTemp5",1)
lngTemp6_2=instr(EndPoint,strContent," ",1)
if lngTemp6_1>0 then
lngTemp6=lngTemp6_1+3
elseif lngTemp6_2>0 then
lngTemp6=lngTemp6_2+3
else
lngTemp6=EndPoint
end if
if lngTemp6>EndPoint and lngTemp6
"
if CurrentPage>1 then
response.write "上一页 "
end if
for i=1 to pages
if i=CurrentPage then
response.write "[" & cstr(i) & "] "
else
response.write "[" & i & "] "
end if
next
if CurrentPage下一页"
end if
response.write "
"
end if
end sub
'=================================================
'过程名：ShowArticleContent
'作 用：显示文章具体信息
'参 数：无
'=================================================
sub ShowArticleInfo()
response.write "［"
dim Author,CopyFrom
Author=rs("Author")
CopyFrom=rs("CopyFrom")
response.write "作者："
if instr(Author,"|")>0 then
response.write "" & left(Author,instr(Author,"|")-1) & ""
else
response.write Author
end if
if false then'if CopyFrom <> "本站原创" and CopyFrom <> "" then
response.write " 转贴自："
if instr(CopyFrom,"|")>0 then
response.write "" & left(CopyFrom,instr(CopyFrom,"|")-1) & ""
else
response.write CopyFrom
end if
end if
'response.write " 点击数：" & rs("Hits")
response.write " 更新时间：" & FormatDateTime(rs("UpdateTime"),2)' & " 文章录入："
'set tUser=Conn_User.execute("select " & db_User_ID & " from " & db_User_Table & " where " & db_User_Name & "='" & rs("Editor") & "'")
'if tUser.bof and tUser.eof then
' response.write rs("Editor")
'else
' response.write "" & rs("Editor") & ""
'end if
response.write "］"
end sub
%>
"
else
strClassTree=strClassTree & "
"
end if
else
if arrShowLine(i)=True then
strClassTree=strClassTree & "
"
else
strClassTree=strClassTree & "
"
end if
end if
next
end if
if rsClass(6)>0 then
strClassTree=strClassTree & "
"
else
strClassTree=strClassTree & "
"
end if
if rsClass(5)="" then
strClassTree=strClassTree & ""
else
strClassTree=strClassTree & ""
end if
if rsClass(2)=0 then
strClassTree=strClassTree & "" & rsClass(1) & ""
else
strClassTree=strClassTree & rsClass(1)
end if
'if rsClass(5)<>"" then
' strClassTree=strClassTree & "(外)"
'end if
strClassTree=strClassTree & ""
if rsClass(6)>0 then
strClassTree=strClassTree & "（" & rsClass(6) & "）"
end if
strClassTree=strClassTree & "
"
else
strTemp = strTemp & "
"
end if
end if
if ShowIncludePic=True and rsArticle("IncludePic")=true then
strTemp = strTemp & "[图文]"
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 & ""
TitleStr=gotTopic(rsArticle("title"),intTitleLen)
if rsArticle("TitleFontType")=1 then
TitleStr="" & TitleStr & ""
elseif rsArticle("TitleFontType")=2 then
TitleStr="" & TitleStr & ""
elseif rsArticle("TitleFontType")=3 then
TitleStr="" & TitleStr & ""
end if
if rsArticle("TitleFontColor")<>"" then
TitleStr="" & TitleStr & ""
end if
strTemp=strTemp & TitleStr & ""
if ShowAuthor=True or ShowDateType>0 or ShowHits=True then
strTemp = strTemp & " ("
if ShowAuthor=True then
if AuthorEmail="" then
strTemp=strTemp & AuthorName
else
strTemp=strTemp & "" & AuthorName & ""
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 & ""
else
strTemp= strTemp & ""
end if
if ShowDateType=1 then
strTemp= strTemp & month(rsArticle("UpdateTime")) & "月" & day(rsArticle("UpdateTime")) & "日"
else
strTemp=strTemp & FormatDateTime(rsArticle("UpdateTime"),1) & ""
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
if ShowHot=True and rsArticle("Hits")>=HitsOfHot then
strTemp= strTemp & "
"
end if
strTemp= strTemp & "
"
end if
if rsPic("TitleFontType")=1 then
TitleStr="" & TitleStr & ""
elseif rsPic("TitleFontType")=2 then
TitleStr="" & TitleStr & ""
elseif rsPic("TitleFontType")=3 then
TitleStr="" & TitleStr & ""
end if
if rsPic("TitleFontColor")<>"" then
TitleStr="" & TitleStr & ""
end if
strPic=strPic & "