📄 function.asp
字号:
end sub
sub ShowAnnounce(ShowType,AnnounceNum)
dim sqlAnnounce,rsAnnounce,i
if AnnounceNum>0 and AnnounceNum<=10 then
sqlAnnounce="select top " & AnnounceNum
else
sqlAnnounce="select top 10"
end if
sqlAnnounce=sqlAnnounce & " * from Announce where IsSelected=1"
sqlAnnounce=sqlAnnounce & " and (ChannelID=0 or ChannelID=" & ChannelID & ")"
sqlAnnounce=sqlAnnounce & " and (ShowType=0 or ShowType=1) order by ID Desc"
Set rsAnnounce= Server.CreateObject("ADODB.Recordset")
rsAnnounce.open sqlAnnounce,conn,1,1
if rsAnnounce.bof and rsAnnounce.eof then
AnnounceCount=0
response.write "<p> 没有通告</p>"
else
AnnounceCount=rsAnnounce.recordcount
if ShowType=1 then
do while not rsAnnounce.eof
response.Write " <a href='#' onclick=""javascript:window.open('Announce.asp?ChannelID=" & ChannelID & "&ID=" & rsAnnounce("id") &"', 'newwindow', 'height=300, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='" & rsAnnounce("Content") & "'>" & rsAnnounce("title") & "</div><br><div align='right'>" & rsAnnounce("Author") & " <br>" & FormatDateTime(rsAnnounce("DateAndTime"),1) & "</a>"
rsAnnounce.movenext
i=i+1
if i<AnnounceCount then response.write "<hr>"
loop
else
do while not rsAnnounce.eof
response.Write " <a href='#' onclick=""javascript:window.open('Announce.asp?ChannelID=" & ChannelID & "&ID=" & rsAnnounce("id") &"', 'newwindow', 'height=300, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='" & rsAnnounce("Content") & "' >" & rsAnnounce("title") & " [" & rsAnnounce("Author") & " " & FormatDateTime(rsAnnounce("DateAndTime"),1) & "]</a> "
rsAnnounce.movenext
loop
end if
end if
rsAnnounce.close
set rsAnnounce=nothing
end sub
sub ShowFriendSite(LinkType,SiteNum,Cols,ShowType)
dim sqlLink,rsLink,SiteCount,i,strLink
if LinkType<>1 and LinkType<>2 then
LinkType=1
else
LinkType=Cint(LinkType)
end if
if SiteNum<=0 or SiteNum>100 then
SiteNum=10
end if
if Cols<=0 or Cols>20 then
Cols=10
end if
if ShowType=1 then
' strLink=strLink & "<marquee id='LinkScrollArea' direction='up' scrolldelay='50' scrollamount='1' width='100' height='100' onmouseover='this.stop();' onmouseout='this.start();'>"
strLink=strLink & "<div id=rolllink style=overflow:hidden;height:100;width:100><div id=rolllink1>" '新增加的代码
elseif ShowType=3 then
strLink=strLink & "<select name='FriendSite' onchange=""if(this.options[this.selectedIndex].value!=''){window.open(this.options[this.selectedIndex].value,'_blank');}""><option value=''>友情文字链接站点</option>"
end if
if ShowType=1 or ShowType=2 then
strLink=strLink & "<table width='100%' cellSpacing='5'><tr align='center' class='tdbg'>"
end if
sqlLink="select top " & SiteNum & " * from FriendSite where IsOK=1 and LinkType=" & LinkType & " order by IsGood,id desc"
set rsLink=server.createobject("adodb.recordset")
rsLink.open sqlLink,conn,1,1
if rsLink.bof and rsLink.eof then
if ShowType=1 or ShowType=2 then
for i=1 to SiteNum
strLink=strLink & "<td><a href='FriendSiteReg.asp' target='_blank'>"
if LinkType=1 then
strLink=strLink & "<img src='images/nologo.jpg' width='88' height='31' border='0' alt='点击申请'>"
else
strLink=strLink & "点击申请"
end if
strLink=strLink & "</a></td>"
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
next
end if
else
SiteCount=rsLink.recordcount
for i=1 to SiteCount
if ShowType=1 or ShowType=2 then
if LinkType=1 then
strLink=strLink & "<td width='88'><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>"
if rsLink("LogoUrl")="" or rsLink("LogoUrl")="http://" then
strLink=strLink & "<img src='images/nologo.gif' width='88' height='31' border='0'>"
else
strLink=strLink & "<img src='" & rsLink("LogoUrl") & "' width='88' height='31' border='0'>"
end if
strLink=strLink & "</a></td>"
else
strLink=strLink & "<td width='88'><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>" & rsLink("SiteName") & "</a></td>"
end if
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
else
strLink=strLink & "<option value='" & rsLink("SiteUrl") & "'>" & rsLink("SiteName") & "</option>"
end if
rsLink.moveNext
next
if SiteCount<SiteNum and (ShowType=1 or ShowType=2) then
for i=SiteCount+1 to SiteNum
if LinkType=1 then
strLink=strLink & "<td width='88'><a href='FriendSiteReg.asp' target='_blank'><img src='images/nologo.jpg' width='88' height='31' border='0' alt='点击申请'></a></td>"
else
strLink=strLink & "<td width='88'><a href='FriendSiteReg.asp' target='_blank'>点击申请</a></td>"
end if
if i mod Cols=0 and i<SiteNum then
strLink=strLink & "</tr><tr align='center' class='tdbg'>"
end if
next
end if
end if
if ShowType=1 or ShowType=2 then
strLink=strLink & "</tr></table>"
end if
if ShowType=1 then
' strLink=strLink & "</marquee>"
strLink=strLink & "</div><div id=rolllink2></div></div>" '新增代码
elseif ShowType=3 then
strLink=strLink & "</select>"
end if
response.write strLink
if ShowType=1 then call RollFriendSite() '新增代码
rsLink.close
set rsLink=nothing
end sub
sub RollFriendSite()
%>
<script>
var rollspeed=30
rolllink2.innerHTML=rolllink1.innerHTML //克隆rolllink1为rolllink2
function Marquee(){
if(rolllink2.offsetTop-rolllink.scrollTop<=0) //当滚动至rolllink1与rolllink2交界时
rolllink.scrollTop-=rolllink1.offsetHeight //rolllink跳到最顶端
else{
rolllink.scrollTop++
}
}
var MyMar=setInterval(Marquee,rollspeed) //设置定时器
rolllink.onmouseover=function() {clearInterval(MyMar)}//鼠标移上时清除定时器达到滚动停止的目的
rolllink.onmouseout=function() {MyMar=setInterval(Marquee,rollspeed)}//鼠标移开时重设定时器
</script>
<%
end sub
sub ShowGoodSite(SiteNum)
dim sqlLink,rsLink,SiteCount,i,strLink
if SiteNum<=0 or SiteNum>100 then
SiteNum=10
end if
strLink=strLink & "<table width='100%' cellSpacing='5'>"
sqlLink="select top " & SiteNum & " * from FriendSite where IsOK=True and LinkType=1 and IsGood=1 order by id desc"
set rsLink=server.createobject("adodb.recordset")
rsLink.open sqlLink,conn,1,1
if rsLink.bof and rsLink.eof then
for i=1 to SiteNum
strLink=strLink & "<tr align='center'><td><a href='FriendSiteReg.asp' target='_blank'><img src='images/nologo.jpg' width='88' height='31' border='0' alt='点击申请'></a></td></tr>"
next
else
SiteCount=rsLink.recordcount
for i=1 to SiteCount
strLink=strLink & "<tr align='center'><td><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>"
if rsLink("LogoUrl")="" or rsLink("LogoUrl")="http://" then
strLink=strLink & "<img src='images/nologo.gif' width='88' height='31' border='0'>"
else
strLink=strLink & "<img src='" & rsLink("LogoUrl") & "' width='88' height='31' border='0'>"
end if
strLink=strLink & "</a></td></tr>"
rsLink.moveNext
next
for i=SiteCount+1 to SiteNum
strLink=strLink & "<tr align='center'><td><a href='FriendSiteReg.asp' target='_blank'><img src='images/nologo.jpg' width='88' height='31' border='0' alt='点击申请'></a></td></tr>"
next
end if
strLink=strLink & "</table>"
response.write strLink
rsLink.close
set rsLink=nothing
end sub
sub Bottom()
dim strTemp
strTemp="<table width='100%' align='center' border='0' class='topborder' cellpadding='0' cellspacing='0'><tr height='22' align='center'><td class='title_maintxt'>"
strTemp= strTemp & "<font color='#000000'>| <a href='#' onClick=this.style.behavior='url(#default#homepage)';this.setHomePage('"& SiteUrl & "');><font color='#000000' style='text-decoration:none'>设为首页</font></a> | "
strTemp= strTemp & "<a href=javascript:window.external.addFavorite('" & SiteUrl & "','" & SiteName & "') style='text-decoration:none'><font color='#000000'>加入收藏</font></a> | "
strTemp= strTemp & "<a href='mailto:" & WebmasterEmail & "' style='text-decoration:none'><font color='#000000'>联系站长</font></a> | "
'strTemp= strTemp & "<a href='FriendSite.asp' target='_blank' style='text-decoration:none'><font color='#000000'>友情链接</font></a> | "
strTemp= strTemp & "<a href='Admin_login.asp' target='_blank' style='text-decoration:none'><font color='#000000'>管理登录</font></a> | </font>"
strTemp= strTemp & "</td></tr>"
strTemp= strTemp & "</td></tr></table>"
response.write strTemp
end sub
sub ShowCopyRight()
dim strTemp
strTemp="<table width='100%' align='center' border='0' class='topborder' cellpadding='0' cellspacing='0'><tr height='22' align='center'><td class='title_maintxt'>"
strTemp= strTemp & Copyright
'strTemp= strTemp & " 站长：<a href='mailto:" & WebmasterEmail & "'>" & WebmasterName & "</a>"
if ShowRunTime="Yes" then
strTemp= strTemp & " 页"&"面"&"执"&"行"&"时"&"间：" & CStr(FormatNumber((Timer-BeginTime)*1000,2)) & "毫秒"
end if
strTemp= strTemp & "</td></tr></table>"
response.write strTemp
end sub
sub ShowTopUser(UserNum)
if UserNum<=0 or UserNum>100 then UserNum=10
dim sqlTopUser,rsTopUser,i
sqlTopUser="select top " & UserNum & " * from " & db_User_Table & " order by " & db_User_ArticleChecked & " desc," & db_User_ID & " asc"
set rsTopUser=server.createobject("adodb.recordset")
rsTopUser.open sqlTopUser,Conn_User,1,1
if rsTopUser.bof and rsTopUser.eof then
response.write "没有任何用户"
else
response.write "<table width='100%' border='0' cellspacing='0' cellpadding='0'><tr><td align='left'>名次</td><td align='left'>用户名</td><td align='right'>文章数</td></tr>"
for i=1 to rsTopUser.recordcount
response.write "<tr><td align='center'>" & cstr(i) & "</td><td align='left'><a href='UserInfo.asp?UserID=" & rsTopUser(db_User_ID) & "'>" & rsTopUser(db_User_Name) & "</a></td><td align='right'>" & rsTopUser(db_User_ArticleChecked) & "</td></tr>"
rsTopUser.movenext
next
response.write "</table><div align='right'><a href='UserList.asp'>more...</a></div>"
end if
set rsTopUser=nothing
end sub
sub ShowAllUser()
select case OrderType
case 1
sqlUser="select * from " & db_User_Table & " order by " & db_User_ArticleChecked & " desc"
case 2
sqlUser="select * from " & db_User_Table & " order by " & db_User_RegDate & " desc"
case 3
sqlUser="select * from " & db_User_Table & " order by " & db_User_ID & " desc"
end select
set rsUser=server.createobject("adodb.recordset")
rsUser.open sqlUser,Conn_User,1,1
if rsUser.bof and rsUser.eof then
totalput=0
response.write "<br><li>没有任何用户</li>"
else
totalput=rsUser.recordcount
if currentPage=1 then
call ShowUserList()
else
if (currentPage-1)*MaxPerPage<totalPut then
rsUser.move (currentPage-1)*MaxPerPage
dim bookmark
bookmark=rsUser.bookmark
call ShowUserList()
else
currentPage=1
call ShowUserList()
end if
end if
end if
rsUser.close
set rsUser=nothing
end sub
sub ShowUserList()
dim i
i=0
response.write "<div align='center'><br><a href='UserList.asp?OrderType=1'>按发表文章数排序</a> <a href='UserList.asp?OrderType=2'>按注册日期排序</a> <a href='UserList.asp?OrderType=3'>按用户ID排序</a><br></div>"
response.write "<table width='100%' border='0' cellspacing='1' cellpadding='3' bgcolor='#f9f9f9'><tr align='center'><td bgcolor='#f0f0f0'>用户名</td><td bgcolor='#f0f0f0'>性别</td><td bgcolor='#f0f0f0'>Email</td><td bgcolor='#f0f0f0'>QQ号码</td><td bgcolor='#f0f0f0'>MSN</td><td bgcolor='#f0f0f0'>主页</td><td bgcolor='#f0f0f0'>注册日期</td><td bgcolor='#f0f0f0'>文章数</td><tr>"
do while not rsUser.eof
response.write "<tr onmouseout=""this.style.backgroundColor=''"" onmouseover=""this.style.backgroundColor='#BFDFFF'"">"
response.write "<td><a href='UserInfo.asp?UserID=" & rsUser(db_User_ID) & "'>" & rsUser(db_User_Name) & "</a></td><td align='center'>"
if rsUser(db_User_Sex)=1 then
response.write "男"
else
response.write "女"
end if
response.write "</td><td><a href='mailto:" & rsUser(db_User_Email) & "'>" & rsUser(db_User_Email) & "</a><td align='center'>"
if rsUser(db_User_QQ)<>"" then
response.write rsUser(db_User_QQ)
else
response.write "未填"
end if
response.write "</td><td align='center'>"
if rsUser(db_User_Msn)<>"" then
response.write rsUser(db_User_Msn)
else
response.write "未填"
end if
response.write "</td><td align='center'>"
if rsUser(db_User_Homepage)<>"" and rsUser(db_User_Homepage)<>"http://" then
response.write "<a href='" & rsUser(db_User_Homepage) & "' title='" & rsUser(db_User_Homepage) & "'>点此访问</a>"
else
response.write "未填"
end if
response.write "</td><td align='center'>" & FormatDateTime(rsUser(db_User_RegDate),2) & "</td><td align='right'>" & rsUser(db_User_ArticleChecked) & "</td></tr>"
rsUser.movenext
i=i+1
if i>=MaxPerPage then exit do
loop
response.write "</table>"
end sub
sub MenuJS()
dim strMenu
if ShowMyStyle="Yes" then
%>
<script language="JavaScript" type="text/JavaScript">
//下拉菜单相关代码
var h;
var w;
var l;
var t;
var topMar = 1;
var leftMar = -2;
var space = 1;
var isvisible;
var MENU_SHADOW_COLOR='#999999';//定义下拉菜单阴影色
var global = window.document
global.fo_currentMenu = null
global.fo_shadows = new Array
function HideMenu()
{
var mX;
var mY;
var vDiv;
var mDiv;
if (isvisible == true)
{
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -