<%@language=vbscript codepage=936 %>
<%
option explicit
response.buffer=true	
'强制浏览器重新访问服务器下载页面，而不是从缓存读取页面
Response.Buffer = True 
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1 
Response.Expires = 0 
Response.CacheControl = "no-cache" 
%>
<!--#include file="conn.asp"-->
<!--#include file="config.asp"-->
<!--#include file="ubbcode.asp"-->
<!--#include file="function.asp"-->
<!--#include file="admin_code.asp"-->
<%
dim strChannel,sqlChannel,rsChannel,ChannelUrl,ChannelName
dim ArticleID,ArticleTitle
dim FileName,strFileName,MaxPerPage,ShowSmallClassType
dim totalPut,CurrentPage,TotalPages
dim BeginTime,EndTime
dim founderr, errmsg
dim ClassID,SpecialID,keyword,strField,SpecialName
dim rs,sql,sqlArticle,rsArticle,sqlSearch,rsSearch,rsPic,sqlSpecial,rsSpecial,sqlUser,rsUser
dim tClass,ClassName,RootID,ParentID,Depth,ParentPath,Child,SkinID,LayoutID,LayoutFileName,ChildID,tID,tChild
dim tSpecial
dim strPic,AnnounceCount
dim UserLevel
dim PageTitle,strPath,strPageTitle
dim strClassTree

BeginTime=Timer
ArticleID=trim(request("ArticleID"))
ClassID=trim(request("ClassID"))
SpecialID=trim(request("SpecialID"))
strField=trim(request("Field"))
keyword=trim(request("keyword"))
UserLevel=request.Cookies("asp163")("UserLevel")

if ArticleId="" then
	ArticleID=0
else
	ArticleID=Clng(ArticleID)
end if
if ClassID<>"" then
	ClassID=CLng(ClassID)
else
	ClassID=0
end if
if SpecialID="" then
	SpecialID=0
else
	SpecialID=CLng(SpecialID)
end if
if UserLevel="" then
	UserLevel=5000
else
	UserLevel=Cint(UserLevel)
end if
strPath= "&nbsp;您现在的位置：&nbsp;<a href='" & SiteUrl & "'>" & SiteName & "</a>"
strPageTitle= SiteTitle
if ShowSiteChannel="Yes" then
	strChannel= "|&nbsp;"
	sqlChannel="select * from Channel order by OrderID"
	set rsChannel=server.CreateObject("adodb.recordset")
	rsChannel.open sqlChannel,conn,1,1
	do while not rsChannel.eof
		if rsChannel("ChannelID")=ChannelID then
			ChannelUrl=rsChannel("LinkUrl")
			ChannelName=rsChannel("ChannelName")
			strChannel=strChannel & "<a href='" & ChannelUrl & "'><font color=red>" & ChannelName & "</font></a>&nbsp;|&nbsp;"
		else
			strChannel=strChannel & "<a href='" & rsChannel("LinkUrl") & "' target='_blank'>" & rsChannel("ChannelName") & "</a>&nbsp;|&nbsp;"
		end if
		rsChannel.movenext
	loop
	rsChannel.close
	set rsChannel=nothing
	strPath=strPath & "&nbsp;&gt;&gt;&nbsp;<a href='" & ChannelUrl & "'>" & ChannelName & "</a>"
	strPageTitle=strPageTitle & " >> " & ChannelName
end if

if ArticleID>0 then
	sql="select * from article where ArticleID=" & ArticleID & ""
	Set rs= Server.CreateObject("ADODB.Recordset")
	rs.open sql,conn,1,3
	if rs.bof and rs.eof then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>你要找的文章不存在，或者已经被管理员删除！</li>"
	else	
		ClassID=rs("ClassID")
		SpecialID=rs("SpecialID")
		SkinID=rs("SkinID")
		LayoutID=rs("LayoutID")
		ArticleTitle=rs("Title")

		rs("Hits")=rs("Hits")+1
		rs.update
		if rs("hits")>=HitsOfHot then
			rs("Hot")=True
			rs.update
		end if
		if rs("ReadLevel")<9999 and session("Admin")="" then
			if CheckUserLogined()=False then 
				FoundErr=True
				ErrMsg=ErrMsg & "<br>&nbsp;&nbsp;&nbsp;&nbsp;你还没注册？或者没有登录？这篇文章要求至少是本站的注册用户才能阅读！<br><br>"
				ErrMsg=ErrMsg & "&nbsp;&nbsp;&nbsp;&nbsp;如果你还没注册，请赶紧<a href='UserReg.asp'><font color=red>点此注册</font></a>吧！<br><br>"
				ErrMsg=ErrMsg & "&nbsp;&nbsp;&nbsp;&nbsp;如果你已经注册但还没登录，请赶紧<a href='UserLogin.asp'><font color=red>点此登录</font></a>吧！<br><br>"
			else
				if Cint(Request.Cookies("asp163")("UserLevel"))>rs("ReadLevel") then
					FoundErr=True
					ErrMsg=ErrMsg & "<br><li>对不起，你没有阅读此文章的权限!</li>"
				end if
			end if
		end if
	end if
end if

if ClassID>0 then
	sql="select C.ClassName,C.RootID,C.ParentID,C.Depth,C.ParentPath,C.Child,C.SkinID,L.LayoutID,L.LayoutFileName,C.BrowsePurview From ArticleClass C"
	sql=sql & " inner join Layout L on C.LayoutID=L.LayoutID where C.ClassID=" & ClassID
	set tClass=conn.execute(sql)
	if tClass.bof and tClass.eof then
		FoundErr=True
		ErrMsg=ErrMsg & "<br><li>找不到指定的栏目</li>"
		Call WriteErrMsg()
		response.end
	else
		if tClass(9)<UserLevel then
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>对不起，你没有浏览本栏目的权限！</li>"
			Call WriteErrMsg()
			response.end
		else
			ClassName=tClass(0)
			RootID=tClass(1)
			ParentID=tClass(2)
			Depth=tClass(3)
			ParentPath=tClass(4)
			Child=tClass(5)
			SkinID=tClass(6)
			LayoutID=tClass(7)
			LayoutFileName=tClass(8)

			strPath=strPath & "&nbsp;&gt;&gt;&nbsp;"
			strPageTitle=strPageTitle & " >> "
			if ParentID>0 then
				dim sqlPath,rsPath
				sqlPath="select ArticleClass.ClassID,ArticleClass.ClassName,Layout.LayoutFileName,Layout.LayoutID From ArticleClass"
				sqlPath= sqlPath & " inner join Layout on ArticleClass.LayoutID=Layout.LayoutID where ArticleClass.ClassID in (" & ParentPath & ") order by ArticleClass.Depth"
				set rsPath=server.createobject("adodb.recordset")
				rsPath.open sqlPath,conn,1,1
				do while not rsPath.eof
					strPath=strPath & "<a href='" & rsPath(2) & "?ClassID=" & rsPath(0) & "&LayoutID=" & rsPath(3) & "'>" & rsPath(1) & "</a>&nbsp;&gt;&gt;&nbsp;"
					strPageTitle=strPageTitle & rsPath(1) & " >> "
					rsPath.movenext
				loop
				rsPath.close
				set rsPath=nothing
			end if
			strPath=strPath & "<a href='" & LayoutFileName & "?ClassID=" & ClassID & "'>" & ClassName & "</a>"
			strPageTitle=strPageTitle & ClassName
		end if	
	end if
end if
if SpecialID>0 then
	sql="select S.SpecialID,S.SpecialName,S.SkinID,S.LayoutID,L.LayoutFileName,S.BrowsePurview from Special S inner join Layout L on L.LayoutID=S.LayoutID where S.SpecialID=" & SpecialID
	set tSpecial=conn.execute(sql)
	if tSpecial.bof and tSpecial.eof then
		FounErr=True
		ErrMsg=ErrMsg & "<br><li>找不到指定的栏目</li>"
		Call WriteErrMsg()
		response.end
	else
		if tSpecial(5)<UserLevel then
			FoundErr=True
			ErrMsg=ErrMsg & "<br><li>对不起，你没有浏览本专题的权限！</li>"
			Call WriteErrMsg()
			response.end
		else
			SpecialName=tSpecial(1)
			SkinID=tSpecial(2)
			LayoutID=tSpecial(3)
			LayoutFilename=tSpecial(4)
			strPath=strPath & "&nbsp;&gt;&gt;&nbsp;<font color=blue>[专题]</font><a href='" & tSpecial(4) & "?SpecialID=" & tSpecial(0) & "'>" & SpecialName & "</a>"
			strPageTitle=strPageTitle & " >> [专题]" & SpecialName
		end if
	end if
end if
	
if keyword<>"" then 
	keyword=ReplaceBadChar(keyword)
end if

if request("page")<>"" then
    currentPage=cint(request("page"))
else
	currentPage=1
end if

'=================================================
'过程名：ShowPath
'作  用：显示“你现在所有位置”导航信息
'参  数：无
'=================================================
sub ShowPath()
	if PageTitle<>"" then
		strPath=strPath & "&nbsp;&gt;&gt;&nbsp;" & PageTitle
	end if
	response.write strPath
end sub

'=================================================
'过程名：ShowRootClass
'作  用：显示一级栏目（无特殊效果）
'参  数：无
'=================================================
sub ShowRootClass()
	dim sqlRoot,rsRoot
	sqlRoot="select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,C.LinkUrl From ArticleClass C"
	sqlRoot= sqlRoot & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=0 order by C.RootID"
	Set rsRoot= Server.CreateObject("ADODB.Recordset")
	rsRoot.open sqlRoot,conn,1,1
	if rsRoot.bof and rsRoot.eof then 
		response.Write("还没有任何栏目，请首先添加栏目。")
	else
		if ClassID>0 then
			response.write "|<a href='" & ChannelUrl & "'>&nbsp;首页&nbsp;</a>|"
		else
			response.write "|<a href='" & ChannelUrl & "'><font color=red>&nbsp;首页&nbsp;</font></a>|"
		end if
		do while not rsRoot.eof
			if rsRoot(4)<>"" then
				response.write "<a href='" & rsRoot(4) & "' target='_blank'>&nbsp;" & rsRoot(1) & "&nbsp;</a>|"
			else
				if rsRoot(2)=RootID then
					response.Write "<a href='" & rsRoot(3) & "?ClassID=" & rsRoot(0) & "'><font color=red>&nbsp;" & rsRoot(1) & "</font>&nbsp;</a>|"
				else
					response.Write "<a href='" & rsRoot(3) & "?ClassID=" & rsRoot(0) & "'>&nbsp;" & rsRoot(1) & "&nbsp;</a>|"
				end if
			end if
			rsRoot.movenext
		loop
	end if
	rsRoot.close
	set rsRoot=nothing
	if ShowMyStyle="Yes" then
		response.write "<a href='#' onMouseOver='ShowMenu(menu_skin,100)'>&nbsp;自选风格&nbsp;</a>|"
	end if
end sub

'=================================================
'过程名：ShowRootClass_Menu
'作  用：显示一级栏目（下拉菜单效果）
'参  数：无
'=================================================
sub ShowRootClass_Menu()
	dim sqlRoot,rsRoot
	sqlRoot="select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,C.LinkUrl,C.Child From ArticleClass C"
	sqlRoot= sqlRoot & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=0 order by C.RootID"
	Set rsRoot= Server.CreateObject("ADODB.Recordset")
	rsRoot.open sqlRoot,conn,1,1
	if rsRoot.bof and rsRoot.eof then 
		response.Write("还没有任何栏目，请首先添加栏目。")
	else
		if ClassID>0 then
			response.write "|<a href='" & ChannelUrl & "'>&nbsp;首页&nbsp;</a>|"
		else
			response.write "|<a href='" & ChannelUrl & "'><font color=red>&nbsp;首页&nbsp;</font></a>|"
		end if
		do while not rsRoot.eof
			if rsRoot(4)<>"" then
				response.write "<a href='" & rsRoot(4) & "' target='_blank'>&nbsp;" & rsRoot(1) & "&nbsp;</a> | "
			else
				if rsRoot(5)>0 then
					if rsRoot(2)=RootID then
						response.Write "<a href='" & rsRoot(3) & "?ClassID=" & rsRoot(0) & "' onMouseOver='ShowMenu(menu" & rsRoot(2) & ",100)'><font color=red>&nbsp;" & rsRoot(1) & "&nbsp;</font></a>|"
					else
						response.Write "<a href='" & rsRoot(3) & "?ClassID=" & rsRoot(0) & "' onMouseOver='ShowMenu(menu" & rsRoot(2) & ",100)'>&nbsp;" & rsRoot(1) & "&nbsp;</a>|"
					end if
				else
					if rsRoot(2)=RootID then
						response.Write "<a href='" & rsRoot(3) & "?ClassID=" & rsRoot(0) & "'><font color=red>&nbsp;" & rsRoot(1) & "&nbsp;</font></a>|"
					else
						response.Write "<a href='" & rsRoot(3) & "?ClassID=" & rsRoot(0) & "'>&nbsp;" & rsRoot(1) & "&nbsp;</a>|"
					end if
				end if
			end if
			rsRoot.movenext
		loop
	end if
	rsRoot.close
	set rsRoot=nothing
	if ShowMyStyle="Yes" then
		response.write "<a href='#' onMouseOver='ShowMenu(menu_skin,100)'>&nbsp;自选风格&nbsp;</a>|"
	end if
end sub

'=================================================
'过程名：ShowJumpClass
'作  用：显示“跳转栏目到…”下拉列表框
'参  数：无
'=================================================
sub ShowJumpClass()
	response.write "<div z-index:1><select name='ClassID' onchange=""if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}"">"
    response.write "<option value='' selected>跳转栏目至…</option>"
	dim arrShowLine(20)
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	dim rsClass,sqlClass,strTemp,tmpDepth,i
	sqlClass="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl From ArticleClass C"
	sqlClass= sqlClass & " inner join Layout L on C.LayoutID=L.LayoutID order by C.RootID,C.OrderID"
	set rsClass=server.CreateObject("adodb.recordset")
	rsClass.open sqlClass,conn,1,1
	if rsClass.bof and rsClass.bof then
		response.write "<option value=''>请先添加栏目</option>"
	else
		do while not rsClass.eof
			tmpDepth=rsClass(2)
			if rsClass(4)>0 then
				arrShowLine(tmpDepth)=True
			else
				arrShowLine(tmpDepth)=False
			end if
			if rsClass(5)="" then
				strTemp="<option value='" & rsClass(3) & "?ClassID=" & rsClass(0) & "'>"
			else
				strTemp="<option value='" & rsClass(5) & "'>"
			end if
			if tmpDepth>0 then
				for i=1 to tmpDepth
					strTemp=strTemp & "&nbsp;&nbsp;"
					if i=tmpDepth then
						if rsClass(4)>0 then
							strTemp=strTemp & "├&nbsp;"
						else
							strTemp=strTemp & "└&nbsp;"
						end if
					else
						if arrShowLine(i)=True then
							strTemp=strTemp & "│"
						else
							strTemp=strTemp & "&nbsp;"
						end if
					end if
				next
			end if
			strTemp=strTemp & rsClass(1)
			if rsClass(5)<>"" then
				strTemp=strTemp & "(外)"
			end if
			strTemp=strTemp & "</option>"
			response.write strTemp
			rsClass.movenext
		loop
	end if
	rsClass.close
	set rsClass=nothing
	response.write "</select></div>"
end sub

'=================================================
'过程名：ShowClass_Tree
'作  用：显示所有栏目（树形目录效果）
'参  数：无
'=================================================
sub ShowClass_Tree()
	dim arrShowLine(20)
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	dim rsClass,sqlClass,tmpDepth,i
	sqlClass="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child From ArticleClass C"
	sqlClass= sqlClass & " inner join Layout L on C.LayoutID=L.LayoutID order by C.RootID,C.OrderID"
	set rsClass=server.CreateObject("adodb.recordset")
	rsClass.open sqlClass,conn,1,1
	if rsClass.bof and rsClass.bof then
		strClassTree="没有任何栏目"
	else
		strClassTree=""
		do while not rsClass.eof
			tmpDepth=rsClass(2)
			if rsClass(4)>0 then
				arrShowLine(tmpDepth)=True
			else
				arrShowLine(tmpDepth)=False
			end if
			if tmpDepth>0 then
				for i=1 to tmpDepth
					if i=tmpDepth then
						if rsClass(4)>0 then
							strClassTree=strClassTree & "<img src='images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
						else
							strClassTree=strClassTree & "<img src='images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
						end if
					else
						if arrShowLine(i)=True then
							strClassTree=strClassTree & "<img src='images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
						else
							strClassTree=strClassTree & "<img src='images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
						end if
					end if
				next
			end if
			if rsClass(6)>0 then 
				strClassTree=strClassTree & "<img src='Images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>" 
			else 
				strClassTree=strClassTree & "<img src='Images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>" 
			end if 
			if rsClass(5)="" then
				strClassTree=strClassTree & "<a href='" & rsClass(3) & "?ClassID=" & rsClass(0) & "'>"
			else
				strClassTree=strClassTree & "<a href='" & rsClass(5) & "' target='_blank'>"
			end if
			if rsClass(2)=0 then 
				strClassTree=strClassTree & "<b>"  & rsClass(1) & "</b>"
			else
				strClassTree=strClassTree & rsClass(1)
			end if 
			'if rsClass(5)<>"" then
			'	strClassTree=strClassTree & "(外)"
			'end if
			strClassTree=strClassTree & "</a>"
			if rsClass(6)>0 then 
				strClassTree=strClassTree & "（" & rsClass(6) & "）" 
			end if 
			strClassTree=strClassTree & "<br>"
			rsClass.movenext
		loop
	end if
	rsClass.close
	set rsClass=nothing
	response.write strClassTrue
end sub


'=================================================
'过程名：ShowSpecial
'作  用：以竖向列表方式显示专题名称
'参  数：SpecialNum  ------最多显示多少个专题名称
'=================================================
sub ShowSpecial(SpecialNum)
	dim i
	i=1
	if SpecialNum<=0 or SpecialNum>100 then
		SpecialNum=10
	end if
	sqlSpecial="select S.SpecialID,S.SpecialName,L.LayoutFileName from Special S inner join Layout L on L.LayoutID=S.LayoutID where S.BrowsePurview>=" & UserLevel & " order by S.OrderID"
	Set rsSpecial= Server.CreateObject("ADODB.Recordset")
	rsSpecial.open sqlSpecial,conn,1,1
	totalPut=rsSpecial.recordcount
	if rsSpecial.bof and rsSpecial.eof then 
		response.Write "&nbsp;没有任何专题栏目"
	else
		rsSpecial.movefirst
		do while not rsSpecial.eof
			response.Write("<li><a href='" & rsSpecial(2) & "?SpecialID=" & rsSpecial(0) & "'>" & rsSpecial(1) & "</a></li><br>")
			rsSpecial.movenext
			i=i+1
			if i>SpecialNum then exit do
		loop
	end if
	if not rsSpecial.eof then
		response.write "<p align='right'><a href='Special.asp'>更多专题</a></p>"
	end if
end sub

'=================================================
'过程名：ShowAllSpecial
'作  用：分页显示所有专题
'参  数：无
'=================================================
sub ShowAllSpecial()
	sqlSpecial="select S.SpecialID,S.SpecialName,L.LayoutFileName from Special S inner join Layout L on L.LayoutID=S.LayoutID where S.BrowsePurview>=" & UserLevel & " order by S.OrderID"
	Set rsSpecial= Server.CreateObject("ADODB.Recordset")
	rsSpecial.open sqlSpecial,conn,1,1
	totalPut=rsSpecial.recordcount
	if rsSpecial.bof and rsSpecial.eof then 
		response.Write "&nbsp;没有任何专题栏目"
	else
		if currentpage<1 then
			currentpage=1
		end if
		if (currentpage-1)*MaxPerPage>totalput then
			if (totalPut mod MaxPerPage)=0 then
				currentpage= totalPut \ MaxPerPage
			else
				currentpage= totalPut \ MaxPerPage + 1
			end if
		end if
		if currentPage=1 then
			call SpecialContent()
		else
			if (currentPage-1)*MaxPerPage<totalPut then
         	   	rsSpecial.move  (currentPage-1)*MaxPerPage
         		dim bookmark
           		bookmark=rsSpecial.bookmark
            	call SpecialContent()
        	else
	        	currentPage=1
           		call SpecialContent()
	    	end if
		end if
	end if
end sub

sub SpecialContent()
	dim i
	i=1
	do while not rsSpecial.eof
		response.Write("<li><a href='" & rsSpecial(2) & "?SpecialID=" & rsSpecial(0) & "'>" & rsSpecial(1) & "</a></li><br>")
		rsSpecial.movenext
		i=i+1
		if i>=MaxPerPage then exit do	
	loop
end sub

'=================================================
'过程名：ShowSiteCount
'作  用：显示站点统计信息
'参  数：无
'=================================================
sub ShowSiteCount()
	dim sqlCount,rsCount
	Set rsCount= Server.CreateObject("ADODB.Recordset")
	sqlCount="select count(ArticleID) from Article"
	rsCount.open sqlCount,conn,1,1
	response.write "文章总数：" & rsCount(0) & "篇<br>"
	rsCount.close

	sqlCount="select count(ArticleID) from Article where Passed=False"
	rsCount.open sqlCount,conn,1,1
	response.write "待审文章：" & rsCount(0) & "篇<br>"
	rsCount.close
	
	sqlCount="select count(CommentID) from Comment"
	rsCount.open sqlCount,conn,1,1
	response.write "评论总数：" & rsCount(0) & "条<br>"
	rsCount.close
	
	sqlCount="select count(SpecialID) from Special"
	rsCount.open sqlCount,conn,1,1
	response.write "专题总数：" & rsCount(0) & "个<br>"
	rsCount.close

	sqlCount="select count(UserID) from [User]"
	rsCount.open sqlCount,conn,1,1
	response.write "注册用户：" & rsCount(0) & "名<br>"
	rsCount.close
	
	sqlCount="select sum(Hits) from article"
	rsCount.open sqlCount,conn,1,1
	response.write "文章阅读：" & rsCount(0) & "人次<br>"
	rsCount.close
	
	set rsCount=nothing
end sub

'=================================================
'过程名：ShowVote
'作  用：显示网站调查
'参  数：无
'=================================================
sub ShowVote()
	dim sqlVote,rsVote,i
	sqlVote="select top 1 * from Vote where IsSelected=True"
	Set rsVote= Server.CreateObject("ADODB.Recordset")
	rsVote.open sqlVote,conn,1,1
	if rsVote.bof and rsVote.eof then 
		response.Write "&nbsp;没有任何调查"
	else
		response.write "<form name='VoteForm' method='post' action='vote.asp' target='_blank'>"
		response.write "&nbsp;&nbsp;&nbsp;&nbsp;" & rsVote("Title") & "<br>"
		if rsVote("VoteType")="Single" then
			for i=1 to 8
				if trim(rsVote("Select" & i) & "")="" then exit for
				response.Write "<input type='radio' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
			next
		else
			for i=1 to 8
				if trim(rsVote("Select" & i) & "")="" then exit for
				response.Write "<input type='checkbox' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
			next
		end if
		response.write "<br><input name='VoteType' type='hidden'value='" & rsVote("VoteType") & "'>"
		response.write "<input name='Action' type='hidden' value='Vote'>"
		response.write "<input name='ID' type='hidden' value='" & rsVote("ID") & "'>"
		response.write "<div align='center'>"
		response.write "<a href='javascript:VoteForm.submit();'><img src='images/voteSubmit.gif' width='52' height='18' border='0'></a>&nbsp;&nbsp;"
        response.write "<a href='Vote.asp?ID=" & rsVote("ID") & "&Action=Show' target='_blank'><img src='images/voteView.gif' width='52' height='18' border='0'></a>"
		response.write "</div></form>"
	end if
	rsVote.close
	set rsVote=nothing
end sub

'=================================================
'过程名：ShowArticle
'作  用：分页显示文章标题等信息
'参  数：TitleLen  ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowArticle(TitleLen)
	if TitleLen<0 or TitleLen>200 then
		TitleLen=50
	end if

	sqlArticle=sqlArticle & "select  A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
	sqlArticle=sqlArticle & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
	sqlArticle=sqlArticle & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True "
	if SpecialID>0 then
		sqlArticle=sqlArticle & " and A.SpecialID=" & SpecialID
	end if
	if ClassId>0 then
		sqlArticle=sqlArticle &  " and A.ClassID=" & ClassID
	end if
	sqlArticle=sqlArticle & " order by A.OnTop,A.ArticleID desc"

	Set rsArticle= Server.CreateObject("ADODB.Recordset")
	rsArticle.open sqlArticle,conn,1,1
	if rsArticle.bof and  rsArticle.eof then
		totalput=0
		response.Write("<br><li>没有任何文章</li>")
	else
		totalput=rsArticle.recordcount
		if currentpage<1 then
			currentpage=1
		end if
		if (currentpage-1)*MaxPerPage>totalput then
			if (totalPut mod MaxPerPage)=0 then
				currentpage= totalPut \ MaxPerPage
			else
				currentpage= totalPut \ MaxPerPage + 1
			end if
		end if

		if currentPage=1 then
			call ArticleContent(TitleLen,True,True,True,2,True,True)
		else
			if (currentPage-1)*MaxPerPage<totalPut then
         	   	rsArticle.move  (currentPage-1)*MaxPerPage
         		dim bookmark
           		bookmark=rsArticle.bookmark
            	call ArticleContent(TitleLen,True,True,True,2,True,True)
        	else
	        	currentPage=1
           		call ArticleContent(TitleLen,True,True,True,2,True,True)
	    	end if
		end if
	end if
	rsArticle.close
	set rsArticle=nothing
end sub

'=================================================
'过程名：ArticleContent
'作  用：显示文章属性、标题、作者、更新日期、点击数等信息
'参  数：intTitleLen  ----标题最多字符数，一个汉字=两个英文字符
'        ShowProperty ----是否显示文章属性（固顶/推荐/普通），True为显示，False为不显示
'        ShowIncludePic ---是否显示“[图文]”字样，True为显示，False为不显示
'        ShowAuthor -------是否显示文章作者，True为显示，False为不显示
'        ShowDateType -----显示更新日期的样式，0为不显示，1为显示年月日，2为只显示月日。
'        ShowHits ---------是否显示文章点击数，True为显示，False为不显示
'        ShowHot ----------是否显示热门文章标志，True为显示，False为不显示
'=================================================
sub ArticleContent(intTitleLen,ShowProperty,ShowIncludePic,ShowAuthor,ShowDateType,ShowHits,ShowHot)
   	dim i,strTemp,TitleStr,Author,AuthorName,AuthorEmail
    i=0
	do while not rsArticle.eof
		strTemp=""
		if ShowProperty=True then
			if rsArticle("OnTop")=true then
				strTemp = strTemp & "<img src='images/article_ontop.gif' alt='固顶文章'>&nbsp;"
			elseif rsArticle("Elite")=true then
				strTemp = strTemp & "<img src='images/article_elite.gif' alt='推荐文章'>&nbsp;"
			else
				strTemp = strTemp & "<img src='images/article_common.gif' alt='普通文章'>&nbsp;"
			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>"
		if ShowAuthor=True or ShowDateType>0 or ShowHits=True then
			strTemp = strTemp & "&nbsp;("
			if ShowAuthor=True then
				if AuthorEmail="" then
					strTemp=strTemp & AuthorName
				else
					strTemp=strTemp & "<a href='mailto:" & AuthorEmail & "'>" & AuthorName & "</a>"
				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
					strTemp= strTemp & month(rsArticle("UpdateTime")) & "月" & 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 & rsArticle("Hits")
			end if
			strTemp=strTemp  & ")"
		end if
		if ShowHot=True and rsArticle("Hits")>=HitsOfHot then
			strTemp= strTemp & "<img src='images/hot.gif' alt='热点文章'>"
		end if
		strTemp= strTemp & "<br>"
		response.write strTemp
		rsArticle.movenext
		i=i+1
		if i>=MaxPerPage then exit do	
	loop
end sub 

'=================================================
'过程名：ShowUserArticle
'作  用：分页显示用户文章标题等信息
'参  数：TitleLen  ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowUserArticle(TitleLen)
	if TitleLen<0 or TitleLen>200 then
		TitleLen=50
	end if

	sqlArticle=sqlArticle & "select  A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
	sqlArticle=sqlArticle & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
	sqlArticle=sqlArticle & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True and Editor='" & UserName & "'"
	if SpecialID>0 then
		sqlArticle=sqlArticle & " and A.SpecialID=" & SpecialID
	end if
	if ClassId>0 then
		sqlArticle=sqlArticle &  " and A.ClassID=" & ClassID
	end if
	sqlArticle=sqlArticle & " order by A.OnTop,A.ArticleID desc"

	Set rsArticle= Server.CreateObject("ADODB.Recordset")
	rsArticle.open sqlArticle,conn,1,1
	if rsArticle.bof and  rsArticle.eof then
		totalput=0
		response.Write("<br><li>没有任何文章</li>")
	else
		totalput=rsArticle.recordcount
		if currentpage<1 then
			currentpage=1
		end if
		if (currentpage-1)*MaxPerPage>totalput then
			if (totalPut mod MaxPerPage)=0 then
				currentpage= totalPut \ MaxPerPage
			else
				currentpage= totalPut \ MaxPerPage + 1
			end if
		end if
		if currentPage=1 then
			call ArticleContent(TitleLen,True,True,True,2,True,True)
		else
			if (currentPage-1)*MaxPerPage<totalPut then
         	   	rsArticle.move  (currentPage-1)*MaxPerPage
         		dim bookmark
           		bookmark=rsArticle.bookmark
            	call ArticleContent(TitleLen,True,True,True,2,True,True)
        	else
	        	currentPage=1
           		call ArticleContent(TitleLen,True,True,True,2,True,True)
	    	end if
		end if
	end if
	rsArticle.close
	set rsArticle=nothing
end sub

'=================================================
'过程名：ShowSearchResult
'作  用：分页显示搜索结果
'参  数：无
'=================================================
sub ShowSearchResult()
	dim arrClassID,trs
	sqlSearch=sqlSearch & "select A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,A.Content,"
	sqlSearch=sqlSearch & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
	sqlSearch=sqlSearch & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True"
	if ClassID>0 then
		if Child>0 then
			arrClassID=ClassID
			set trs=conn.execute("select ClassID from ArticleClass where ParentID=" & ClassID & " or ParentPath like '%" & ParentPath & "," & ClassID & ",%' and Child=0 and LinkUrl='' and BrowsePurview>=" & UserLevel)
			do while not trs.eof
				arrClassID=arrClassID & "," & trs(0)
				trs.movenext
			loop
			set trs=nothing			
			sqlSearch=sqlSearch & " and A.ClassID in (" & arrClassID & ")"
		else
			sqlSearch=sqlSearch & " and A.ClassID=" & ClassID
		end if
	end if
	if keyword<>"" then
		select case strField
			case "Title"
				sqlSearch=sqlSearch & " and A.Title like '%" & keyword & "%' "
			case "Content"
				sqlSearch=sqlSearch & " and A.Content like '%" & keyword & "%' "
			case "Author"
				sqlSearch=sqlSearch & " and A.Author like '%" & keyword & "%' "
			case "Editor"
				sqlSearch=sqlSearch & " and A.Editor like '%" & keyword & "%' "
			case else
				sqlSearch=sqlSearch & " and A.Title like '%" & keyword & "%' "
		end select
	end if
	sqlSearch=sqlSearch & " order by A.Articleid desc"
	Set rsSearch= Server.CreateObject("ADODB.Recordset")
	rsSearch.open sqlSearch,conn,1,1
 	if rsSearch.eof and rsSearch.bof then 
		totalput=0
		response.write "<p align='center'><br><br>没有或没有找到任何文章</p>" 
   	else 
   		totalput=rsSearch.recordcount		
 		if currentpage<1 then
			currentpage=1
		end if
		if (currentpage-1)*MaxPerPage>totalput then
			if (totalPut mod MaxPerPage)=0 then
				currentpage= totalPut \ MaxPerPage
			else
				currentpage= totalPut \ MaxPerPage + 1
			end if
		end if
  		if currentPage=1 then 
       		call SearchResultContent()
   		else 
       		if (currentPage-1)*MaxPerPage<totalPut then 
       			rsSearch.move  (currentPage-1)*MaxPerPage 
       			dim bookmark 
       			bookmark=rsSearch.bookmark 
       			call SearchResultContent()
      		else 
        		currentPage=1 
       			call SearchResultContent()
      		end if 
	   	end if 
   	end if 
   	rsSearch.close 
   	set rsSearch=nothing   
end sub

sub SearchResultContent()
   	dim i,strTemp,content
	i=1
	do while not rsSearch.eof
		strTemp=""
		strTemp=strTemp & cstr(MaxPerPage*(CurrentPage-1)+i) & ".<a href='" & rsSearch("LayoutFileName") & "?ArticleID=" & rsSearch("articleid") & "'>"
		if strField="Title" then
			strTemp=strTemp & "<b>" & replace(rsSearch("title"),""&keyword&"","<font color=red>"&keyword&"</font>") & "</b></font></a>"
		else
			strTemp=strTemp & "<b>" & rsSearch("title") & "</b>"
		end if
		if strField="Author" then
			strTemp=strTemp & "&nbsp;[" & replace(rsSearch("Author"),""&keyword&"","<font color=red>"&keyword&"</font>") & "]"
		else
			strTemp=strTemp & "&nbsp;[" & rsSearch("Author") & "]"
		end if
		strTemp=strTemp & "[" & FormatDateTime(rsSearch("UpdateTime"),1) & "][" & rsSearch("Hits") & "]"
		content=left(nohtml(rsSearch("content")),200)
		if strField="Content" then
			strTemp=strTemp & "<div style='padding:10px 20px'>" & replace(content,""&keyword&"","<font color=red>"&keyword&"</font>") & "……</div>"
		else
			strTemp=strTemp & "<div style='padding:10px 20px'>" & content & "……</div>"
		end if
		strTemp=strTemp & "</a>"
		response.write strTemp
		i=i+1
		if i>MaxPerPage then exit do
		rsSearch.movenext
	loop
end sub 

'=================================================
'过程名：ShowAnnounce
'作  用：显示本站公告信息
'参  数：ShowType ------显示方式，1为纵向，2为横向
'        AnnounceNum  ----最多显示多少条公告
'=================================================
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=True 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>&nbsp;&nbsp;没有通告</p>" 
	else 
		AnnounceCount=rsAnnounce.recordcount
		if ShowType=1 then
			do while not rsAnnounce.eof   
				response.Write "<a href='Announce.asp?ID=" & rsAnnounce("id") &"' title='" & rsAnnounce("Content") & "' target=_Blank>&nbsp;&nbsp;" & rsAnnounce("title") & "</div><div align='right'>" & rsAnnounce("Author") & "&nbsp;<br>" & FormatDateTime(rsAnnounce("DateAndTime"),1) & "</a>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
				rsAnnounce.movenext
			loop
		else
			do while not rsAnnounce.eof   
				response.Write "<p><a href='Announce.asp?ID=" & rsAnnounce("id") &"' title='" & rsAnnounce("Content") & "' target=_Blank>&nbsp;&nbsp;" & rsAnnounce("title") & "&nbsp;&nbsp;[" & rsAnnounce("Author") & "&nbsp;" & FormatDateTime(rsAnnounce("DateAndTime"),1) & "]</a></p>"
				rsAnnounce.movenext
				i=i+1
				if i<AnnounceCount then response.write "<hr>"   
			loop
       	end if	
	end if  
	rsAnnounce.close
	set rsAnnounce=nothing
end sub

'=================================================
'过程名：ShowHot
'作  用：显示热门文章
'参  数：ArticleNum  ----最多显示多少篇文章
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowHot(ArticleNum,TitleLen)
	dim sqlHot,rsHot
	if ArticleNum>0 and ArticleNum<=100 then
		sqlHot="select top " & ArticleNum
	else
		sqlHot="select top 10 "
	end if
	sqlHot=sqlHot & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=False and A.Passed=True And A.Hits>=" & HitsOfHot & " order by A.Hits desc,A.ArticleID desc"
	Set rsHot= Server.CreateObject("ADODB.Recordset")
	rsHot.open sqlHot,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsHot.bof and rsHot.eof then 
		response.write "<li>无热门文章</li>" 
	else 
		do while not rsHot.eof   
			response.Write "<a href='" & rsHot("LayoutFileName") & "?ArticleID=" & rsHot("articleid") &"' title='文章标题：" & rsHot("Title") & vbcrlf & "作    者：" & rsHot("Author") & vbcrlf & "更新时间：" & rsHot("UpdateTime") & vbcrlf & "点击次数：" & rsHot("Hits") & "' target='_blank'>" & gotTopic(rsHot("title"),TitleLen) & "</a>[<font color=#000000>" & rsHot("hits") & "</font>]<br>"
        	rsHot.movenext     
		loop
	end if  
	rsHot.close
	set rsHot=nothing
end sub

'=================================================
'过程名：ShowElite
'作  用：显示推荐文章
'参  数：ArticleNum  ----最多显示多少篇文章
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowElite(ArticleNum,TitleLen)
	dim sqlElite,rsElite
	if ArticleNum>0 and ArticleNum<=100 then
		sqlElite="select top " & ArticleNum
	else
		sqlElite="select top 10 "
	end if
	sqlElite=sqlElite & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=False and A.Passed=True And A.Elite=True order by A.articleid desc"
	Set rsElite= Server.CreateObject("ADODB.Recordset")
	rsElite.open sqlElite,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsElite.bof and rsElite.eof then 
		response.write "<li>无推荐文章</li>" 
	else 
		do while not rsElite.eof   
			response.Write "<li><a href='" & rsElite("LayoutFileName") & "?ArticleID=" & rsElite("articleid") &"' title='文章标题：" & rsElite("Title") & vbcrlf & "作    者：" & rsElite("Author") & vbcrlf & "更新时间：" & rsElite("UpdateTime") & vbcrlf & "点击次数：" & rsElite("Hits") & "' target='_blank'>" & gotTopic(rsElite("title"),TitleLen) & "</a>[<font color=red>" & rsElite("hits") & "</font>]</li><br>"
        	rsElite.movenext     
		loop
	end if  
	rsElite.close
	set rsElite=nothing
end sub

'=================================================
'过程名：ShowLogo
'作  用：显示网站LOGO
'参  数：无
'=================================================
sub ShowLogo()
	if LogoUrl<>"" then
		response.write "<a href='" & SiteUrl & "' title='" & SiteName & "'>"
		if lcase(right(LogoUrl,3))<>"swf" then
			response.write "<img src='" & LogoUrl & "' width='180' height='60' border='0'>"
		else
			Response.Write "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='180' height='60'><param name='movie' value='" & LogoUrl & "'><param name='quality' value='high'><embed src='" & LogoUrl & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='480' height='60'></embed></object>"
		end if
		response.write "</a>"
	else
		response.write "<a href='http://www.asp163.net' title='动力空间'><img src='http://www.asp163.net/article/images/logo.gif' width='180' height='60' border='0'></a>"
	end if
end sub

'=================================================
'过程名：ShowBanner
'作  用：显示网站Banner
'参  数：无
'=================================================
sub ShowBanner()
	if BannerUrl<>"" then
		if lcase(right(BannerUrl,3))="swf" then
			Response.Write "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='480' height='60'><param name='movie' value='" & BannerUrl & "'><param name='quality' value='high'><embed src='" & BannerUrl & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='480' height='60'></embed></object>"
		else
			response.Write "<a href='" & SiteUrl & "' title='" & SiteName & "'><img src='" & BannerUrl & "' width='480' height='60' border='0'></a>"
		end if
	else
		call ShowAD()
	end if
end sub

'=================================================
'过程名：ShowAD
'作  用：显示横幅广告
'参  数：无
'=================================================
sub ShowAD()
	dim sqlAD,rsAD
	sqlAD="select * from Advertisement where IsSelected=True"
	set rsAD=server.createobject("adodb.recordset")
	rsAD.open sqlAD,conn,1,1
	if rsAd.bof and rsAD.eof then
		response.write "<p align=center>没有任何广告</p>"
	else
		if rsAD("isflash")=true then
			Response.Write "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0'"
			if rsAD("ImgWidth")>0 then response.write " width='" & rsAD("ImgWidth") & "'"
			if rsAD("ImgHeight")>0 then response.write " height='" & rsAD("ImgHeight") & "'"
			response.write "><param name='movie' value='" & rsAD("ImgUrl") & "'><param name='quality' value='high'><embed src='" & rsAD("ImgUrl") & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash'"
			if rsAD("ImgWidth")>0 then response.write " width='" & rsAD("ImgWidth") & "'"
			if rsAD("ImgHeight")>0 then response.write " height='" & rsAD("ImgHeight") & "'"
			response.write "></embed></object>"
		else
			response.write "<a href='" & rsAD("SiteUrl") & "' target='_blank' title='" & rsAD("SiteName") & "：" & rsAD("SiteUrl") & "'><img src='" & rsAD("ImgUrl") & "'"
			if rsAD("ImgWidth")>0 then response.write " width='" & rsAD("ImgWidth") & "'"
			if rsAD("ImgHeight")>0 then response.write " height='" & rsAD("ImgHeight") & "'"
			response.write " border='0'></a>"
		end if
	end if
	rsAD.close
	set rsAD=nothing
end sub

'=================================================
'过程名：ShowCorrelative
'作  用：显示相关文章
'参  数：ArticleNum  ----最多显示多少篇文章
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowCorrelative(ArticleNum,TitleLen)
	dim rsCorrelative,sqlCorrelative
	dim strKey,arrKey,i
	if ArticleNum>0 and ArticleNum<=100 then
		sqlCorrelative="select top " & ArticleNum
	else	
		sqlCorrelative="Select Top 5 "
	end if
	strKey=mid(rs("Key"),2,len(rs("Key"))-2)
	if instr(strkey,"|")>1 then
		arrKey=split(strKey,"|")
		strKey="((A.Key like '|%" & arrKey(0) & "|%')"
		for i=1 to ubound(arrKey)
			strKey=strKey & " or (A.Key like '%|" & arrKey(i) & "|%')"
		next
		strKey=strKey & ")"
	else
		strKey="(A.Key like '%|" & strKey & "%|')"
	end if
	sqlCorrelative=sqlCorrelative & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName From Article A inner join Layout L on L.LayoutID=A.LayoutID Where A.Deleted=False and A.Passed=True and " & strKey & " and A.ArticleID<>" & ArticleID & " Order by A.ArticleID desc"
	Set rsCorrelative= Server.CreateObject("ADODB.Recordset")
	rsCorrelative.open sqlCorrelative,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsCorrelative.bof and rsCorrelative.Eof then
		response.write "没有相关文章"
	else
	 	do while not rsCorrelative.eof	
			response.write "<li><a href='" & rsCorrelative("LayoutFileName") & "?ArticleID=" & rsCorrelative("ArticleID") & "' title='文章标题：" & rsCorrelative("Title") & vbcrlf & "作    者：" & rsCorrelative("Author") & vbcrlf & "更新时间：" & rsCorrelative("UpdateTime") & vbcrlf & "点击次数：" & rsCorrelative("Hits") & "'>" & gotTopic(rsCorrelative("Title"),TitleLen) & "</a>[<font color=red>" & rsCorrelative("hits") & "</font>]</li><br>"
			rsCorrelative.movenext
		loop
	end if
	rsCorrelative.close
	set rsCorrelative=nothing
end sub

'=================================================
'过程名：ShowComment
'作  用：显示相关评论
'参  数：ArticleNum  ----最多显示多少篇文章
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowComment(CommentNum)
	dim rsComment,sqlComment
	if CommentNum>0 and CommentNum<=100 then
		sqlComment="select top " & CommentNum
	else
		sqlComment="select top 10 "
	end if
	sqlComment=sqlComment & " * from Comment where ArticleID=" & ArticleID & " order by CommentID desc"
	Set rsComment= Server.CreateObject("ADODB.Recordset")
	rsComment.open sqlComment,conn,1,1
	if rsComment.bof and rsComment.eof then
		response.write "&nbsp;&nbsp;&nbsp;&nbsp;没有任何评论"
	else
		do while not rsComment.eof
			response.write "<li>会员<font color='blue'>" & rsComment("UserName") & "</font>于" & rsComment("WriteTime") & "发表评论说：&nbsp;&nbsp;" & rsComment("Title") & "<br>&nbsp;&nbsp;&nbsp;&nbsp;" & rsComment("Content") & "</li><br>"
			rsComment.movenext
		loop
		response.write "<div align='right'><a href='CommentShow.asp?ArticleID=" & ArticleID & "'>查看关于此文章的所有评论</a></div>"
	end if
end sub

'=================================================
'过程名：ShowPrevArticle
'作  用：显示上一篇文章
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowPrevArticle(TitleLen)
	dim rsPrev,sqlPrev
	sqlPrev="Select Top 1 A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName From Article A inner join Layout L on A.LayoutID=L.LayoutID Where Deleted=False and Passed=True and ClassID=" & rs("ClassID") & " and ArticleID<" & rs("ArticleID")& " order by ArticleID DESC"
	Set rsPrev= Server.CreateObject("ADODB.Recordset")
	rsPrev.open sqlPrev,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsPrev.Eof then
	  	response.write "没有了"
	else
		response.write "<a href='" & rsPrev("LayoutFileName") & "?ArticleID=" & rsPrev("ArticleID")& "' title='文章标题：" & rsPrev("Title") & vbcrlf & "作    者：" & rsPrev("Author") & vbcrlf & "更新时间：" & rsPrev("UpdateTime") & vbcrlf & "点击次数：" & rsPrev("Hits") &"'>" & gotTopic(rsPrev("Title"),TitleLen) & "</a>"
	end if
	rsPrev.close
	set rsPrev=nothing
end sub

'=================================================
'过程名：ShowNextArticle
'作  用：显示上一篇文章
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowNextArticle(TitleLen)
	dim rsNext,sqlNext
	sqlNext="Select Top 1 A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName From Article A inner join Layout L on A.LayoutID=L.LayoutID Where Deleted=False and Passed=True and ClassID=" & rs("ClassID") & " and ArticleID>" & rs("ArticleID")& " order by ArticleID ASC"
	Set rsNext= Server.CreateObject("ADODB.Recordset")
	rsNext.open sqlNext,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsNext.Eof then
	 	response.write "没有了"
	else
	  	response.write "<a href='"& rsNext("LayoutFileName") & "?ArticleID="&rsNext("ArticleID")& "' title='文章标题：" & rsNext("Title") & vbcrlf & "作    者：" & rsNext("Author") & vbcrlf & "更新时间：" & rsNext("UpdateTime") & vbcrlf & "点击次数：" & rsNext("Hits") &"'>" & gotTopic(rsNext("Title"),TitleLen) & "</a>"
	end if
	rsNext.close
	set rsNext=nothing
end sub
sub Bottom()
	dim strTemp
	strTemp="<table width='760' align='center' border='0' class='border' cellpadding='0' cellspacing='0' bgcolor='#FFFFFF'><tr height='22' align='center' class='title'><td>"
	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' class='tdbg' height='20' valign='bottom'><td>"
	strTemp= strTemp & Copyright
	'strTemp= strTemp & "版"&"权"&"所"&"有 Cop" & "yri"&"ght &co"&"py 2003 <a href='" & SiteUrl & "' target='_blank'>" & SiteName & "</a>"
	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;"
		'strTemp= strTemp & "</td></tr><tr align='center' class='tdbg' height='16' valign='bottom'><td>"
		strTemp= strTemp & "页"&"面"&"执"&"行"&"时"&"间：" & CStr((Timer-BeginTime)*1000) & "毫秒"
	end if
	'strTemp= strTemp & "<b><a href='http://www.asp"&"163.net/article' target='_blank'>动"&"力"&"文"&"章"&"管"&"理"&"系"&"统</a>&nbsp;&nbsp;"
	'strTemp= strTemp & "<a href='http://www.asp"&"163.net/download' target='_blank'>V2.0 Bu"&"ild 200"&"30320 正"&"式"&"版</a></b>&nbsp;&nbsp;"
	'strTemp= strTemp & "设"&"计"&"制"&"作：<a href='mailto:web"&"web@"&"3niao.com'>3NI"&"AO</a>&nbsp;&nbsp;"
	'strTemp= strTemp & "授"&"权"&"使"&"用：<a href='" & SiteUrl & "'>" & SiteName & "</a>"
	'strTemp= strTemp & "</td></tr><tr align='center' class='tdbg' height='16' valign='bottom'><td>"
	strTemp= strTemp & "<br>Pow"&"er Sys"&"tem Of Art"&"icle Mana"&"gement Ver 3.0 Bu"&"ild 200"&"30628. Powe"&"red by <a href='mailto:we"&"b@3"&"niaio.com'>3NI"&"AO</a>."
	strTemp= strTemp & "</td></tr></table>"
	response.write strTemp
end sub


'=================================================
'过程名：ShowPicArticle
'作  用：显示图片文章
'参  数：intClassID  ----栏目ID，0为所有栏目，若大于0，则显示指定栏目及其子栏目的图片文章
'        ArticleNum  ----最多显示多少篇文章
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'        ShowType   ----显示方式。1为只有图片+标题，2为图片+标题+内容简介
'        Cols       ----列数。超过此列数就换行。
'        ImgWidth   ----图片宽度
'        ImgHeight  ----图片高度
'        ContentLen ----内容最多字符数
'        Hot        ----是否是热门文章
'        Elite      ----是否是推荐文章
'=================================================
sub ShowPicArticle(intClassID,ArticleNum,TitleLen,ShowType,Cols,ImgWidth,ImgHeight,ContentLen,Hot,Elite)
	dim sqlPic,i,tClass,trs,arrClassID
	if ArticleNum<0 or ArticleNum>=50 then
		ArticleNum=5
	end if
	if ShowType<>1 and ShowType<>2 then
		ShowType=1
	end if
	if Cols<=0 or Cols>=10 then
		Cols=5
	end if
	if ImgWidth<0 or ImgWidth>500 then
		ImgWidth=150
	end if
	if ImgHeight<0 or ImgHeight>500 then
		ImgHeight=150
	end if
	if Hot<>True and Hot<>False then
		Hot=False
	end if
	if Elite<>True and Elite<>False then
		Elite=False
	end if

	sqlPic="select top " & ArticleNum
	sqlPic=sqlPic & " A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Key,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
	if ShowType=2 then
		sqlPic=sqlPic & "A.Content,"
	end if
	sqlPic=sqlPic & " A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
	sqlPic=sqlPic & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=False and A.Passed=True and DefaultPicUrl<>''"

	if intClassID>0 then
		set tClass=conn.execute("select ClassID,Child,ParentPath from ArticleClass where ClassID=" & intClassID)
		if not(tClass.bof and tClass.eof) then
			if tClass(1)>0 then
				arrClassID=ClassID
				set trs=conn.execute("select ClassID from ArticleClass where ParentID=" & tClass(0) & " or ParentPath like '%" & tClass(2) & "," & tClass(0) & ",%' and Child=0 and LinkUrl=''")
				do while not trs.eof
					arrClassID=arrClassID & "," & trs(0)
					trs.movenext
				loop
				set trs=nothing	
				sqlPic=sqlPic & " and A.ClassID in (" & arrClassID & ")"
			else
				sqlPic=sqlPic & " and A.ClassID=" & tClass(0)
			end if
			set trs=nothing
		else
			sqlPic=sqlPic & " and A.ClassID=" & tClass(0)
		end if
		set tClass=nothing
	end if
	if Hot=True then
		sqlPic=sqlPic & " and A.Hits>=" & HitsOfHot
	end if
	if Elite=True then
		sqlPic=sqlPic & " and A.Elite=True "
	end if
	sqlPic=sqlPic & " order by A.OnTop,A.ArticleID desc"
	set rsPic=Server.CreateObject("ADODB.Recordset")
	rsPic.open sqlPic,conn,1,1
	strPic= "<table width='100%' cellpadding='0' cellspacing='5' border='0' align='center'><tr valign='top'>"
	if rsPic.bof and rsPic.eof then
		strPic= strPic & "<td align='center'><img src='images/NoPic.jpg' width='" & ImgWidth & "' height='" & ImgHeight & "' border='0'><br>没有任何图片文章</td>"
	else
		i=0
		if ShowType=1 then
			do while not rsPic.eof
				strPic=strPic & "<td align='center'>"
				call GetPicArticleTitle(TitleLen,ImgWidth,ImgHeight)
				strPic=strPic & "</td>"
				rsPic.movenext
				i=i+1
				if ((i mod Cols=0) and (not rsPic.eof)) then strPic=strPic & "</tr><tr valign='top'>"
			loop
		elseif ShowType=2 then
			do while not rsPic.eof
				strPic=strPic & "<td align='center'>"
				call GetPicArticleTitle(TitleLen,ImgWidth,ImgHeight)
				strPic=strPic & "</td><td valign='top' algin='center' class='left'><a href='" & rsPic("LayoutFileName") & "?ArticleID=" & rsPic("ArticleID") & "'>" & left(nohtml(rsPic("Content")),ContentLen) & "……</a></td>"
				rsPic.movenext
				i=i+1
				if ((i mod Cols=0) and (not rsPic.eof)) then strPic=strPic & "</tr><tr valign='top'>"
			loop
		end if
		
	end if
	strPic=strPic &  "</tr></table>"
	response.write strPic
	rsPic.close
end sub

'=================================================
'过程名：GetPicArticleTitle
'作  用：显示图片文章的标题
'参  数：intTitleLen  ----标题最多字符数，一个汉字=两个英文字符
'        intImgWidth   ----图片宽度
'        intImgHeight  ----图片高度
'=================================================
sub GetPicArticleTitle(intTitleLen,intImgWidth,intImgHeight)
	dim FileType,TitleStr
	FileType=right(lcase(rsPic("DefaultPicUrl")),3)
	TitleStr=gotTopic(rsPic("Title"),intTitleLen)
	strPic=strPic & "<a href='" & rsPic("LayoutFileName") & "?ArticleID=" & rsPic("ArticleID") & "' title='文章标题：" & rsPic("Title") & vbcrlf & "作    者：" & rsPic("Author") & vbcrlf & "更新时间：" & rsPic("UpdateTime") & vbcrlf & "点击次数：" & rsPic("Hits") & "' target='_blank'>"
	if FileType="swf" then
		strPic=strPic & "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='" & intImgWidth & "' height='" & intImgHeight & "'><param name='movie' value='" & rsPic("DefaultPicUrl") & "'><param name='quality' value='high'><embed src='" & rsPic("DefaultPicUrl") & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='" & intImgWidth & "' height='" & intImgHeight & "'></embed></object>"
	elseif fileType="jpg" or fileType="bmp" or fileType="png" or fileType="gif" then
		strPic=strPic & "<img src='" & rsPic("DefaultPicUrl") & "' width='" & intImgWidth & "' height='" & intImgHeight & "' border='0'>"
	else
		strPic=strPic & "<img src='images/NoPic.jpg2' width='" & intImgWidth & "' height='" & intImgHeight & "' border='0'>"
	end if
	if rsPic("TitleFontType")=1 then
		TitleStr="<b>" & TitleStr & "</b>"
	elseif rsPic("TitleFontType")=2 then
		TitleStr="<em>" & TitleStr & "</em>"
	elseif rsPic("TitleFontType")=3 then
		TitleStr="<b><em>" & TitleStr & "</em></b>"
	end if
	if rsPic("TitleFontColor")<>"" then
		TitleStr="<font color='" & rsPic("TitleFontColor") & "'>" & TitleStr & "</font>"
	end if
	strPic=strPic & "<br>" & TitleStr & "</a>"
end sub

'=================================================
'过程名：MenuJS
'作  用：生成下拉菜单相关的JS代码
'参  数：无
'=================================================
sub MenuJS()
%>
<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)
{
		vDiv = document.all("menuDiv");
		mX = window.event.clientX + document.body.scrollLeft;
		mY = window.event.clientY + document.body.scrollTop;
		if ((mX < parseInt(vDiv.style.left)) || (mX > parseInt(vDiv.style.left)+vDiv.offsetWidth) || (mY < parseInt(vDiv.style.top)-h) || (mY > parseInt(vDiv.style.top)+vDiv.offsetHeight)){
			vDiv.style.visibility = "hidden";
			isvisible = false;
		}
}
}

function ShowMenu(vMnuCode,tWidth) {
	vSrc = window.event.srcElement;
	vMnuCode = "<table id='submenu' cellspacing=1 cellpadding=3 style='width:"+tWidth+"' class=menu onmouseout='HideMenu()'><tr height=23><td nowrap align=left class=MenuBody>" + vMnuCode + "</td></tr></table>";

	h = vSrc.offsetHeight;
	w = vSrc.offsetWidth;
	l = vSrc.offsetLeft + leftMar+4;
	t = vSrc.offsetTop + topMar + h + space-2;
	vParent = vSrc.offsetParent;
	while (vParent.tagName.toUpperCase() != "BODY")
	{
		l += vParent.offsetLeft;
		t += vParent.offsetTop;
		vParent = vParent.offsetParent;
	}

	menuDiv.innerHTML = vMnuCode;
	menuDiv.style.top = t;
	menuDiv.style.left = l;
	menuDiv.style.visibility = "visible";
	isvisible = true;
    makeRectangularDropShadow(submenu, MENU_SHADOW_COLOR, 4)
}

function makeRectangularDropShadow(el, color, size)
{
	var i;
	for (i=size; i>0; i--)
	{
		var rect = document.createElement('div');
		var rs = rect.style
		rs.position = 'absolute';
		rs.left = (el.style.posLeft + i) + 'px';
		rs.top = (el.style.posTop + i) + 'px';
		rs.width = el.offsetWidth + 'px';
		rs.height = el.offsetHeight + 'px';
		rs.zIndex = el.style.zIndex - i;
		rs.backgroundColor = color;
		var opacity = 1 - i / (i + 1);
		rs.filter = 'alpha(opacity=' + (100 * opacity) + ')';
		el.insertAdjacentElement('afterEnd', rect);
		global.fo_shadows[global.fo_shadows.length] = rect;
	}
}
</script>
<%
	response.write "<script language='JavaScript' type='text/JavaScript'>" & vbcrlf
	response.write "//菜单列表" & vbcrlf

	dim arrShowLine(20)
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	
	dim sqlMenu,rsMenu,strMenu,PrevRootID,tmpDepth,i
	sqlMenu="select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,C.LinkUrl,C.Child,C.Depth,C.NextID From ArticleClass C"
	sqlMenu= sqlMenu & " inner join Layout L on C.LayoutID=L.LayoutID where C.Depth>=1 order by C.RootID,C.OrderID"
	Set rsMenu= Server.CreateObject("ADODB.Recordset")
	rsMenu.open sqlMenu,conn,1,1
	PrevRootID=0
	if not(rsMenu.bof and rsMenu.eof) then
		tmpDepth=rsMenu(6)
		if rsMenu(7)>0 then
			arrShowLine(tmpDepth)=True
		else
			arrShowLine(tmpDepth)=False
		end if
		strMenu="var menu" & rsMenu(2) & "=" & chr(34)

		for i=1 to tmpDepth
			if i=tmpDepth then
				if rsMenu(7)>0 then
					strMenu=strMenu & "<img src='images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
				else
					strMenu=strMenu & "<img src='images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
				end if
			else
				if arrShowLine(i)=True then
					strMenu=strMenu & "<img src='images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
				else
					strMenu=strMenu & "<img src='images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
				end if
			end if
		next
		if rsMenu(5)>0 then 
			strMenu=strMenu & "<img src='Images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>" 
		else 
			strMenu=strMenu & "<img src='Images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>" 
		end if 
			
		if rsMenu(4)<>"" then
			strMenu=strMenu & "<a style=font-size:9pt;line-height:14pt; href='" & rsMenu(4) & "'>" & rsMenu(1) & "</a><br>"
		else
			strMenu=strMenu & "<a style=font-size:9pt;line-height:14pt; href='" & rsMenu(3) & "?ClassID=" & rsMenu(0) & "'>" & rsMenu(1) & "</a><br>"
		end if
			
		PrevRootID=rsMenu(2)
		rsMenu.movenext
		do while not rsMenu.eof
			if rsMenu(2)<>PrevRootID then
				strMenu=strMenu & chr(34) & ";" & vbcrlf & "var menu" & rsMenu(2) & "=" & chr(34)
			end if

			tmpDepth=rsMenu(6)
			if rsMenu(7)>0 then
				arrShowLine(tmpDepth)=True
			else
				arrShowLine(tmpDepth)=False
			end if
			for i=1 to tmpDepth
				if i=tmpDepth then
					if rsMenu(7)>0 then
						strMenu=strMenu & "<img src='images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
					else
						strMenu=strMenu & "<img src='images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
					end if
				else
					if arrShowLine(i)=True then
						strMenu=strMenu & "<img src='images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
					else
						strMenu=strMenu & "<img src='images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
					end if
				end if
			next
			if rsMenu(5)>0 then 
				strMenu=strMenu & "<img src='Images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>" 
			else 
				strMenu=strMenu & "<img src='Images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>" 
			end if 
			
			if rsMenu(4)<>"" then
				strMenu=strMenu & "<a style=font-size:9pt;line-height:14pt; href='" & rsMenu(4) & "' target='_blank'>" & rsMenu(1) & "</a>"
			else
				strMenu=strMenu & "<a style=font-size:9pt;line-height:14pt; href='" & rsMenu(3) & "?ClassID=" & rsMenu(0) & "'>" & rsMenu(1) & "</a>"
			end if
			strMenu=strMenu & "<br>"
			
			PrevRootID=rsMenu(2)
			rsMenu.movenext
		loop
		strMenu=strMenu & chr(34) & ";" & vbcrlf
		response.write strMenu
	end if
	rsMenu.close
	set rsMenu=nothing
	
	if ShowMyStyle="Yes" then
		'自选风格的菜单定义
		strMenu="var menu_skin=" & chr(34)
		dim rsSkin
		set rsSkin=conn.execute("select SkinID,SkinName from Skin")
		do while not rsSkin.eof
			strMenu=strMenu & "&nbsp;<a style=font-size:9pt;line-height:14pt; href='SetCookie.asp?Action=SetSkin&ClassID=" & ClassID & "&SkinID=" & rsSkin(0) & "'>" & rsSkin(1) & "</a><br>"
			rsSkin.movenext
		loop
		rsSkin.close
		set rsSkin=nothing
		response.write strMenu & chr(34) & ";" & vbcrlf
	end if
	response.write "</script>" & vbcrlf
end sub


'=================================================
'过程名：PopAnnouceWindow
'作  用：弹出公告窗口
'参  数：无
'=================================================
sub PopAnnouceWindow(Width,Height)
	if AnnounceCount>0 and PopAnnounce="Yes" and session("Poped")="" then
		response.write "<script LANGUAGE='JavaScript'>"
		response.write "window.open ('Announce.asp', 'newwindow', 'height=" & Height & ", width=" & Width & ", toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"
		response.write "</script>"
		session("Poped")="Yes"
	end if
end sub

'=================================================
'过程名：ShowArticleContent
'作  用：显示文章具体的内容，可以分页显示
'参  数：无
'=================================================
sub ShowArticleContent()
	dim PaginationType
	PaginationType=rs("PaginationType")
	select case PaginationType
		case 0    '不分页显示
			response.write rs("Content")
		case 1    '自动分页显示
			call AutoPagination()
		case 2    '手动分页显示
			call ManualPagination()
	end select
end sub

