📄 function.asp
字号:
}
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=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='778' align='center' border='0' cellpadding='0' cellspacing='0'><tr><td height='1' bgcolor='#CCCCCC'></td></tr><tr> <td height='2'></td></tr><tr height='22' bgcolor='#eeeeee' align='center'><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 & "</td></tr><tr><td height='2' bgcolor='#CCCCCC'></td></tr></table>"
response.write strTemp
end sub
'==================================================
'过程名：ShowUserLogin
'作 用：显示用户登录表单
'参 数：无
'==================================================
sub ShowUserLogin()
dim strLogin
if CheckUserLogined()=False then
strLogin="<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbcrlf
strLogin=strLogin & "<form action='User_ChkLogin.asp' method='post' name='UserLogin' onSubmit='return CheckForm();'>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'><img src='Images/username.gif'></td><td height='25'><input name='UserName' type='text' id='UserName' size='16' maxlength='20'></td></tr>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'><img src='Images/ps.gif'></td><td height='25'><input name='Password' type='password' id='Password' size='16' maxlength='20'></td></tr>" & vbcrlf
strLogin=strLogin & "<tr><td height='25' align='right'><img src='Images/Cookies.gif'></td><td height='25'><select name=CookieDate><option selected value=0>不 保 存</option><option value=1>保 存 一 天</option>" & vbcrlf
strLogin=strLogin & "<option value=2>保 存 一 月</option><option value=3>保 存 一 年</option></select></td></tr>" & vbcrlf
strLogin=strLogin & "<tr align='center'><td height='30' colspan='2'><input name='Login' type='submit' id='Login' value=' 登 录 '> <input name='Reset' type='reset' id='Reset' value=' 清 除 '>" & vbcrlf
strLogin=strLogin & "<br><hr size='1' color='#Cccccc'><a href='User_Reg.asp' target='_blank'>新用户注册</a> <font color='#666666'>|</font> <a href='User_GetPassword.asp'>忘记密码？</a><br></td>" & vbcrlf
strLogin=strLogin & "</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 " <font color='#666666'>欢迎</font><font color=#FF6600><b>" & UserName & "</b></font><font color='#666666'>，登陆！</font>"
response.write "<br> <font color='#666666'>您的身份：</font>"
if UserLevel=999 then
response.write "<font color='#666666'>注册用户</font>"
elseif UserLevel=99 then
response.write "<font color='#666666'>收费用户</font>"
elseif UserLevel=9 then
response.write "<font color='#666666'>VIP用户</font>"
end if
response.write "<br> <font color='#666666'>计费方式：</font>"
if ChargeType=1 then
if UserPoint>0 then
response.write "<font color='#666666'>扣点数</font><br> <font color='#666666'>可用点数：</font> <b><font color=#FF0099>" & UserPoint & "</font></b> <font color='#666666'>点</font>"
if UserPoint<=10 then
response.write "<br><font color=red>你的可用点数已不多，请及时联系我们进行充值！</font>"
end if
else
response.write "<font color='#666666'>扣点数</font><br><font color='#666666'>可用点数：</font> <b><font color=#FF0099>" & UserPoint & "</font></b> 点"
response.write "<br><font color=red>你的可用点数已经用完，请联系我们进行充值，否则你将不能阅读收费内容。</font>"
end if
else
if ValidDays>0 then
response.write "有效期<br>有效天数： <b><font color=blue>" & ValidDays & "</font></b> 天"
if ValidDays<=10 then
response.write "<br><font color=red>你的有效期时间已不长，请及时联系我们进行充值！</font>"
end if
else
response.write "有效期<br>有效天数： <b><font color=red>" & ValidDays & "</font></b> 天"
response.write "<br><font color=red>你的有效期已经过期，请联系我们进行充值，否则你将不能阅读收费内容。</font>"
end if
end if
response.write "<br><img src='Images/yhkz.gif' width='171' height='20'><br>" & vbcrlf
response.write " <a href=""JavaScript:openScript('User_ControlPad.asp?Action=ArticleAdd')""><img src='Images/yht.gif' width='10' height='14' border='0'> 发表文章</a>" & vbcrlf
response.write " <a href=""JavaScript:openScript('User_ControlPad.asp?Action=ArticleManage')""><img src='Images/yht.gif' width='10' height='14' border='0'> 文章管理</a><br>" & vbcrlf
response.write " <a href=""JavaScript:openScript('User_ControlPad.asp?Action=ModifyPwd')""><img src='Images/yht.gif' width='10' height='14' border='0'> 修改密码</a>" & vbcrlf
response.write " <a href=""JavaScript:openScript('User_ControlPad.asp?Action=ModifyInfo')""><img src='Images/yht.gif' width='10' height='14' border='0'> 个人信息</a><br>" & vbcrlf
response.write "<div align='center'><a href='User_Logout.asp'><img src='Images/aqtc.gif' width='92' height='22' border='0'></a></div>" & vbcrlf
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='100%' border='0' cellspacing='0' cellpadding='0'><tr><td align='left'><font color='#666666'>名次</font></td><td align='left'><font color='#666666'>用户名</font></td><td align='right'><font color='#666666'>文章数</font></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'><font color='#999900'>" & rsTopUser(db_User_ArticleChecked) & "</font></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
'==================================================
'过程名：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 "<table width='100%' border='0' align='center' cellpadding='0' cellspacing='0'><tr bgcolor='#f6f6f6'><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></div></td></tr></table>"
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='#f6f6f6'"">"
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
'==================================================
'过程名：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='#cccccc';//定义下拉菜单阴影色
var global = window.document
global.fo_currentMenu = null
global.fo_shadows = new Array
function HideMenu()
{
var mX;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -