function.asp

ASP开发设计的小型网站源码,主要实现歌曲点播.和后台数据库连接很好.适合作为课程设计作业.

</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='center' border='0' class='topborder' cellpadding='0' cellspacing='0'><tr height='22' align='center'><td class='title_maintxt'>"
	strTemp= strTemp & "|&nbsp;<a href='#' onClick=this.style.behavior='url(#default#homepage)';this.setHomePage('"& SiteUrl & "');>设"&"为"&"首"&"页</a>&nbsp;|&nbsp;"
	strTemp= strTemp & "<a href=javascript:window.external.addFavorite('" & SiteUrl & "','" & SiteName & "')>加"&"入"&"收"&"藏</a>&nbsp;|&nbsp;"
	strTemp= strTemp & "<a href='mailto:" & WebmasterEmail & "'>联"&"系"&"站"&"长</a>&nbsp;|&nbsp;"
	strTemp= strTemp & "<a href='FriendSite.asp' target='_blank'>友"&"情"&"链"&"接</a>&nbsp;|&nbsp;"
	strTemp= strTemp & "<a href='Copyright.asp' target='_blank'>版"&"权"&"申"&"明</a>&nbsp;|&nbsp;"
	strTemp= strTemp & "<a href='Admin_login.asp' target='_blank'>管"&"理"&"登"&"录</a>&nbsp;|&nbsp;"
	strTemp= strTemp & "</td></tr><tr align='center' height='20' valign='bottom'><td>"
	strTemp= strTemp & Copyright
	strTemp= strTemp & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;站长：<a href='mailto:" & WebmasterEmail & "'>" & WebmasterName & "</a>"
	if ShowRunTime="Yes" then
		strTemp= strTemp & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;页"&"面"&"执"&"行"&"时"&"间：" & CStr(FormatNumber((Timer-BeginTime)*1000,2)) & "毫秒"
	end if
	strTemp= strTemp & "<br>Powe"&"red by：<a href='http://www.asp1"&"63.net'>MyPo"&"wer Ve"&"r3.51</a>"
	strTemp= strTemp & "</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'>用户名：</td><td height='25'><input name='UserName' type='text' id='UserName' size='10' maxlength='20'></td></tr>" & vbcrlf
        strLogin=strLogin & "<tr><td height='25' align='right'>密&nbsp;&nbsp;码：</td><td height='25'><input name='Password' type='password' id='Password' size='10' maxlength='20'></td></tr>" & vbcrlf
        strLogin=strLogin & "<tr><td height='25' align='right'>Cookie：</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><br><a href='User_Reg.asp' target='_blank'>新用户注册</a>&nbsp;&nbsp;<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=green><b>" & UserName & "</b></font>，好久不见！"
		response.write "<br>您的身份："
		if UserLevel=999 then
			response.write "注册用户"
		elseif UserLevel=99 then
			response.write "收费用户"
		elseif UserLevel=9 then
			response.write "VIP用户"
		end if
		response.write "<br>计费方式："
		if ChargeType=1 then
			if UserPoint>0 then
				response.write "扣点数<br>可用点数： <b><font color=blue>" & UserPoint & "</font></b> 点"
				if UserPoint<=10 then
					response.write "<br><font color=red>你的可用点数已不多，请及时联系我们进行充值！</font>"
				end if
			else
				response.write "扣点数<br>可用点数： <b><font color=red>" & 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><b>用户控制面板：</b><br>" & vbcrlf
		response.write "&nbsp;&nbsp;&nbsp;<a href=""JavaScript:openScript('User_ControlPad.asp?Action=ArticleAdd')"">发表文章</a>" & vbcrlf
		response.write "&nbsp;&nbsp;<a href=""JavaScript:openScript('User_ControlPad.asp?Action=ArticleManage')"">文章管理</a><br>" & vbcrlf
		response.write "&nbsp;&nbsp;&nbsp;<a href=""JavaScript:openScript('User_ControlPad.asp?Action=ModifyPwd')"">修改密码</a>" & vbcrlf
		response.write "&nbsp;&nbsp;<a href=""JavaScript:openScript('User_ControlPad.asp?Action=ModifyInfo')"">个人信息</a><br>" & vbcrlf
		response.write "<div align='center'><a href='User_Logout.asp'>【注销登录】</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'>名次</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

'==================================================
'过程名：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'><br><a href='UserList.asp?OrderType=1'>按发表文章数排序</a>&nbsp;&nbsp;&nbsp;&nbsp;<a href='UserList.asp?OrderType=2'>按注册日期排序</a>&nbsp;&nbsp;&nbsp;&nbsp;<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

'==================================================
'过程名：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 & "&nbsp;&gt;&gt;&nbsp;" & 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;