'=================================================
'过程名：ManualPagination
'作  用：采用手动分页方式显示文章具体的内容
'参  数：无
'=================================================
sub ManualPagination()
	dim ArticleID,strContent,CurrentPage
	dim ContentLen,MaxPerPage,pages,i
	dim arrContent
	ArticleID=rs("ArticleID")
	strContent=rs("Content")
	ContentLen=len(strContent)
	CurrentPage=trim(request("ArticlePage"))
	if Instr(strContent,"[NextPage]")<=0 then
		response.write strContent
		response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
	else
		arrContent=split(strContent,"[NextPage]")

		pages=Ubound(arrContent)+1
		if CurrentPage="" then
			CurrentPage=1
		else
			CurrentPage=Cint(CurrentPage)
		end if
		if CurrentPage<1 then CurrentPage=1
		if CurrentPage>pages then CurrentPage=pages

		response.write arrContent(CurrentPage-1)

		response.write "</p><p align='center'><b>"
		if CurrentPage>1 then
			response.write "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & CurrentPage-1 & "'>上一页</a>&nbsp;&nbsp;"
		end if
		for i=1 to pages
			if i=CurrentPage then
				response.write "<font color='red'>[" & cstr(i) & "]</font>&nbsp;"
			else
				response.write "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & i & "'>[" & i & "]</a>&nbsp;"
			end if
		next
		if CurrentPage<pages then
			response.write "&nbsp;<a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & CurrentPage+1 & "'>下一页</a>"
		end if
		response.write "</b></p>"
		
	end if

end sub
'=================================================
'过程名：AutoPagination
'作  用：采用自动分页方式显示文章具体的内容
'参  数：无
'=================================================
sub AutoPagination()
	dim ArticleID,strContent,CurrentPage
	dim ContentLen,MaxPerPage,pages,i,lngBound
	dim BeginPoint,EndPoint
	ArticleID=rs("ArticleID")
	strContent=rs("Content")
	ContentLen=len(strContent)
	CurrentPage=trim(request("ArticlePage"))
	if ContentLen<=rs("MaxCharPerPage") then
		response.write strContent
		response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
	else
		if CurrentPage="" then
			CurrentPage=1
		else
			CurrentPage=Cint(CurrentPage)
		end if
		pages=ContentLen\rs("MaxCharPerPage")
		if rs("MaxCharPerPage")*pages<ContentLen then
			pages=pages+1
		end if
		lngBound=ContentLen          '最大误差范围
		if CurrentPage<1 then CurrentPage=1
		if CurrentPage>pages then CurrentPage=pages

		dim lngTemp
		dim lngTemp1,lngTemp1_1,lngTemp1_2,lngTemp1_1_1,lngTemp1_1_2,lngTemp1_1_3,lngTemp1_2_1,lngTemp1_2_2,lngTemp1_2_3
		dim lngTemp2,lngTemp2_1,lngTemp2_2,lngTemp2_1_1,lngTemp2_1_2,lngTemp2_2_1,lngTemp2_2_2
		dim lngTemp3,lngTemp3_1,lngTemp3_2,lngTemp3_1_1,lngTemp3_1_2,lngTemp3_2_1,lngTemp3_2_2
		dim lngTemp4,lngTemp4_1,lngTemp4_2,lngTemp4_1_1,lngTemp4_1_2,lngTemp4_2_1,lngTemp4_2_2
		dim lngTemp5,lngTemp5_1,lngTemp5_2
		dim lngTemp6,lngTemp6_1,lngTemp6_2
		
		if CurrentPage=1 then
			BeginPoint=1
		else
			BeginPoint=rs("MaxCharPerPage")*(CurrentPage-1)+1
			
			lngTemp1_1_1=instr(BeginPoint,strContent,"</table>",1)
			lngTemp1_1_2=instr(BeginPoint,strContent,"</TABLE>",1)
			lngTemp1_1_3=instr(BeginPoint,strContent,"</Table>",1)
			if lngTemp1_1_1>0 then
				lngTemp1_1=lngTemp1_1_1
			elseif lngTemp1_1_2>0 then
				lngTemp1_1=lngTemp1_1_2
			elseif lngTemp1_1_3>0 then
				lngTemp1_1=lngTemp1_1_3
			else
				lngTemp1_1=0
			end if
							
			lngTemp1_2_1=instr(BeginPoint,strContent,"<table",1)
			lngTemp1_2_2=instr(BeginPoint,strContent,"<TABLE",1)
			lngTemp1_2_3=instr(BeginPoint,strContent,"<Table",1)
			if lngTemp1_2_1>0 then
				lngTemp1_2=lngTemp1_2_1
			elseif lngTemp1_2_2>0 then
				lngTemp1_2=lngTemp1_2_2
			elseif lngTemp1_2_3>0 then
				lngTemp1_2=lngTemp1_2_3
			else
				lngTemp1_2=0
			end if
			
			if lngTemp1_1=0 and lngTemp1_2=0 then
				lngTemp1=BeginPoint
			else
				if lngTemp1_1>lngTemp1_2 then
					lngtemp1=lngTemp1_2
				else
					lngTemp1=lngTemp1_1+8
				end if
			end if

			lngTemp2_1_1=instr(BeginPoint,strContent,"</p>",1)
			lngTemp2_1_2=instr(BeginPoint,strContent,"</P>",1)
			if lngTemp2_1_1>0 then
				lngTemp2_1=lngTemp2_1_1
			elseif lngTemp2_1_2>0 then
				lngTemp2_1=lngTemp2_1_2
			else
				lngTemp2_1=0
			end if
						
			lngTemp2_2_1=instr(BeginPoint,strContent,"<p",1)
			lngTemp2_2_2=instr(BeginPoint,strContent,"<P",1)
			if lngTemp2_2_1>0 then
				lngTemp2_2=lngTemp2_2_1
			elseif lngTemp2_2_2>0 then
				lngTemp2_2=lngTemp2_2_2
			else
				lngTemp2_2=0
			end if
			
			if lngTemp2_1=0 and lngTemp2_2=0 then
				lngTemp2=BeginPoint
			else
				if lngTemp2_1>lngTemp2_2 then
					lngtemp2=lngTemp2_2
				else
					lngTemp2=lngTemp2_1+4
				end if
			end if

			lngTemp3_1_1=instr(BeginPoint,strContent,"</ur>",1)
			lngTemp3_1_2=instr(BeginPoint,strContent,"</UR>",1)
			if lngTemp3_1_1>0 then
				lngTemp3_1=lngTemp3_1_1
			elseif lngTemp3_1_2>0 then
				lngTemp3_1=lngTemp3_1_2
			else
				lngTemp3_1=0
			end if
			
			lngTemp3_2_1=instr(BeginPoint,strContent,"<ur",1)
			lngTemp3_2_2=instr(BeginPoint,strContent,"<UR",1)
			if lngTemp3_2_1>0 then
				lngTemp3_2=lngTemp3_2_1
			elseif lngTemp3_2_2>0 then
				lngTemp3_2=lngTemp3_2_2
			else
				lngTemp3_2=0
			end if
					
			if lngTemp3_1=0 and lngTemp3_2=0 then
				lngTemp3=BeginPoint
			else
				if lngTemp3_1>lngTemp3_2 then
					lngtemp3=lngTemp3_2
				else
					lngTemp3=lngTemp3_1+5
				end if
			end if
			
			if lngTemp1<lngTemp2 then
				lngTemp=lngTemp2
			else
				lngTemp=lngTemp1
			end if
			if lngTemp<lngTemp3 then
				lngTemp=lngTemp3
			end if

			if lngTemp>BeginPoint and lngTemp<=BeginPoint+lngBound then
				BeginPoint=lngTemp
			else
				lngTemp4_1_1=instr(BeginPoint,strContent,"</li>",1)
				lngTemp4_1_2=instr(BeginPoint,strContent,"</LI>",1)
				if lngTemp4_1_1>0 then
					lngTemp4_1=lngTemp4_1_1
				elseif lngTemp4_1_2>0 then
					lngTemp4_1=lngTemp4_1_2
				else
					lngTemp4_1=0
				end if
				
				lngTemp4_2_1=instr(BeginPoint,strContent,"<li",1)
				lngTemp4_2_1=instr(BeginPoint,strContent,"<LI",1)
				if lngTemp4_2_1>0 then
					lngTemp4_2=lngTemp4_2_1
				elseif lngTemp4_2_2>0 then
					lngTemp4_2=lngTemp4_2_2
				else
					lngTemp4_2=0
				end if
				
				if lngTemp4_1=0 and lngTemp4_2=0 then
					lngTemp4=BeginPoint
				else
					if lngTemp4_1>lngTemp4_2 then
						lngtemp4=lngTemp4_2
					else
						lngTemp4=lngTemp4_1+5
					end if
				end if
				
				if lngTemp4>BeginPoint and lngTemp4<=BeginPoint+lngBound then
					BeginPoint=lngTemp4
				else					
					lngTemp5_1=instr(BeginPoint,strContent,"<img",1)
					lngTemp5_2=instr(BeginPoint,strContent,"<IMG",1)
					if lngTemp5_1>0 then
						lngTemp5=lngTemp5_1
					elseif lngTemp5_2>0 then
						lngTemp5=lngTemp5_2
					else
						lngTemp5=BeginPoint
					end if
					
					if lngTemp5>BeginPoint and lngTemp5<BeginPoint+lngBound then
						BeginPoint=lngTemp5
					else
						lngTemp6_1=instr(BeginPoint,strContent,"<br>",1)
						lngTemp6_2=instr(BeginPoint,strContent,"<BR>",1)
						if lngTemp6_1>0 then
							lngTemp6=lngTemp6_1
						elseif lngTemp6_2>0 then
							lngTemp6=lngTemp6_2
						else
							lngTemp6=0
						end if
					
						if lngTemp6>BeginPoint and lngTemp6<BeginPoint+lngBound then
							BeginPoint=lngTemp6+4
						end if
					end if
				end if
			end if
		end if

		if CurrentPage=pages then
			EndPoint=ContentLen
		else
		  EndPoint=rs("MaxCharPerPage")*CurrentPage
		  if EndPoint>=ContentLen then
			EndPoint=ContentLen
		  else
			lngTemp1_1_1=instr(EndPoint,strContent,"</table>",1)
			lngTemp1_1_2=instr(EndPoint,strContent,"</TABLE>",1)
			lngTemp1_1_3=instr(EndPoint,strContent,"</Table>",1)
			if lngTemp1_1_1>0 then
				lngTemp1_1=lngTemp1_1_1
			elseif lngTemp1_1_2>0 then
				lngTemp1_1=lngTemp1_1_2
			elseif lngTemp1_1_3>0 then
				lngTemp1_1=lngTemp1_1_3
			else
				lngTemp1_1=0
			end if
							
			lngTemp1_2_1=instr(EndPoint,strContent,"<table",1)
			lngTemp1_2_2=instr(EndPoint,strContent,"<TABLE",1)
			lngTemp1_2_3=instr(EndPoint,strContent,"<Table",1)
			if lngTemp1_2_1>0 then
				lngTemp1_2=lngTemp1_2_1
			elseif lngTemp1_2_2>0 then
				lngTemp1_2=lngTemp1_2_2
			elseif lngTemp1_2_3>0 then
				lngTemp1_2=lngTemp1_2_3
			else
				lngTemp1_2=0
			end if
			
			if lngTemp1_1=0 and lngTemp1_2=0 then
				lngTemp1=EndPoint
			else
				if lngTemp1_1>lngTemp1_2 then
					lngtemp1=lngTemp1_2-1
				else
					lngTemp1=lngTemp1_1+7
				end if
			end if

			lngTemp2_1_1=instr(EndPoint,strContent,"</p>",1)
			lngTemp2_1_2=instr(EndPoint,strContent,"</P>",1)
			if lngTemp2_1_1>0 then
				lngTemp2_1=lngTemp2_1_1
			elseif lngTemp2_1_2>0 then
				lngTemp2_1=lngTemp2_1_2
			else
				lngTemp2_1=0
			end if
						
			lngTemp2_2_1=instr(EndPoint,strContent,"<p",1)
			lngTemp2_2_2=instr(EndPoint,strContent,"<P",1)
			if lngTemp2_2_1>0 then
				lngTemp2_2=lngTemp2_2_1
			elseif lngTemp2_2_2>0 then
				lngTemp2_2=lngTemp2_2_2
			else
				lngTemp2_2=0
			end if
			
			if lngTemp2_1=0 and lngTemp2_2=0 then
				lngTemp2=EndPoint
			else
				if lngTemp2_1>lngTemp2_2 then
					lngTemp2=lngTemp2_2-1
				else
					lngTemp2=lngTemp2_1+3
				end if
			end if

			lngTemp3_1_1=instr(EndPoint,strContent,"</ur>",1)
			lngTemp3_1_2=instr(EndPoint,strContent,"</UR>",1)
			if lngTemp3_1_1>0 then
				lngTemp3_1=lngTemp3_1_1
			elseif lngTemp3_1_2>0 then
				lngTemp3_1=lngTemp3_1_2
			else
				lngTemp3_1=0
			end if
			
			lngTemp3_2_1=instr(EndPoint,strContent,"<ur",1)
			lngTemp3_2_2=instr(EndPoint,strContent,"<UR",1)
			if lngTemp3_2_1>0 then
				lngTemp3_2=lngTemp3_2_1
			elseif lngTemp3_2_2>0 then
				lngTemp3_2=lngTemp3_2_2
			else
				lngTemp3_2=0
			end if
					
			if lngTemp3_1=0 and lngTemp3_2=0 then
				lngTemp3=EndPoint
			else
				if lngTemp3_1>lngTemp3_2 then
					lngtemp3=lngTemp3_2-1
				else
					lngTemp3=lngTemp3_1+4
				end if
			end if
			
			if lngTemp1<lngTemp2 then
				lngTemp=lngTemp2
			else
				lngTemp=lngTemp1
			end if
			if lngTemp<lngTemp3 then
				lngTemp=lngTemp3
			end if

			if lngTemp>EndPoint and lngTemp<=EndPoint+lngBound then
				EndPoint=lngTemp
			else
				lngTemp4_1_1=instr(EndPoint,strContent,"</li>",1)
				lngTemp4_1_2=instr(EndPoint,strContent,"</LI>",1)
				if lngTemp4_1_1>0 then
					lngTemp4_1=lngTemp4_1_1
				elseif lngTemp4_1_2>0 then
					lngTemp4_1=lngTemp4_1_2
				else
					lngTemp4_1=0
				end if
				
				lngTemp4_2_1=instr(EndPoint,strContent,"<li",1)
				lngTemp4_2_1=instr(EndPoint,strContent,"<LI",1)
				if lngTemp4_2_1>0 then
					lngTemp4_2=lngTemp4_2_1
				elseif lngTemp4_2_2>0 then
					lngTemp4_2=lngTemp4_2_2
				else
					lngTemp4_2=0
				end if
				
				if lngTemp4_1=0 and lngTemp4_2=0 then
					lngTemp4=EndPoint
				else
					if lngTemp4_1>lngTemp4_2 then
						lngtemp4=lngTemp4_2-1
					else
						lngTemp4=lngTemp4_1+4
					end if
				end if
				
				if lngTemp4>EndPoint and lngTemp4<=EndPoint+lngBound then
					EndPoint=lngTemp4
				else					
					lngTemp5_1=instr(EndPoint,strContent,"<img",1)
					lngTemp5_2=instr(EndPoint,strContent,"<IMG",1)
					if lngTemp5_1>0 then
						lngTemp5=lngTemp5_1-1
					elseif lngTemp5_2>0 then
						lngTemp5=lngTemp5_2-1
					else
						lngTemp5=EndPoint
					end if
					
					if lngTemp5>EndPoint and lngTemp5<EndPoint+lngBound then
						EndPoint=lngTemp5
					else
						lngTemp6_1=instr(EndPoint,strContent,"<br>",1)
						lngTemp6_2=instr(EndPoint,strContent,"<BR>",1)
						if lngTemp6_1>0 then
							lngTemp6=lngTemp6_1+3
						elseif lngTemp6_2>0 then
							lngTemp6=lngTemp6_2+3
						else
							lngTemp6=EndPoint
						end if
					
						if lngTemp6>EndPoint and lngTemp6<EndPoint+lngBound then
							EndPoint=lngTemp6
						end if
					end if
				end if
			end if
		  end if
		end if
		response.write mid(strContent,BeginPoint,EndPoint-BeginPoint)
		
		response.write "</p><p align='center'><b>"
		if CurrentPage>1 then
			response.write "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & CurrentPage-1 & "'>上一页</a>&nbsp;&nbsp;"
		end if
		for i=1 to pages
			if i=CurrentPage then
				response.write "<font color='red'>[" & cstr(i) & "]</font>&nbsp;"
			else
				response.write "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & i & "'>[" & i & "]</a>&nbsp;"
			end if
		next
		if CurrentPage<pages then
			response.write "&nbsp;<a href='" & strFileName & "?ArticleID=" & ArticleID & "&ArticlePage=" & CurrentPage+1 & "'>下一页</a>"
		end if
		response.write "</b></p>"
	end if

