📄 function.asp
字号:
value = value & "stm_aix('p0i1','p0i0',[0,'首 页','','',-1,-1,0,'" & ChannelUrl & "','_self','" & ChannelUrl & "','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbcrlf
value = value & "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
dim sql,rs,j,classfliename
if ChannelID=1 or ChannelID=2 then
sql="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From ArticleClass where Depth=0 and ShowOnTop=True order by RootID"
classfliename="Article_Class.ASP"
elseif ChannelID=3 then
sql="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From SoftClass where Depth=0 and ShowOnTop=True order by RootID"
classfliename="Soft_Class.asp"
elseif ChannelID=4 then
sql="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From PhotoClass where Depth=0 and ShowOnTop=True order by RootID"
classfliename="Photo_Class.asp"
end if
Set rs= Execute(sql)
if not(rs.bof and rs.eof) then
j=3
do while not rs.eof
if (j-3) mod 5=0 and j<>3 then
value = value & "stm_em();" & vbcrlf
value = value & "//-->" & vbcrlf & "</script>" & vbcrlf
value = value & "<script type='text/javascript' language='JavaScript1.2'>" & vbcrlf & "<!--" & vbcrlf
value = value & "stm_bm(['uueoehr',400,'','images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
value = value & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
value = value & "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
end if
if rs(4)<>"" then
value = value & "stm_aix('p0i"&j&"','p0i0',[0,'" & rs(1) & "','','',-1,-1,0,'" & rs(4) & "','_blank','" & rs(4) & "','" & rs(6) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbcrlf
else
value = value & "stm_aix('p0i"&j&"','p0i0',[0,'" & rs(1) & "','','',-1,-1,0,'" & classfliename & "?ClassID=" & rs(0) & "','_self','" & classfliename & "?ClassID=" & rs(0) & "','" & rs(6) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbcrlf
end if
if rs(5)>0 then
call GetClassMenu(rs(0),0)
end if
j=j+1
value = value & "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
j=j+1
rs.movenext
loop
end if
rs.close
set rs=nothing
value = value & "stm_em();" & vbcrlf
value = value & "//-->" & vbcrlf & "</script>" & vbcrlf
else
value = ""
end if
end sub
Public Sub GetClassMenu(ID,ShowType)
dim sql,rs,k,classfliename
if pNum=1 then
value = value & "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
value = value & "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,4,0,0,2,3,6]);" & vbcrlf
else
value = value & "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbcrlf
end if
end if
k=0
if ChannelID=1 or ChannelID=2 then
sql="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From ArticleClass where ParentID=" & ID & " order by OrderID asc"
classfliename="Article_Class.ASP"
elseif ChannelID=3 then
sql="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From SoftClass where ParentID=" & ID & " order by OrderID asc"
classfliename="Soft_Class.asp"
elseif ChannelID=4 then
sql="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From PhotoClass where ParentID=" & ID & " order by OrderID asc"
classfliename="Photo_Class.asp"
end if
Set rs = Execute(sql)
do while not rs.eof
if rs(4)<>"" then
if rs(5)>0 then
value = value & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rs(1) & "','','',-1,-1,0,'" & rs(4) & "','_blank','" & rs(4) & "','" & rs(6) & "','','',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(rs(0),1)
else
value = value & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rs(1) & "','','',-1,-1,0,'" & rs(4) & "','_blank','" & rs(4) & "','" & rs(6) & "','','',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 rs(5)>0 then
value = value & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rs(1) & "','','',-1,-1,0,'"&classfliename&"?ClassID=" & rs(0) & "','_self','"&classfliename&"?ClassID=" & rs(0) & "','" & rs(6) & "','','',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(rs(0),1)
else
value = value & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rs(1) & "','','',-1,-1,0,'"&classfliename&"?ClassID=" & rs(0) & "','_self','"&classfliename&"?ClassID=" & rs(0) & "','" & rs(6) & "','','',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
rs.movenext
loop
rs.close
set rs=nothing
value = value & "stm_ep();" & vbcrlf
end sub
'读取网站访问记数
Public Sub loadSiteCount()
Dim Rs,tmpdata
'文章总数 0
Set Rs = execute("select count(ArticleID) from Article where Deleted=False")
tmpdata = tmpdata & rs(0) &"|||"
'文章阅读 1
Set Rs = execute("select sum(Hits) from article")
tmpdata = tmpdata & rs(0) &"|||"
'待审文章 2
Set Rs = execute("select count(ArticleID) from Article where Passed=False and Deleted=False")
tmpdata = tmpdata & rs(0) &"|||"
'评论总数 3
Set Rs = execute("select count(CommentID) from ArticleComment")
tmpdata = tmpdata & rs(0) &"|||"
'专题总数 4
Set Rs = execute("select count(SpecialID) from Special")
tmpdata = tmpdata & rs(0) &"|||"
'下载总数 5
Set Rs = execute("select count(SoftID) from Soft where Deleted=False")
tmpdata = tmpdata & rs(0) &"|||"
'文件下载 6
Set Rs = execute("select sum(Hits) from Soft")
tmpdata = tmpdata & rs(0) &"|||"
'待审下载 7
Set Rs = execute("select count(SoftID) from Soft where Passed=False and Deleted=False")
tmpdata = tmpdata & rs(0) &"|||"
'下载评论 8
Set Rs = execute("select count(CommentID) from SoftComment")
tmpdata = tmpdata & rs(0) &"|||"
'图片总数 9
Set Rs = execute("select count(PhotoID) from Photo where Deleted=False")
tmpdata = tmpdata & rs(0) &"|||"
'图片查看 10
Set Rs = execute("select sum(Hits) from Photo")
tmpdata = tmpdata & rs(0) &"|||"
'待审图片 11
Set Rs = execute("select count(PhotoID) from Photo where Passed=False and Deleted=False")
tmpdata = tmpdata & rs(0) &"|||"
'图片评论 12
Set Rs = execute("select count(CommentID) from PhotoComment")
tmpdata = tmpdata & rs(0) &"|||"
'注册用户 13
Set Rs = Conn_User.execute("select count(UserID) from " & db_User_Table)
tmpdata = tmpdata & rs(0) &"|||"
SqlQueryNum=SqlQueryNum+1
value=tmpdata
Set Rs = Nothing
end Sub
Public sub loadVote()
dim Rs,SQL,tmpdata,i
Name="vote"&ChannelID
SQL="select top 1 * from Vote where IsSelected=True and (ChannelID=0 or ChannelID=" & ChannelID & ") order by ID Desc"
Set Rs= execute(SQL)
if Rs.bof and Rs.eof then
tmpdata = "<font color='#ff9900'>· </font>没有任何调查"
else
tmpdata = "<form name='VoteForm' method='post' action='vote.asp' target='_blank'>"
tmpdata = tmpdata & " " & Rs("Title") & "<br>"
if Rs("VoteType")="Single" then
for i=1 to 8
if trim(Rs("Select" & i) & "")="" then exit for
tmpdata = tmpdata & "<input type='radio' name='VoteOption' value='" & i & "' style='border:0'>" & Rs("Select" & i) & "<br>"
next
else
for i=1 to 8
if trim(Rs("Select" & i) & "")="" then exit for
tmpdata = tmpdata & "<input type='checkbox' name='VoteOption' value='" & i & "' style='border:0'>" & Rs("Select" & i) & "<br>"
next
end if
tmpdata = tmpdata & "<br><input name='VoteType' type='hidden'value='" & Rs("VoteType") & "'>"
tmpdata = tmpdata & "<input name='Action' type='hidden' value='Vote'>"
tmpdata = tmpdata & "<input name='ID' type='hidden' value='" & Rs("ID") & "'></form>"
tmpdata = tmpdata & "<div align='center'>"
tmpdata = tmpdata & "<a href='javascript:VoteForm.submit();'><img src='Skin/51dsn03/bt_voteSubmit.gif' border='0'></a>"
tmpdata = tmpdata & "<a href='Vote.asp?ID=" & Rs("ID") & "&Action=Show' target='_blank'><img src='Skin/51dsn03/bt_voteView.gif' border='0'></a>"
tmpdata = tmpdata & "</div>"
end if
Rs.close
set Rs=nothing
value=tmpdata
end sub
'*************************************************
'缓存文章栏目
'=================================================
'过程名：ArticleContentshiyu
'作 用：显示文章属性、标题、作者、更新日期、点击数等信息
'参 数：intTitleLen ----标题最多字符数，一个汉字=两个英文字符
' ShowProperty ----是否显示文章属性（固顶/推荐/普通），True为显示，False为不显示
' ShowIncludePic ---是否显示“[图文]”字样，True为显示，False为不显示
' ShowAuthor -------是否显示文章作者，True为显示，False为不显示
' ShowDateType -----显示更新日期的样式，0为不显示，1为显示年月日，2为只显示月日。
' ShowHits ---------是否显示文章点击数，True为显示，False为不显示
' ShowHot ----------是否显示热门文章标志，True为显示，False为不显示
'=================================================
function ArticleContentshiyu(intTitleLen,ShowProperty,ShowIncludePic,ShowAuthor,ShowDateType,ShowHits,ShowHot)
dim i,strTemp,TitleStr,Author,AuthorName,AuthorEmail
i=0
strTemp="<table width=100% border=0 cellpadding=0 cellspacing=0>"
do while not rsArticle.eof
strTemp=strTemp & "<tr><td>"
if ShowProperty=True then
if rsArticle("OnTop")=true then
strTemp = strTemp & "<img src='images/article_ontop.gif' alt='固顶文章'> "
elseif rsArticle("Elite")=true then
strTemp = strTemp & "<img src='images/article_elite.gif' alt='推荐文章'> "
else
strTemp = strTemp & "<img src='images/article_common.gif' alt='普通文章'> "
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></td><td align=right>"
if ShowAuthor=True or ShowDateType>0 or ShowHits=True then
strTemp = strTemp & "["
if ShowAuthor=True then
if AuthorEmail="" then
strTemp=strTemp & "<font color=#999999>" & AuthorName & "</font>"
else
strTemp=strTemp & "<font color=#999999><a href='mailto:" & AuthorEmail & "'>" & AuthorName & "</a></font>"
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
if month(rsArticle("UpdateTime"))<10 then
strTemp= strTemp & "0"
end if
strTemp= strTemp & month(rsArticle("UpdateTime"))& "-"
if day(rsArticle("UpdateTime"))<10 then
strTemp= strTemp & "0"
end if
strTemp= strTemp & 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 & "<font color=#999999>" & rsArticle("Hits") & "</font>"
end if
strTemp=strTemp & "]"
end if
if ShowHot=True and rsArticle("Hits")>=nt2003.site_setting(14) then
strTemp= strTemp & "<img src='images/hot.gif' alt='热点文章'>"
end if
strTemp= strTemp & "</td></tr>"
rsArticle.movenext
i=i+1
if i>=MaxPerPage then exit do
loop
strTemp=strTemp & "</table>"
ArticleContentshiyu=strTemp
end function
public tmpdata
public function showarticleshiyu()
dim sqlRoot,rsRoot
name="classroot"
If ObjIsEmpty() Then
sqlRoot="select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,L.LayoutID,C.Child From ArticleClass C inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=0 and IsElite=True and LinkUrl='' order by C.RootID"
Set rsRoot = Execute(sqlRoot)
if rsRoot.bof and rsRoot.eof then
value=""
else
value = rsRoot.GetString(,,"|||","@@@","")
end if
rsRoot.close
set rsRoot=nothing
end if
tmpdata=value
Name="showarticleshiyu"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -