function.asp
来自「利用C++编写的网络跟踪代码」· ASP 代码 · 共 1,591 行 · 第 1/5 页
ASP
1,591 行
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=True 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='760' align='left' border='0' class='topborder' cellpadding='0' cellspacing='0'><tr height='30' align='left'><td width=10 rowspan='2'></td><td >"
strTemp= strTemp & "| <a href='#' onClick=this.style.behavior='url(#default#homepage)';this.setHomePage('"& SiteUrl & "');>设"&"为"&"首"&"页</a> | "
strTemp= strTemp & "<a href=javascript:window.external.addFavorite('" & SiteUrl & "','" & SiteName & "')>加"&"入"&"收"&"藏</a> | "
strTemp= strTemp & "<a href='mailto:" & WebmasterEmail & "'>联"&"系"&"站"&"长</a> | "
strTemp= strTemp & "<a href='FriendSite.asp' target='_blank'>友"&"情"&"链"&"接</a> | "
strTemp= strTemp & "<a href='Copyright.asp' target='_blank'>版"&"权"&"申"&"明</a> | "
strTemp= strTemp & "<a href='Admin_login.asp' target='_blank'>管"&"理"&"登"&"录</a> | "
strTemp= strTemp & "<a href='mailto:" & WebmasterEmail & "' target='_blank'>广"&"告"&"投"&"放</a> | "
strTemp= strTemp & "<a href='guestbook.asp' target='_blank'>站"&"内"&"留"&"言</a> | "
strTemp= strTemp & "</td></tr><tr align='left' height='25' valign='top'><td>"
strTemp= strTemp & "| "& Copyright & ""
if ShowRunTime="Yes" then
strTemp= strTemp & " 页"&"面"&"执"&"行"&"时"&"间：" & CStr(FormatNumber((Timer-BeginTime)*1000,2)) & "毫秒 | "
end if
strTemp= strTemp & "</td></tr></table>"
response.write strTemp
end sub
'==================================================
'过程名：ShowUserLogin
'作 用：显示用户登录表单
'参 数：无
'==================================================
sub ShowUserLogin()
dim strLogin
if CheckUserLogined()=False then
strLogin="<table width=100% height=1 border=0 cellpadding=0 cellspacing=0><tr><td></td></tr></table><table border='0' cellspacing='0' cellpadding='0' width='100%' align=center> " & vbcrlf
strLogin=strLogin & "<form action='User_ChkLogin.asp' method='post' name='UserLogin' onSubmit='return CheckForm();'>" & vbcrlf
strLogin=strLogin & "<tr><td align='center'><b> 帐号:</b></td><td align='center' ><input name='UserName' type='text' id='UserName' size='16' maxlength='16' class=input2 ></td><td align='center'><b>密码:</b></td><td height='35' align='center'><input name='Password' type='password' id='Password' size='16' maxlength='16' class=input2 ></td>" & vbcrlf
strLogin=strLogin & "<td align=center><a href='User_Reg.asp' target='_blank'><FONT COLOr=990000>注册</font></a> <input name='Login' type='submit' id='Login' class=input3 value=' LOGIN '>" & vbcrlf
strLogin=strLogin & "<td align=center></td></tr></form></table>" & vbcrlf
response.write strLogin
%>
<script language=javascript>
function CheckForm()
{
if(document.UserLogin.UserName.value=="")
{
alert("请输入用户名！");
document.UserLogin.UserName.focus();
return false;
}
if(document.UserLogin.Password.value == "")
{
alert("请输入密码！");
document.UserLogin.Password.focus();
return false;
}
}
function openScript(url, width, height)
{
var Win = window.open(url,"UserControlPad",'width=' + width + ',height=' + height + ',resizable=1,scrollbars=yes,menubar=yes,status=yes' );
}
</script>
<%
Else
response.write "<table width=100% cellpadding=0 cellspacing=0 align=center ><Tr><td height=24> <img src=new/mem.gif alt= "
if UserLevel=999 then
response.write "普通会员"
elseif UserLevel=99 then
response.write "收费会员"
elseif UserLevel=9 then
response.write "VIP会员"
end if
response.write "> </td><td><b><font color=cc0000>" & UserName & "</font></b> "
if ChargeType=1 then
if UserPoint>0 then
response.write "<b><font color=cc0000>(" & UserPoint & "</font></b><font color=cc0000>点) </font></b>"
else
response.write "<b><font color=cc0000>(" & UserPoint & "</font></b><font color=cc0000>点) </font></b>"
end if
else
if ValidDays>0 then
response.write "<b><font color=cc0000>(" & ValidDays & "</font></b><font color=cc0000>天) </font></b>"
else
response.write "<b><font color=cc0000>(" & ValidDays & "</font></b><font color=cc0000>天) </font></b>"
end if
end if
response.write "| <b><a href=User_ArticleAdd.asp target=_blank><font color=333333>我要投稿</font></a></b>" & vbcrlf
response.write "| <b><a href=User_ArticleManage.asp target=_blank><font color=333333>投稿管理</font></a></b>" & vbcrlf
response.write "| <b></b>" & vbcrlf
response.write "| <b></b>" & vbcrlf
response.write "| <b><a href=User_ModifyInfo.asp target=_blank><font color=333333>修改信息</font></a></b>" & vbcrlf
response.write "| <b><a href='User_Logout.asp'><font color=333333>注销登录</font></a></b> |" & vbcrlf
response.write "</td></tr></table>"
end if
%>
<script language=javascript>
function openScript(url)
{
var Win = window.open(url,"UserControlPad");
}
function openScript2(url, width, height)
{
var Win = window.open(url,"UserControlPad",'width=' + width + ',height=' + height + ',resizable=1,scrollbars=yes,menubar=yes,status=yes' );
}
</script>
<%
end sub
'==================================================
'过程名：ShowTopUser
'作 用：显示用户排行，按已发表的文章数排序，若相等，再按注册先后顺序排序
'参 数：UserNum-------显示的用户个数
'==================================================
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='97%' align=center border='0' cellspacing='0' cellpadding='0'><tr><td align='left' width=40><font color=#B2B2B2>名次</font></td><td align='left'><font color=#B2B2B2>用户名</font></td><td align='right'><font color=#B2B2B2>文章数</font></td></tr>"
for i=1 to rsTopUser.recordcount
response.write "<tr><td align='left'> <font color=cccccc>" & cstr(i) & "</font></td><td align='left'><a href='UserInfo.asp?UserID=" & rsTopUser(db_User_ID) & "'><font color=cccccc>" & rsTopUser(db_User_Name) & "</font></a></td><td align='right'><font color=cccccc>" & rsTopUser(db_User_ArticleChecked) & "</font></td></tr>"
rsTopUser.movenext
next
response.write "<tr><td height=30 colspan=3 align=right><a href='UserList.asp'><img src=img/more.gif border=0></a></td></tr></table>"
end if
set rsTopUser=nothing
end sub
'==================================================
'过程名：ShowAllUser
'作 用：分页显示所有用户
'参 数：无
'==================================================
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'><a href='UserList.asp?OrderType=1'>按发表文章数排序</a> <a href='UserList.asp?OrderType=2'>按注册日期排序</a> <a href='UserList.asp?OrderType=3'>按用户ID排序</a><br><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 align=center><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) & "' target=_blank>点此访问</a>"
else
response.write "未填"
end if
response.write "</td><td align='center'>" & FormatDateTime(rsUser(db_User_RegDate),2) & "</td><td align='center'>" & rsUser(db_User_ArticleChecked) & "</td></tr>"
rsUser.movenext
i=i+1
if i>=MaxPerPage then exit do
loop
response.write "</table>"
end sub
'==================================================
'过程名：PopAnnouceWindow
'作 用：弹出公告窗口
'参 数：Width-------弹出窗口宽度
' Height------弹出窗口高度
'==================================================
sub PopAnnouceWindow(Width,Height)
dim popCount,rsAnnounce
set rsAnnounce=conn.execute("select count(*) from Announce where IsSelected=True and (ChannelID=0 or ChannelID=" & ChannelID & ") and (ShowType=0 or ShowType=2)")
popCount=rsAnnounce(0)
if popCount>0 then
if PopAnnounce="Yes" and session("Poped")<>ChannelID then
response.write "<script LANGUAGE='JavaScript'>"
response.write "window.open ('Announce.asp?ChannelID=" & ChannelID & "', 'newwindow', 'height=" & Height & ", width=" & Width & ", toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"
response.write "</script>"
session("Poped")=ChannelID
end if
end if
end sub
'==================================================
'过程名：ShowPath
'作 用：显示“你现在所有位置”导航信息
'参 数：无
'==================================================
sub ShowPath()
if PageTitle<>"" and ChannelID<>1 then
strPath=strPath & " >> " & PageTitle
end if
response.write strPath
end sub
'==================================================
'过程名：MenuJS
'作 用：生成下拉菜单相关的JS代码
'参 数：无
'==================================================
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;
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?