end sub

'=================================================
'过程名：ShowFriendSite
'作  用：显示友情链接站点
'参  数：LinkType  ----链接方式，1为LOGO链接，2为文字链接
'       SiteNum   ----最多显示多少个站点
'       Cols      ----分几列显示
'       ShowType  ----显示方式。1为向上滚动，2为横向列表，3为下拉列表框
'=================================================
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();'>"
	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=True 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>"
	elseif ShowType=3 then
		strLink=strLink & "</select>"
	end if
	response.write strLink
	rsLink.close
	set rsLink=nothing
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='UserChkLogin.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='UserReg.asp' target='_blank'>新用户注册</a>&nbsp;&nbsp;<a href='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 "<br>欢迎您！" & Trim(Request.Cookies("asp163")("UserName")) & "<br><br>"
		response.write "<b>用户控制面板：</b><br>" & vbcrlf
		response.write "&nbsp;&nbsp;&nbsp;<a href=""JavaScript:openScript('UserControlPad.asp?Action=ArticleAdd')"">发表文章</a>" & vbcrlf
		response.write "&nbsp;&nbsp;<a href=""JavaScript:openScript('UserControlPad.asp?Action=ArticleManage')"">文章管理</a><br>" & vbcrlf
		response.write "&nbsp;&nbsp;&nbsp;<a href=""JavaScript:openScript('UserControlPad.asp?Action=ModifyPwd')"">修改密码</a>" & vbcrlf
		response.write "&nbsp;&nbsp;<a href=""JavaScript:openScript('UserControlPad.asp?Action=ModifyInfo')"">个人信息</a><br>" & vbcrlf
		response.write "<div align='center'><a href='UserLogout.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 [User] order by ArticleChecked desc,UserID asc"
	set rsTopUser=server.createobject("adodb.recordset")
	rsTopUser.open sqlTopUser,conn,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='center'>文章数</td></tr>"
		for i=1 to rsTopUser.recordcount
			response.write "<tr><td align='left'>" & cstr(i) & "</td><td align='left'><a href='ShowUserInfo.asp?UserID=" & rsTopUser("UserID") & "'>" & rsTopUser("UserName") & "</a></td><td align='center'>" & rsTopUser("ArticleChecked") & "</td></tr>"
			rsTopUser.movenext
		next
		response.write "</table><div align='right'><a href='ShowUser.asp'>more&nbsp;&nbsp;&nbsp; </a></div>"
	end if
	set rsTopUser=nothing
end sub

'=================================================
'过程名：ShowAllUser
'作  用：分页显示所有用户
'参  数：无
'=================================================
sub ShowAllUser()
	select case OrderType
	case 1
		sqlUser="select * from [User] order by ArticleChecked desc"
	case 2
		sqlUser="select * from [User] order by RegDate desc"
	case 3
		sqlUser="select * from [User] order by UserID desc"
	end select
	set rsUser=server.createobject("adodb.recordset")
	rsUser.open sqlUser,conn,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='ShowUser.asp?OrderType=1'>按发表文章数排序</a>&nbsp;&nbsp;&nbsp;&nbsp;<a href='ShowUser.asp?OrderType=2'>按注册日期排序</a>&nbsp;&nbsp;&nbsp;&nbsp;<a href='ShowUser.asp?OrderType=3'>按用户ID排序</a><br></div>"
	response.write "<table width='100%' border='0' cellpadding='2' cellspacing='1'><tr align='center'><td>用户名</td><td>性别</td><td>Email</td><td>QQ号码</td><td>MSN</td><td>主页</td><td>注册日期</td><td>文章数</td><tr>"
	do while not rsUser.eof
		response.write "<tr onmouseout=""this.style.backgroundColor=''"" onmouseover=""this.style.backgroundColor='#BFDFFF'"">"
		response.write "<td><a href='ShowUserInfo.asp?UserID=" & rsUser("UserID") & "'>" & rsUser("UserName") & "</a></td><td align='center'>"
		if rsUser("Sex")=1 then
			response.write "男"
		else
			response.write "女"
		end if
		response.write "</td><td><a href='mailto:" & rsUser("Email") & "'>" & rsUser("Email") & "</a><td align='center'>"
		if rsUser("QQ")<>"" then
			response.write rsUser("QQ")
		else
			response.write "未填"
		end if
		response.write "</td><td align='center'>"
		if rsUser("MSN")<>"" then
			response.write rsUser("MSN")
		else
			response.write "未填"
		end if
		response.write "</td><td align='center'>"
		if rsUser("Homepage")<>"" and rsUser("Homepage")<>"http://" then
			response.write "<a href='" & rsUser("Homepage") & "' title='" & rsUser("Homepage") & "'>点此访问</a>"
		else
			response.write "未填"
		end if
		response.write "</td><td align='center'>" & FormatDateTime(rsUser("RegDate"),2) & "</td><td align='right'>" & rsUser("ArticleChecked") & "</td></tr>"
		
		rsUser.movenext
		i=i+1
		if i>=MaxPerPage then exit do
	loop
	response.write "</table>"
end sub
%>
