📄 syscode.asp
字号:
strTemp=strTemp & "├ "
else
strTemp=strTemp & "└ "
end if
else
if arrShowLine(i)=True then
strTemp=strTemp & "│"
else
strTemp=strTemp & " "
end if
end if
next
end if
strTemp=strTemp & rsClass(1)
if rsClass(5)<>"" then
strTemp=strTemp & "(外)"
end if
strTemp=strTemp & "</option>"
response.write strTemp
rsClass.movenext
loop
end if
rsClass.close
set rsClass=nothing
response.write "</select></div>"
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,strClassTree
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 & "<img src='images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
else
strClassTree=strClassTree & "<img src='images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
end if
else
if arrShowLine(i)=True then
strClassTree=strClassTree & "<img src='images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
else
strClassTree=strClassTree & "<img src='images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
end if
end if
next
end if
if rsClass(6)>0 then
strClassTree=strClassTree & "<img src='Images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>"
else
strClassTree=strClassTree & "<img src='Images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>"
end if
if rsClass(5)="" then
if style<>"1" then
strClassTree=strClassTree & "<a href='" & rsClass(3) & "?ClassID=" & rsClass(0) & "'>"
else
strClassTree=strClassTree & "<a href='" & rsClass(3) & "?ClassID=" & rsClass(0) & "' target='_blank'>"
end if
else
strClassTree=strClassTree & "<a href='" & rsClass(5) & "' target='_blank'>"
end if
if rsClass(2)=0 then
strClassTree=strClassTree & "<b>" & rsClass(1) & "</b>"
else
strClassTree=strClassTree & rsClass(1)
end if
'if rsClass(5)<>"" then
' strClassTree=strClassTree & "(外)"
'end if
strClassTree=strClassTree & "</a>"
if rsClass(6)>0 then
strClassTree=strClassTree & "（" & rsClass(6) & "）"
end if
strClassTree=strClassTree & "<br>"
rsClass.movenext
loop
end if
rsClass.close
set rsClass=nothing
response.write strClassTree
end sub
'=================================================
'过程名：ShowClass_Tree2
'作 用：显示所有栏目（树形目录效果）
'参 数：无
'=================================================
sub ShowClass_Tree2()
dim path1,path2,path3,path4,sqlArticle3,rsArticle3
dim arrShowLine(20)
for i=0 to ubound(arrShowLine)
arrShowLine(i)=False
next
dim rsClass1,sqlClass1,tmpDepth1,i1,strClassTree1,Cid,Cid1,C_sql,sqlClass10,rsClass10
sqlClass1="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.RootID,C.Child,C.ParentID,C.ParentPath,C.ParentPath From ArticleClass C"
sqlClass1= sqlClass1 & " inner join Layout L on C.LayoutID=L.LayoutID where C.ClassID="&ClassID&" order by C.RootID,C.OrderID"
set rsClass1=server.CreateObject("adodb.recordset")
rsClass1.open sqlClass1,conn,1,1
path1=split(rsClass1("ParentPath"),",")
path2=Lbound(path1)
path3=(path1(path2))
if (path1(path2))=0 then
path3=ClassName
else
sqlClass10="select ClassID,ClassName From ArticleClass where ClassID="&path3&""
set rsClass10=server.CreateObject("adodb.recordset")
rsClass10.open sqlClass10,conn,1,1
path3=rsClass10("ClassName")
path4=rsClass10("ClassID")
end if
'response.write "<tr><td valign=top>"' class=title_left
'response.write "<table width='100%' border=0 cellspacing=0 cellpadding=0 class=title_left>"
'response.write "<tr><td class=title_lefttxt align=center><img border=0 src=Images/tb01.gif width=26 height=22> <span style='letter-spacing: 10px'><a href=# title="&path3&"><b><font size=3>"&left(path3,7)&"</font></b></a></span></td></tr></table>"
'response.write "</td><tr class='tdbg_left'><td height='100' valign='top'><table width='100%' height='100%' cellpadding='0' cellspacing='5'><tr><td valign='top'>"
response.write "<table border=0 width='100%'>"&vbcrlf
if not rsClass1.eof then
Cid=rsClass1("ParentID")
if rsClass1("ParentID")=0 then
C_sql=" C.ParentID="&ClassID
else '取相关的ID
sqlClass1="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.RootID,C.Child,C.ParentID,C.ParentPath From ArticleClass C"
sqlClass1= sqlClass1 & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID="&Cid&" order by C.RootID,C.OrderID"
set rsClass1=server.CreateObject("adodb.recordset")
rsClass1.open sqlClass1,conn,1,1
if not rsClass1.eof then
Cid1=Cid1&rsClass1("ParentPath")
'end if
p1=split(Cid1,",")
p2=UBound(p1)
for i=0 to p2
if p1(i)<>"" then
C_sql=C_sql & " C.ParentID="& p1(i) & " or "
end if
next
C_sql=C_sql & " C.ParentID="&Classid
end if
end if
end if
sqlClass="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child,C.LinkUrl From ArticleClass C"
sqlClass= sqlClass & " inner join Layout L on C.LayoutID=L.LayoutID where 1=1 and "&C_sql&" 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="<tr><td height=8>"&vbcrlf' onMouseOver=""this.className='Menu_TitleClassName';"" onMouseOut=""this.className='';""
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 & "<img src='images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
else
strClassTree=strClassTree & "<img src='images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
end if
else
if arrShowLine(i)=True then
strClassTree=strClassTree & "<img src='images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
else
strClassTree=strClassTree & "<img src='images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
end if
end if
next
end if
sqlArticle3="select ArticleID,ClassID From Article where ClassID="&rsClass(0)&" and Deleted=false"
set rsArticle3=server.CreateObject("adodb.recordset")
rsArticle3.open sqlArticle3,conn,1,3
'response.write sqlArticle3
'or rsClass("LinkUrl")<>""
'if not rsArticle3.eof then
'response.write "<font color=#ff0000>"
dim rsClassID
rsClassID = rsClass(0)
if rsClass(5)="" then
strClassTree=strClassTree & "<a class='Html_informa_left' href='" & rsClass(3) & "?ClassID=" & rsClassID & "'>"
else
strClassTree=strClassTree & "<a class='Html_informa_left' href='" & rsClass(5) & "'>"
end if
'else
' response.write "<font color=#CCCCCC>"
'end if
if rsClass(6)>0 then
strClassTree=strClassTree & "<img src='Images/tree_folder4.gif' width='15' height='15' valign='abvmiddle' border=0>"
else
strClassTree=strClassTree & "<img src='Images/tree_folder3.gif' width='15' height='15' valign='abvmiddle' border=0>"
end if
if rsClass(2)=0 then
strClassTree=strClassTree & "<b>" & left(rsClass(1),8) & "</b>"
else
if ClassID=rsClass("Classid") then
strClassTree=strClassTree & "<font color=red>" & left(rsClass(1),8) & "</font>"
else
strClassTree=strClassTree & "" & left(rsClass(1),8) & ""'<font color=#000000></font>
end if
end if
''or rsClass("LinkUrl")<>""
'if not rsArticle3.eof then
strClassTree=strClassTree & "</a>"
'end if
'response.write "</font>"
strClassTree=strClassTree & "</td></tr>"&vbcrlf&"<tr><td height=8>"&vbcrlf'<br> onMouseOver=""this.className='Menu_TitleClassName';"" onMouseOut=""this.className='';""
rsClass.movenext
loop
rsClass.close
set rsClass=nothing
response.write strClassTree
end if
rsClass1.close
set rsClass1=nothing
response.write "</td></tr></table>"&vbcrlf
'response.write "</td></tr></table>"
'response.write "</td></tr>"
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("<li><a href='" & rsSpecial(2) & "?SpecialID=" & rsSpecial(0) & "'>" & rsSpecial(1) & "</a></li><br>")
rsSpecial.movenext
i=i+1
if i>SpecialNum then exit do
loop
end if
if not rsSpecial.eof then
response.write "<p align='right'><a href='Special.asp'>更多专题</a></p>"
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<totalPut then
rsSpecial.move (currentPage-1)*MaxPerPage
dim bookmark
bookmark=rsSpecial.bookmark
call SpecialContent()
else
currentPage=1
call SpecialContent()
end if
end if
end if
end sub
sub SpecialContent()
dim i
i=1
do while not rsSpecial.eof
response.Write("<li><a href='" & rsSpecial(2) & "?SpecialID=" & rsSpecial(0) & "'>" & rsSpecial(1) & "</a></li><br>")
rsSpecial.movenext
i=i+1
if i>=MaxPerPage then exit do
loop
end sub
'=================================================
'过程名：ShowArticle
'作 用：分页显示文章标题等信息
'参 数：TitleLen ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowArticle(TitleLen)
if TitleLen<0 or TitleLen>200 then
TitleLen=30
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.UpdateTime desc"
Set rsArticle= Server.CreateObject("ADODB.Recordset")
rsArticle.open sqlArticle,conn,1,1
if rsArticle.bof and rsArticle.eof then
totalput=0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -