<%
'===================================================
' CreateLive CMS Version 3.1
'							Powered by Aspoo.CoM
'===================================================
' File: Cl_Function_Public.asp
' Date: 2005-10-31
' Mail: aspoo@126.com, Info@aspoo.cn
' Q  Q: 3315263, 596197794
' Msn : aspoo@126.com, Clw866@hotmail.com
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2005 Aspoo.CoM All Rights Reserved.
'===================================================
'==================================================================
'过程：ShowLogo(sChannelID,sWidth,sHeight)
'参数：
'	sChannelID		------  频道ID
'	sWidth			------  宽度
'	sHeight			------  高度
'==================================================================
Function ShowLogo(sChannelID,sWidth,sHeight)
	if Cl.Logo <> "" then
		dim sLogo
		'sChannelID	= Cl.ChkClng(sChannelID)
		'sWidth		= Cl.ChkClng(sWidth)
		'sHeight	= Cl.ChkClng(sHeight)
		sLogo = "<a href=""" & Cl.ReplaceDir(Cl.Web_Info(4)) & """ title=""" & Cl.Web_Info(0) & """>"
		Cl.Logo=Cl.ReplaceDir(Cl.Logo)
		if lcase(right(Cl.Logo,3))<>"swf" then
			sLogo = sLogo & "<img src=""" & Cl.Logo & """ width="""& sWidth &"""  height=""" & sHeight & """ border=0 alt="""" />"
		else
			sLogo = sLogo & "<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="""& sWidth &""" height="""& sHeight &"""><param name=""movie"" value=""" & Cl.Logo & """><param name=""quality"" value=""high""><embed src=""" & Cl.Logo & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width="""& sWidth &""" height="""& sHeight &"""></embed></object>"
		end if
		sLogo = sLogo & "</a>"
		ShowLogo = sLogo
	else
		ShowLogo = "<a href=""http://www.aspoo.cn"" title=""创力网""><img src=""http://www.aspoo.cn/images/logo.gif"" width="""& sWidth &""" height="""& sHeight &""" border=0 alt="""" /></a>"
	end if
End Function

'==================================================================
'过程：ShowBanner(sChannelID,Width,Height)
'参数：
'	sChannelID		------  频道ID
'	sWidth			------  宽度
'	sHeight			------  高度
'==================================================================
Function ShowBanner(sChannelID,sWidth,sHeight)
	if Cl.Banner<>"" then
		'sChannelID	= Cl.ChkClng(sChannelID)
		'sWidth		= Cl.ChkClng(sWidth)
		'sHeight		= Cl.ChkClng(sHeight)
		Cl.Banner = Cl.ReplaceDir(Cl.Banner)
		if lcase(right(Cl.Banner,3))="swf" then
			ShowBanner="<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="""& sWidth &""" height="""& sHeight &"""><param name=""movie"" value=""" & Cl.Banner & """><param name=""quality"" value=""high""><embed src=""" & Cl.Banner & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width="""& sWidth &""" height="""& sHeight &"""></embed></object>"
		else
			ShowBanner="<a href=""" & Cl.Web_Info(4) & """ title=""" & Cl.Web_Info(0) & """><img src=""" & Cl.Banner & """ width="""& sWidth &""" height="""& sHeight &""" border=0 alt="""" /></a>"
		end if
	else
		ShowBanner="<a href=""http://www.aspoo.cn/""><img src=""http://www.aspoo.cn/Images/Banner.Gif"" width="""& sWidth &""" height="""& sHeight &""" border=0 alt="""" /></a>"
	end if
End Function
'显示网站调查
Function ShowVote(Byval sChannelID,Byval TopNum)
	dim i,ii,strHTML,sConTent,sType
	sChannelID = Cl.ChkClng(sChannelID)
	TopNum = Cl.ChkClng(TopNum)
	if TopNum<=1 then TopNum=1
	dim SqlVote,RsVote
	SqlVote = "select top "&TopNum&" ID,Title,Content,nums,Type,totalNums from Cl_Vote where IsNew=1 and (ChannelID=-1 or ChannelID=" & sChannelID & ") order by ID Desc"
	Set RsVote = Cl.Execute(SqlVote)
	if rsVote.bof and rsVote.eof then
		ShowVote = "<li>没有任何调查</li>"
		rsVote.close : set rsVote=Nothing : Exit Function
	End If
	SqlVote = rsVote.GetRows(-1)
	rsVote.close:set rsVote=Nothing
	For ii=0 to Ubound(SqlVote,2)
	strHTML = strHTML & "<form action=""" & Cl.WebDir & "Vote.asp"" method=""post"" target=""_blank"" name=""VoteForm"&SqlVote(0,ii)&""" id=""VoteForm"&SqlVote(0,ii)&""">"
	strHTML = strHTML & "&nbsp;&nbsp;&nbsp;&nbsp;" & SqlVote(1,ii) & "<br />"
	sConTent = Split(SqlVote(2,ii),"@")
	if SqlVote(4,ii) = 0 then
		sType = "radio"
	else
		sType = "checkbox"
	end if
	for i=0 to Ubound(sConTent)
		if Trim(sConTent(i)) = "" then exit for
		strHTML = strHTML & "<input type="""&sType&""" name=""VoteOption"" value="""&i&""" />" & sConTent(i) & "<br />"
	next
	strHTML = strHTML & "<br /><input name=""VoteType"" type=""hidden"" value=""" & Trim(SqlVote(4,ii)) & """ />"
	strHTML = strHTML & "<input name=""Action"" type=""hidden"" value=""Vote"" />"
	strHTML = strHTML & "<input name=""ID"" type=""hidden"" value=""" & SqlVote(0,ii) & """ />"
	strHTML = strHTML & "<div align=""center"">"
	strHTML = strHTML & "<a href=""javascript:VoteForm"&SqlVote(0,ii)&".submit();""><img src=""" & Cl.mainpic(26) & """ width=52 height=18 border=0 /></a>&nbsp;&nbsp;"
	strHTML = strHTML & "<a href=""" & Cl.WebDir & "Vote.asp?ID=" & SqlVote(0,ii) & "&amp;Action=Show"" target=""_blank""><img src=""" & Cl.mainpic(27) & """ width=52 height=18 border=0 alt="""" /></a>"
	strHTML = strHTML & "</div></form>"
	Next
	ShowVote = strHTML
End Function

'==================================================================
'过程：ShowAnnounce(sChannelID,TopNum,TitleLen,ShowType,DateType)
'参数：
'	sChannelID		------  频道ID
'	TopNum			------  最多记录数，0为全部(用于分页显示)
'	TitleLen		------  标题最多字节数，只对列表方式有效
'	ShowType		------  0列表，1纵向，2横向
'	DateType		------  显示更新日期的样式
'					---- 0(不显示)
'					---- 1(2004-10-01 23:45:45)
'					---- 2(年-月-日 时:分:秒)
'					---- 3(2004-10-01)
'					---- 4(2004\10\01)
'					---- 5(10-01 23:45)
'					---- 6(2004年10月01日)
'					---- 7(10-01)
'					---- 8(20041001234545)
'==================================================================
Function ShowAnnounce(sChannelID,TopNum,TitleLen,ShowType,DateType)
	On Error Resume Next
	sChannelID	= CLng(sChannelID)
	TopNum		= CLng(TopNum)
	TitleLen	= Clng(TitleLen)
	ShowType	= CLng(ShowType)
	DateType	= CLng(DateType)
	if Err then Err.Clear : ShowAnnounce="ShowAnnounce参数错误。":Exit Function
	On Error GoTo 0
	dim SQL, Rs, i, sTemp
	if TopNum>0 then
		SQL="Select Top " & TopNum & " "
	else
		SQL="Select Top 10 "
	end if
	SQL=SQL & " ID,Title,Content,Author,AddTime from Cl_Announce where IsSelected=True and (ChannelID=-1 or ChannelID=" & sChannelID & ") and (ShowType=0 or ShowType=1) order by ID Desc"
	Set Rs = Cl.Execute(SQL)
	if Rs.bof and Rs.eof then 
		ShowAnnounce = "当前没有通告！"
		Rs.Close : Set Rs=Nothing : Exit Function
	end if
	SQL = Rs.GetRows(-1)
	Rs.Close : Set Rs=Nothing
	sTemp = "" : TopNum = Ubound(SQL,2)
	Select Case ShowType
	Case 0
		for i=0 to TopNum
			sTemp = sTemp & "<li><a href="""&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,i) &""" title=""" & Cl.NoHtml(SQL(2,i)) & """ target=""_blank"">" & Cl.GotTopic(SQL(1,i),TitleLen) & "</li><br />"
		next
	Case 1
		for i=0 to TopNum
			sTemp = sTemp & "&nbsp;&nbsp;&nbsp;&nbsp;<a href="""&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,i) &""" title=""" & Cl.NoHtml(SQL(2,i)) & """ target=""_blank"">" & SQL(1,i) & "<br /><div align=""right"">" & SQL(3,i) & "&nbsp;&nbsp;<br />" & Cl.Format_Time(SQL(4,i),DateType) & "</a></div>"
			if i < TopNum then sTemp = sTemp & "<hr />"
		next
	Case 2
		for i=0 to TopNum
			if i>0 then sTemp = sTemp & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
			sTemp = sTemp & "<a href="""&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,i) &""" title=""" & Cl.NoHtml(SQL(2,i)) & """ target=""_blank"">" & Cl.GotTopic(SQL(1,i),TitleLen) & "&nbsp;&nbsp;[" & Cl.Format_Time(SQL(4,i),DateType) & "]</a>"
		next
	Case 3
		sTemp = "<a href="""&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,TopNum) &""" id=""hottext"" target=""_blank"">" & SQL(1,TopNum) & "</a>" & VbCrlf
		sTemp = sTemp & "<div id=""AllNews"" style=""display:none;"">" & VbCrlf
		for i=0 to TopNum
			sTemp = sTemp & "<div id=""News"&i&""">" & VbCrlf
			sTemp = sTemp & "	<div id=""Summary"&i&""">" & SQL(1,i) & "</div>" & VbCrlf
			sTemp = sTemp & "	<div id=""NewsLink"&i&""">"&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,i) &"</div>" & VbCrlf
			sTemp = sTemp & "</div>" & VbCrlf
		next
		sTemp = sTemp & "</div>" & VbCrlf
		sTemp = sTemp & "<script type=""text/javascript"" src=""{%webdir%}Inc/Js/news.js""></script>"
	End Select
	ShowAnnounce = sTemp
	SQL=Empty
End Function

'==================================================================
'过程：OpenAnnounce(sChannelID)
'参数：
'	sChannelID		------  频道ID
'==================================================================
Function OpenAnnounce(sChannelID)
	if Cl.Web_Setting(1)="Yes" then
	dim popCount,rsAnnounce,strHTML
	set rsAnnounce=Cl.Execute("select count(*) from Cl_Announce where IsSelected=True and (ChannelID=-1 or ChannelID=" & Clng(sChannelID) & ") and (ShowType=0 or ShowType=2)")
	popCount=rsAnnounce(0)
	if popCount>0 then
		Cl.LoadTemplates("")
		strHTML=Cl.mainhtml(16)
		strHTML=Replace(strHTML,"{%channelid%}",sChannelID)
		strHTML=Replace(strHTML,"{%width%}",Split(Cl.Web_Setting(2),"|")(0))
		strHTML=Replace(strHTML,"{%height%}",Split(Cl.Web_Setting(2),"|")(1))
		'strHTML="<script type=""text/javascript"">" & strHTML & "</script>"
	else
		strHTML=""
	end if
	OpenAnnounce=strHTML
	end if
End Function

'=========================================================
'ShowLinkSite(sClassID,TopNum,Cols,LinkType,ShowType)
'参数：
'	sClassID	-----	分类ID
'	TopNum		-----	最多显示多少个记录
'	Cols		-----	几列换行
'	LinkType	-----	链接方式(1为LOGO，2为文字)
'	ShowType	-----	显示方式(1向上，2横向，3文字下拉)
'=========================================================
Function ShowLinkSite(sClassID,TopNum,Cols,LinkType,ShowType)
	dim SiteCount,i,strLink,sValue
	On Error Resume Next
	sClassID	= Clng(sClassID)
	TopNum		= Clng(TopNum)
	Cols		= Clng(Cols)
	LinkType	= Clng(LinkType)
	ShowType	= Clng(ShowType)
	if Err then Err.Clear : ShowLinkSite="ShowLinkSite参数错误。" : Exit Function
	On Error GoTo 0
	If TopNum=0 then TopNum=10
	Select Case ShowType
	Case 1
		strLink=strLink & "<div id=""rolllink"" style=""overflow:hidden;height:170;width:100""><div id=rolllink1>"
		strLink=strLink & "<table width=""100%"" cellSpacing=5><tr align=""center"">"
		strLink=strLink & "{%tempvalue%}"
		strLink=strLink & "</tr></table>"
        strLink=strLink & "</div><div id=rolllink2></div></div>"   '新增代码
		strLink=strLink & vbcrlf & RollFriendLink()    '新增代码
	Case 2
		strLink=strLink & "<table width=""100%"" cellSpacing=5><tr align=""center"">"
		strLink=strLink & "{%tempvalue%}"
		strLink=strLink & "</tr></table>"
	Case 3
		strLink=strLink & "<select name=""friendlink"" onchange=""if(this.options[this.selectedIndex].value!=''){window.open(this.options[this.selectedIndex].value,'_blank');}""><option value="""">友情文字链接</option>"
		strLink=strLink & "{%tempvalue%}"
		strLink=strLink & "</select>"
	End Select
	dim sqlLink,rsLink

	sqlLink="select top " & TopNum & " ID,LinkType,SiteName,SiteUrl,SiteIntro,LogoUrl from Cl_LinkSite where IsOK=True and LinkType=" & LinkType & " and IsIndex=1 "
	if sClassID>0 then sqlLink=sqlLink & " and ClassID="&sClassID&" "
	sqlLink=sqlLink & " order by IsGood,View desc,OrderID"
	set rsLink=Cl.Execute(sqlLink)
	if rsLink.bof and rsLink.eof then
		if ShowType<>3 then
			if LinkType=1 then
				for i=1 to TopNum
					sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank"">"
					sValue=sValue & "<img src=""" & Cl.WebDir & "images/nologo.gif"" width=88 height=31 border=0 alt=""点击申请"" />"
					sValue=sValue & "</a></td>"
					if i mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
				next
			else
				for i=1 to TopNum
					sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank"">点击申请</a></td>"
					if i mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
				next
			end if
		end if
		rsLink.Close:Set rsLink=Nothing
	else
		sqlLink = rsLink.GetRows(-1)
		rsLink.Close:Set rsLink=Nothing
		SiteCount=Ubound(sqlLink,2)
		if ShowType=3 then
			for i = 0 to SiteCount
				sValue=sValue & "<option value=""" & sqlLink(3,i) & """>" & sqlLink(2,i) & "</option>"
			next
		else
			if LinkType=1 then
				for i = 0 to SiteCount
					sValue=sValue & "<td width=88><a href=""" & sqlLink(3,i) & """ target=""_blank"" title=""网站名称：" & sqlLink(2,i) & vbcrlf & "网站地址：" & sqlLink(3,i) & vbcrlf & "网站简介：" & sqlLink(4,i) & """>"
					if sqlLink(5,i)="" or sqlLink(5,i)="http://" then
						sValue=sValue & "<img src=""" & Cl.WebDir & "images/nologo.gif"" width=88 height=31 border=0 alt="""" />"
					else
						sValue=sValue & "<img src=""" & sqlLink(5,i) & """ width=88 height=31 border=0 alt="""" />"
					end if
					sValue=sValue & "</a></td>"
					if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
				next
				if SiteCount < TopNum-1 then
					for i=SiteCount+1 to TopNum-1
						sValue=sValue & "<td width=88><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank""><img src=""" & Cl.WebDir & "images/nologo.gif"" width=88 height=31 border=0 alt=""点击申请"" /></a></td>"
						if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
					next
				end if
			else
				for i = 0 to SiteCount
					sValue=sValue & "<td width=88><a href=""" & sqlLink(3,i) & """ target=""_blank"" title=""网站名称：" & sqlLink(2,i) & vbcrlf & "网站地址：" & sqlLink(3,i) & vbcrlf & "网站简介：" & sqlLink(4,i) & """>" & sqlLink(2,i) & "</a></td>"
					if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
				next
				if SiteCount < TopNum-1 then
					for i=SiteCount+1 to TopNum-1
						sValue=sValue & "<td width=88><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank"">点击申请</a></td>"
						if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
					next
				end if
			end if
		end if
		sqlLink=Empty
	end if
	ShowLinkSite=Replace(strLink,"{%tempvalue%}",sValue)
End Function

'滚动显示友情链接站点
Function RollFriendLink()
	Dim sTemp
	sTemp="<script type=""text/javascript"">" & vbcrlf
	sTemp=sTemp & "<!--" & vbcrlf
	sTemp=sTemp & "var rollspeed=30" & vbcrlf
	sTemp=sTemp & "rolllink2.innerHTML=rolllink1.innerHTML //克隆rolllink1为rolllink2" & vbcrlf
	sTemp=sTemp & "function Marquee(){" & vbcrlf
	sTemp=sTemp & "if(rolllink2.offsetTop-rolllink.scrollTop<=0) //当滚动至rolllink1与rolllink2交界时" & vbcrlf
	sTemp=sTemp & "rolllink.scrollTop-=rolllink1.offsetHeight  //rolllink跳到最顶端" & vbcrlf
	sTemp=sTemp & "else{" & vbcrlf
	sTemp=sTemp & "rolllink.scrollTop++" & vbcrlf
	sTemp=sTemp & "}" & vbcrlf
	sTemp=sTemp & "}" & vbcrlf
	sTemp=sTemp & "var MyMar=setInterval(Marquee,rollspeed) //设置定时器" & vbcrlf
	sTemp=sTemp & "rolllink.onmouseover=function() {clearInterval(MyMar)}//鼠标移上时清除定时器达到滚动停止的目的" & vbcrlf
	sTemp=sTemp & "rolllink.onmouseout=function() {MyMar=setInterval(Marquee,rollspeed)}//鼠标移开时重设定时器" & vbcrlf
	sTemp=sTemp & "//-->" & vbcrlf
	sTemp=sTemp & "</script>"
	RollFriendLink=sTemp
End Function
'=========================================================
'ShowTopUser(TopNum,ShowType,OrderType)
'显示用户排行:显示数量，排列方式（1文章数，其它为注册时间）
'TopNum			----- 最多显示多少个
'ShowType		----- 排列方式
'				----- 0(用户ID)
'				----- 1(资料)
'				----- 2(金钱)
'				----- 3(点数)
'				----- 4(登录次数)
'				----- 5(等级)
'				----- 6(新增用户)   
'OrderType		----- 排序方式（0,降序，其他升序）
'=========================================================
Function ShowTopUser(TopNum,ShowType,OrderType)
	TopNum		= Cl.ChkClng(TopNum)
	ShowType	= Cl.ChkClng(ShowType)
	OrderType	= Cl.ChkClng(OrderType)
	If TopNum = 0 then TopNum = 10
	if OrderType=0 then
		OrderType="Desc"
	Else
		OrderType="Asc"
	End if
	Dim sqlTop,rsTop,i,ts,ls
	sqlTop="Select Top "&TopNum&" " & Db.UserID & "," & Db.UserName & "," & Db.UserPassWord & ","&Db.UserReName&"," & Db.UserEmail & "," & Db.UserSex & "," & Db.UserFace & "," & Db.UserFaceWidth & "," & Db.UserFaceHeight & "," & Db.UserIM & "," & Db.UserJoinDate & "," & Db.UserLastLogin & "," & Db.UserLogins & "," & Db.UserQuestion & "," & Db.UserAnswer & "," & Db.UserLastIP & "," & Db.UserDataNum & "," & Db.UserLevel & "," & Db.UserPoint & "," & Db.UserMoney & "," & Db.ChargeType & "," & Db.BeginDate & "," & Db.ValidNum & " from " & Db.UserTable & " where " & Db.UserLock & "=0 "
	Select Case ShowType
	Case 0
		sqlTop=	sqlTop & " Order by " & Db.UserID & " "&OrderType&"":ts="用户ID":ls=0
	Case 1
		sqlTop=	sqlTop & " Order by " & Db.UserDataNum & " "&OrderType&"," & Db.UserID & " Asc":ts="发表":ls=16
	Case 2
		sqlTop=	sqlTop & " Order by " & Db.UserMoney & " "&OrderType&"," & Db.UserID & " Asc":ts="金钱":ls=19
	Case 3
		sqlTop=	sqlTop & " Order by " & Db.UserPoint & " "&OrderType&"," & Db.UserID & " Asc":ts="点数":ls=18
	Case 4
		sqlTop=	sqlTop & " Order by " & Db.UserLogins & " "&OrderType&"," & Db.UserID & " Asc":ts="登录":ls=12
	Case 5
		sqlTop=	sqlTop & " Order by " & Db.UserLevel & " "&OrderType&"," & Db.UserID & " Asc":ts="等级":ls=17
	Case Else
		sqlTop=	sqlTop & " Order by " & Db.UserID & " Desc":ts="注册":ls=10
	End Select
	set rsTop=Cl.Execute_U(sqlTop)
	if rsTop.bof and rsTop.eof then
		ShowTopUser = "没有任何用户"
		rsTop.Close : Set rsTop=Nothing : Exit Function
	end if
	sqlTop = rsTop.GetRows(-1)
	rsTop.Close : Set rsTop=Nothing
	Dim sTemp
	sTemp="<table width=""100%"" border=0 cellspacing=0 cellpadding=0><tr><td align=""left"" width=40>名次</td><td align=""left"">用户名</td><td align=""right"">"&ts&"</td></tr>"
	if ls=10 then
		For i=0 to Ubound(sqlTop,2)
		sTemp=sTemp & "<tr><td align=""center"">" & (i+1) & "</td><td align=""left""><a href="""&Cl.WebDir&"User/Info.Asp?UserID=" & sqlTop(0,i) & """>" & sqlTop(1,i) & "</a></td><td align=""right"">" & formatdatetime(sqlTop(ls,i),2)& "</td></tr>"
		next
	else
		For i=0 to Ubound(sqlTop,2)
		sTemp=sTemp & "<tr><td align=""center"">" & (i+1) & "</td><td align=""left""><a href="""&Cl.WebDir&"User/Info.Asp?UserID=" & sqlTop(0,i) & """>" & sqlTop(1,i) & "</a></td><td align=""right"">" & sqlTop(ls,i) & "</td></tr>"
		next
	end if
	sTemp=sTemp & "<tr><td align=""right"" colspan=3><a href="""&Cl.WebDir&"User/List.asp"">more...</a></td></tr>"
	sTemp=sTemp & "</table>"
	ShowTopUser=sTemp
	sqlTop=Empty
End Function
'=====================================================
'ShowGuest(TopNum,TitleLen,ShowReply)
'参数：
'	TopNum		-----	显示记录数
'	TitleLen	-----	标题字节数
'	ShowReply	-----	是否显示已回复字样（True为是）
'=====================================================
Function ShowGuest(TopNum,TitleLen,ShowReply)
	TopNum=Cl.ChkClng(TopNum)
	TitleLen=Cl.ChkClng(TitleLen)
	ShowReply=Cl.ChkCBool(ShowReply)
	if TopNum=0 then TopNum=8
	dim sqlGuest,rsGuest
	sqlGuest="select top "&TopNum&" GuestId,GuestTitle,GuestName,GuestDatetime,GuestReply,GuestReplyAdmin from Cl_Guest where GuestIsPassed=True order by GuestId desc"
	Set rsGuest= Cl.Execute(sqlGuest)
	if rsGuest.bof and rsGuest.eof then
		ShowGuest="没有任何留言"
		rsGuest.Close:Set rsGuest=Nothing:Exit Function
	End if
	sqlGuest=RsGuest.GetRows(-1)
	rsGuest.Close:Set rsGuest=Nothing
	dim i,sTemp
	sTemp="<table width=100%  border=0 cellpadding=0 cellspacing=0>"
	for i=0 to Ubound(sqlGuest,2)
		sTemp=sTemp & "<tr><td><font color=#b70000><b>·</b></font><a href="""&Cl.WebDir&"GuestBook/Index.asp"" title=""主题：" & sqlGuest(1,i) & vbcrlf & "姓名：" & sqlGuest(2,i) & vbcrlf & "时间：" & sqlGuest(3,i) &""" target=""_blank"">"
		sTemp=sTemp & Cl.GotTopic(sqlGuest(1,i),TitleLen)
		if Len(sqlGuest(4,i)) >0 and ShowReply then
		'sTemp=sTemp & "</td><td align=right><font color=#4474A3>[" & "<font color=#990000>" & sqlGuest(5,i) & "</font>" & "已回复]</font>"   '显示[***已回复]
		sTemp=sTemp & "</td><td align=right><font color=#4474A3>[已回复]</font>"   '显示[已回复]
		Else
		sTemp=sTemp & "</td><td align=right><font color=#828877>[未回复]</font>"   '显示[未回复]
		end if
		sTemp=sTemp & "</a></td></tr>"
	Next
	ShowGuest=sTemp & "</table>"
	sqlGuest=Empty
End Function

'==================================================================
'过程：ShowAD(sAdID,sType,sAct,sWidth,sHeight)
'参数：
'	sAdID			------  ADID
'   sType			------  0=图片，1=代码
'	sAct			------  0=普通，1=弹出，2=浮动，3=固定
'	sWidth			------  宽度
'	sHeight			------  高度
'==================================================================
Function ShowAD(sAdID,sType,sAct,sWidth,sHeight)
	dim sqlAD,rsAD,sTempAD
	On Error Resume Next
	sAdID	= Clng(sAdID)
	sType	= Clng(sType)
	sAct	= Clng(sAct)
	sWidth	= Clng(sWidth)
	sHeight	= Clng(sHeight)
	if Err then Err.Clear : ShowAD="ShowAD参数错误。" : Exit Function
	On Error GoTo 0
	if sAdID>0 then
		sqlAD="Select ID,AdName,AdLinkUrl,AdImgUrl,ImgWidth,ImgHeight,IsFlash,ADType,AdAct,ADSetting from Cl_Ads where ID=" & sAdID & " and IsUse=1"
	else
		sqlAD="Select Top 1 ID,AdName,AdLinkUrl,AdImgUrl,ImgWidth,ImgHeight,IsFlash,ADType,AdAct,ADSetting from Cl_Ads where AdAct=" & sAct & " and IsUse=1 and AdType="&sType&""
	end if
	Set rsAD=Cl.Execute(sqlAD)
	if rsAd.bof and rsAD.eof then
		rsAD.Close : Set rsAD=Nothing
		ShowAD = "" : Exit Function
	end if
	Select Case rsAd(7)
	Case 0
		if sWidth	= 0 then sWidth	= rsAd(4)
		if sHeight	= 0 then sHeight= rsAd(5)
		if rsAd(6)=true then
			sTempAD = "<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=""" & sWidth & """ height=""" & sHeight & """>"
			sTempAD = sTempAD & "<param name=""movie"" value=""" & rsAd(3) & """><param name=""quality"" value=""high""><embed src=""" & rsAd(3) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""" & sWidth & """ height=""" & sHeight & """>"
			sTempAD = sTempAD & "</embed></object>"
		else
			sTempAd = "<a href=""" & rsAd(2) & """ target=""_blank"" title=""" & rsAd(1) & """><img src=""" & rsAd(3) & """ width=""" & sWidth & """ height=""" & sHeight & """ border=""0"" alt="""" /></a>"
		end if
		'sTempAD = Replace(Replace(sTempAD,"'",""),vbcrlf,"\n")
		Dim AdSetting
		AdSetting = split(rsAd(9),"|")
		if Clng(AdSetting(1)) = 0 then AdSetting(1) = 100
		if Clng(AdSetting(2)) = 0 then AdSetting(2) = 100
		Select Case rsAd(8)
		Case 0
			ShowAD = sTempAD
		Case 1
			ShowAD = Cl.mainhtml(17)
			ShowAD = Replace(ShowAD,"{%adid%}",sAdID)
			ShowAD = Replace(ShowAD,"{%width%}",sWidth)
			ShowAD = Replace(ShowAD,"{%height%}",sHeight)
			ShowAD = Replace(ShowAD,"{%popleft%}",AdSetting(1))
			ShowAD = Replace(ShowAD,"{%poptop%}",AdSetting(2))
			ShowAD = "<script type=""text/javascript"">" & vbcrlf & Cl.ReplaceDir(ShowAD) & "</script>"
		Case 2
			ShowAD = "<div id=""FlAD_"&sAdID&""" style=""position:absolute; z-index:10;left: "&AdSetting(1)&"; top: "&AdSetting(2)&""">" & sTempAD & "</div>"
			ShowAD = ShowAD & VbCrlf & "<script type=""text/javascript"">" & vbcrlf & Replace(Cl.mainhtml(18),"{%adid%}",sAdID) & "</script>"
		Case 3
			ShowAD = "<div id=""FixAD_"&sAdID&""" style=""position:absolute; z-index:10;left: "&AdSetting(1)&"; top: "&AdSetting(2)&""">" & sTempAD & "</div>"
			ShowAD = ShowAD & VbCrlf & "<script type=""text/javascript"">" & vbcrlf & Replace(Cl.mainhtml(19),"{%adid%}",sAdID) & "</script>"
		End Select
	Case 1
		ShowAD = Cl.ReplaceDir(rsAd(3))
	Case Else
		ShowAD = ""
	End Select
	rsAD.Close : Set rsAD=Nothing
End Function
'==================================================================
'过程：ShowComment(sChannelID,InfoID,TopNum)
'参数：
'	sChannelID		------  频道ID
'	InfoID			------  内容ID
'	TopNum			------  最多显示数
'==================================================================
Function ShowComment(sChannelID,InfoID,TopNum)
	dim rsComment,sqlComment,rsCommentU,NoPassedNum,i
	NoPassedNum=Cl.Execute("Select Count(CommentID) from Cl_Comment where ChannelID="&sChannelID&" and InfoID=" & InfoID & " and Passed="&FalseType)(0)
	if NoPassedNum="" then NoPassedNum=0
	sChannelID		= Cl.ChkClng(sChannelID)
	InfoID			= Cl.ChkClng(InfoID)
	TopNum			= Cl.ChkClng(TopNum)
	if TopNum > 0 then
		sqlComment = "select top " & TopNum & " "
	else
		sqlComment = "select top 8 "
	end if
	sqlComment=sqlComment & " CommentID,InfoID,ClassID,UserLevel,UserName,Email,WriteTime,Score,Content,ReplyContent,ReplyName,ReplyTime,Passed from Cl_Comment where ChannelID="&sChannelID&" and InfoID=" & InfoID & " "
	if Cl.UserLevel=1 then
	sqlComment=sqlComment & " order by CommentID desc"
	else
	sqlComment=sqlComment & " and Passed=True order by CommentID desc"
	end if
	Set rsComment = Cl.Execute(sqlComment)
	if rsComment.bof and rsComment.eof then
		if NoPassedNum>0 then
			ShowComment="&nbsp;&nbsp;待审评论 <b><font color=""#FF0033"">"&NoPassedNum&"</font></b> 条，请管理员 <a href="""&Cl.WebDir&"User/Login.Asp""><font color=""#FF0033"">登录</font></a> 后操作！"
		else
			ShowComment="&nbsp;&nbsp;没有任何评论"
		end if
		rsComment.close:set rsComment=Nothing
	else
		Set ClUbb=New Cls_UbbCode
		Dim sTemp,UserIM
		sTemp="<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"">"
		sqlComment = rsComment.GetRows(-1)
		rsComment.close:set rsComment=Nothing
		For i=0 to Ubound(sqlComment,2)
			sTemp=sTemp & "<tr><td width=""70%""><li>"&Cl.GetUserGroupName(sqlComment(3,i))&"『"
			if sqlComment(3,i)=5 then
				sTemp=sTemp & "<span title=""姓名：" & sqlComment(4,i) & vbcrlf & "信箱：" & sqlComment(5,i) & """><font color=""blue"">" & sqlComment(4,i) & "</font></span>"
			else
				sTemp=sTemp & "<a href=""" & Cl.WebDir & "User/Info.Asp?UserName=" & sqlComment(4,i) & """><font color=""blue"">" & sqlComment(4,i) & "</font></a>"
			end if
			sTemp=sTemp & "』于" & sqlComment(6,i) & "发表评论：</li>"
			if Cl.UserLevel=1 then
				if sqlComment(12,i)=True then
				sTemp=sTemp & "&nbsp;[<a href="""&Cl.WebDir&"Comment.asp?Action=Check&Type=N&CommentID="&sqlComment(0,i)&""">取消</a>]"
				else
				sTemp=sTemp & "&nbsp;[<a href="""&Cl.WebDir&"Comment.asp?Action=Check&Type=P&CommentID="&sqlComment(0,i)&"""><font color=""#FF0033"">审核</font></a>]"
				end if
				'sTemp=sTemp & "&nbsp;[<a href="""&Cl.WebDir&"Comment.asp?Action=Check&Type=M&CommentID="&sqlComment(0,i)&""">修改</a>]"
				sTemp=sTemp & "&nbsp;[<a href="""&Cl.WebDir&"Comment.asp?Action=Check&Type=D&CommentID="&sqlComment(0,i)&""">删除</a>]"
			end if
			sTemp=sTemp & "</td><td align=right>评分："&sqlComment(7,i)&"分</td></tr>"
			sTemp=sTemp & "<tr><td colspan=2>"
			sTemp=sTemp & "&nbsp;&nbsp;&nbsp;&nbsp;" & ClUbb.UbbCode(sqlComment(8,i)) & "<br />"
			if sqlComment(9,i)<>"" then
				sTemp=sTemp & "&nbsp;&nbsp;&nbsp;&nbsp;<font color=""#009900"">★</font>&nbsp;管理员『<font color=""blue"">" & sqlComment(10,i) & "</font>』于 " & sqlComment(11,i) & " 回复道：&nbsp;&nbsp;&nbsp;&nbsp;" & ClUbb.UbbCode(sqlComment(9,i)) & "<br />"
			end if
			sTemp=sTemp & "<br /></td></tr>"
		Next
		Set ClUbb=Nothing
		sTemp=sTemp & "<tr><td align=""right"">&nbsp;"
		if NoPassedNum>0 then
		sTemp=sTemp & "待审评论 <b><font color=red>"&NoPassedNum&"</font></b> 条，请管理员 <a href="""&Cl.WebDir&"User/Login.Asp""><font color=""#FF0033"">登录</font></a> 后操作！"
		end if
		sTemp=sTemp & "</td><td align=""right""><a href="""&Cl.WebDir&"Comment.asp?ChannelID="&sChannelID&"&InfoID=" & InfoID & """>查看所有评论</a></td></tr>"
		sTemp=sTemp & "</table>"
		ShowComment=sTemp
	end if
	sqlComment=Empty
End Function

'显示所有栏目（树形目录效果）(预留)
Function ShowClass_Tree(sChannelID)
	dim rsClass,sqlClass,tmpDepth,i,j
	sqlClass="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,NextID,IsOuter,LinkUrl,Child From Cl_Class where ChannelID="&Cint(sChannelID)&" and order by RootID,OrderID"
	set rsClass=Cl.Execute(sqlClass)
	if rsClass.bof and rsClass.bof then
		ShowClass_Tree="没有任何栏目"
		rsClass.close:set rsClass=Nothing : Exit Function
	End if
	dim arrShowLine(20),strClassTree
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	sqlClass = rsClass.GetRows(-1)
	rsClass.close:set rsClass=Nothing
	For i=0 to Ubound(sqlClass,2)
		tmpDepth=sqlClass(5,i)
		if sqlClass(6,i)>0 then
			arrShowLine(tmpDepth)=True
		else
			arrShowLine(tmpDepth)=False
		end if
		if tmpDepth>0 then
			for j=1 to tmpDepth
				if j=tmpDepth then
					if sqlClass(6,i)>0 then
						strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line1.gif"" width=17 height=16 valign=""abvmiddle"" alt="""" />"
					else
						strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line2.gif"" width=17 height=16 valign=""abvmiddle"" alt="""" />"
					end if
				else
					if arrShowLine(j)=True then
						strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line3.gif"" width=17 height=16 valign=""abvmiddle"" alt="""" />"
					else
						strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/line4.gif"" width=17 height=16 valign=""abvmiddle"" alt="""" />"
					end if
				end if
			next
		end if
		if sqlClass(9,i)>0 then 
			strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/folder4.gif"" width=15 height=15 valign=""abvmiddle"" alt="""" />"
		else 
			strClassTree=strClassTree & "<img src="""&Cl.WebDir&"images/Tree/folder3.gif"" width=15 height=15 valign=""abvmiddle"" alt="""" />"
		end if 
		if sqlClass(7)=1 then
			strClassTree=strClassTree & "<a href=""" & sqlClass(8,i) & """ target=""_blank"">"
		else
			strClassTree=strClassTree & "<a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),sqlClass(2,i),sqlClass(0,i),sqlClass(4,i),sqlClass(3,i),Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & """>"
		end if
		if sqlClass(5,i)=0 then 
			strClassTree=strClassTree & "<b>"  & sqlClass(1,i) & "</b>"
		else
			strClassTree=strClassTree & sqlClass(1,i)
		end if 
		strClassTree=strClassTree & "</a>"
		if sqlClass(9,i)>0 then 
			strClassTree=strClassTree & "（" & sqlClass(9,i) & "）" 
		end if 
		strClassTree=strClassTree & "<br />"
	Next
	ShowClass_Tree=strClassTree
	sqlClass=Empty
End Function

'===============================================================
'显示当前栏目的下一级子栏目
'过程：ShowChildClass(sChannelID,sClassID,sCol,ShowType)
'参数：
'	sChannelID   ----- 频道ID
'	sClassID-----------栏目ID
'	sCol		------ 几列换行(当ShowType大于1时生效)
'	ShowType	------ 显示方式(0,<li>每个栏目一行)
'===============================================================
Function ShowChildClass(sChannelID,sClassID,sCol,ShowType)
	dim SQL,Rs,i,n,sTemp
	sChannelID=Cl.ChkClng(sChannelID):sClassID=Cl.ChkClng(sClassID)
	ShowType=Cl.ChkClng(ShowType):sCol=Cl.ChkClng(sCol)
	SQL="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,NextID,IsOuter,LinkUrl,Child From Cl_Class where ChannelID="&sChannelID&" and ParentID=" & ClassID & " order by OrderID"
	Set Rs= Cl.Execute(SQL)
	if Rs.bof and Rs.eof then
		ShowChildClass="没有子栏目"
		Rs.Close : Set Rs=Nothing : Exit Function
	End if
	SQL=Rs.GetRows(-1)
	n=1:sTemp=""
	if ShowType=0 then
		for i=0 to Ubound(SQL,2)
			if SQL(7,i)=1 then
				sTemp=sTemp & "<li><a href=""" & SQL(8,i) & """>" & SQL(1,i) & "</a></li>"
			else
				sTemp=sTemp & "<li><a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),SQL(2,i),SQL(0,i),SQL(4,i),SQL(3,i),Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & """>" & SQL(1,i) & "</a></li>"
			end if
			if SQL(9,i)>0 then sTemp=sTemp & "(" & SQL(9,i) & ")"
			sTemp=sTemp & "<br />"		
		Next
	else
		for i=0 to Ubound(SQL,2)
			if SQL(7,i)=1 then
				sTemp=sTemp & "&nbsp;&nbsp;<a href=""" & SQL(8,i) & """>" & SQL(1,i) & "</a>"
			else
				sTemp=sTemp & "&nbsp;&nbsp;<a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),SQL(2,i),SQL(0,i),SQL(4,i),SQL(3,i),Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & """>" & SQL(1,i) & "</a>"
			end if
			if SQL(9,i)>0 then sTemp=sTemp & "(" & SQL(9,i) & ")"
			if n mod sCol=0 then sTemp=sTemp & "<br />"
			n=n+1
		Next
	end if
	ShowChildClass=sTemp
	SQL=Empty
End Function
'===============================================================
'显示栏目导航
'过程：ShowClassNavigation(sChannelID,sClassID,sCol)
'参数：
'	sChannelID   ----- 频道ID
'	sClassID-----------栏目ID
'	sCol		------ 几列换行
'===============================================================
Function ShowClassNavigation(sChannelID,sClassID,sCol)
	dim SQL,Rs,sTemp,PrevRootID,i,n
	sChannelID=Cl.ChkClng(sChannelID):sClassID=Cl.ChkClng(sClassID):sCol=Cl.ChkClng(sCol)
	SQL="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,RootID,IsOuter,LinkUrl,Child,Readme From Cl_Class where ChannelID="&sChannelID&""
	if sClassID>0 then
		SQL=SQL & " and (ClassID="&sClassID&" or ParentID="&sClassID&") order by RootID,OrderID"
	else
		SQL=SQL & " and Depth<=1 order by RootID,OrderID"
	end if
	Set Rs= Cl.Execute(SQL)
	if Rs.bof and Rs.eof then
		ShowClassNavigation = "没有任何栏目"
		Rs.Close : Set Rs=Nothing : Exit Function
	End if
	if sCol=0 then sCol=6
	Cl.GetChannelSetting(sChannelID)
	SQL=Rs.GetRows(-1)
	Rs.Close : Set Rs=Nothing
	sTemp="<table border=""0"" cellpadding=""0"" cellspacing=""2""><tr><td valign=""top"" nowrap>【<a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),SQL(2,i),SQL(0,i),SQL(4,i),SQL(3,i),Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & """ title=""" & SQL(10,i) & """>" & SQL(1,i) & "</a>】</td><td>"
	PrevRootID=SQL(6,i):n=1
	For i=1 to Ubound(SQL,2)
		if PrevRootID=SQL(6,i) then
			if SQL(7,i)=1 then
				sTemp=sTemp & "<a href=""" & SQL(8,i) & """ title=""" & SQL(10,i) & """>"
			else
				sTemp=sTemp & "<a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),SQL(2,i),SQL(0,i),SQL(4,i),SQL(3,i),Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & """ title=""" & SQL(10,i) & """>"
			end if
			sTemp=sTemp & SQL(1,i) & "</a>&nbsp;&nbsp;"
			if n>=sCol then
				n=1 : sTemp=sTemp & "<br />"
			else
				n=n+1
			end if
		else
			sTemp=sTemp & "</td></tr><tr><td valign=""top"" nowrap>"
			if SQL(7,i)=1 then
				sTemp=sTemp & "【<a href=""" & SQL(8,i) & """ title=""" & SQL(10,i) & """>"
			else
				sTemp=sTemp & "【<a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),SQL(2,i),SQL(0,i),SQL(4,i),SQL(3,i),Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & """ title=""" & SQL(10,i) & """>"
			end if
			sTemp=sTemp & SQL(1,i) & "</a>】</td><td>"
			n=1
		end if
		PrevRootID=SQL(6,i)
	Next
	ShowClassNavigation = sTemp & "</td></tr></table>"
	SQL=Empty
End Function

'显示站点统计信息
Function ShowWebCount(sChannelID,sType)
	sChannelID	= Cl.ChkClng(sChannelID)
	sType		= Cl.ChkClng(sType)
	Cl.GetChannelSetting(sChannelID)
	Cl.Name="ShowWebCount" & sChannelID
	if Cl.ObjIsEmpty() then
		dim rsCount,sTempD
		Cl.Channel_Setting(20) = Cl.ChkClng(Cl.Channel_Setting(20))
		if Cl.Channel_Setting(20) = 6 then
			Set rsCount = Cl.Execute("select count(GuestID) from Cl_Guest")
			sTempD = rsCount(0) & "@"  '===(0)
			Set rsCount = Cl.Execute("select count(GuestID) from Cl_Guest where GuestIsPassed=True")
			sTempD = sTempD & rsCount(0) & "@"  '===(1)
			Set rsCount = Cl.Execute("select count(GuestID) from Cl_Guest where GuestIsPassed=False")
			sTempD = sTempD & rsCount(0) & "@0@0@0@0@0@"  '===(2)
		Else
			Dim sMName,TempV,TempV2
			Select Case Cl.Channel_Setting(20)
			Case 1 : sMName = "Article"
			Case 2 : sMName = "Soft"
			Case 3 : sMName = "Photo"
			Case 4 : sMName = "Movie"
			Case 5 : sMName = "Product"
			Case else : sMName = "Article"
			End Select
			Set rsCount = Cl.Execute("select count("&sMName&"ID) from Cl_"&sMName&" where ChannelID="&sChannelID&" and Deleted="&FalseType)
			TempV		= rsCount(0)
			sTempD		= TempV & "@"   '===(0) 总数
			Set rsCount = Cl.Execute("select count("&sMName&"ID) from Cl_"&sMName&" where ChannelID="&sChannelID&" and Passed=True and Deleted="&FalseType)
			TempV2		= rsCount(0)
			sTempD		= sTempD & TempV2 & "@"  '===(1) 已审
			sTempD		= sTempD & (TempV-TempV2) & "@"  '===(2) 待审
			Set rsCount = Cl.Execute("select sum(Hits) From Cl_"&sMName&" where ChannelID="&sChannelID&" ")
			sTempD		= sTempD & rsCount(0) & "@"  '===(3) 阅读
			Set rsCount = Cl.Execute("select count(CommentID) from Cl_Comment where ChannelID="&sChannelID&"")
			TempV		= rsCount(0)
			sTempD		= sTempD & TempV & "@"  '===(4) 评论总数
			Set rsCount = Cl.Execute("select count(CommentID) from Cl_Comment where ChannelID="&sChannelID&" and Passed=True")
			TempV2		= rsCount(0)
			sTempD		= sTempD & TempV2 & "@"  '===(5) 已审评论
			sTempD		= sTempD & (TempV-TempV2) & "@"  '===(6) 待审评论
			Set rsCount = Cl.Execute("select count(SpecialID) from Cl_Special where (ChannelID=-1 or ChannelID="&sChannelID&")")
			sTempD	= sTempD & rsCount(0) & "@"  '===(7) 专题数
		End if
		Set rsCount = Cl.Execute("select count(SpecialID) from Cl_Special")
		sTempD		= sTempD & rsCount(0) & "@"  '===(8) 专题总数
		Set rsCount	= Cl.Execute_U("select Count(UserID) from " & Db.UserTable)
		sTempD		= sTempD & rsCount(0) & "@0"  '===(9) 用户总数
		Set rsCount	= Cl.Execute_U("select Count(UserID) from " & Db.UserTable & " where (UserLevel=6 or UserLevel=7)")
		sTempD		= sTempD & rsCount(0) & "@0"  '===(10) 待审用户
		set rsCount	= Nothing
		Cl.Value	= sTempD
	end if
	Dim sTemp
	sTemp = Split(Cl.Value,"@")
	If sType > Ubound(sTemp) then
		ShowWebCount = 0
	Else
		ShowWebCount = sTemp(sType)
	End If
	sTemp=Empty
End Function

'===============================================================
'过程名：ShowSearchForm(sChannelID,ShowType)
'参 数：
'		sChannelID	----	频道ID
'		ShowType	----	显示方式 1简,2标,3(带栏目),4(带专题),5(带栏目+专题)
'===============================================================
Function ShowSearchForm(sChannelID,ShowType)
	sChannelID	= Cl.ChkClng(sChannelID)
	ShowType	= Cl.ChkClng(ShowType)
	Cl.GetChannelSetting(sChannelID)
	Dim sTemp
	sTemp="<table border=""0"" cellpadding=""0"" cellspacing=""0"">"
	sTemp=sTemp & "<form action=""" & Cl.WebDir & Cl.Channel_Setting(4) & "/ShowSearch.Asp"" method=""post"" name=""SearchForm"" id=""SearchForm"">"
	sTemp=sTemp & "<tr><td height=""28"" align=""center"">"
	Select Case ShowType
	Case 0, 1
		sTemp=sTemp & "<input type=""hidden"" name=""field"" value=""Title"" />"
	Case 2
		sTemp=sTemp & ShowSearchField(Cl.Channel_Setting(20),Cl.Channel_Setting(2))
	Case 3
		sTemp=sTemp & ShowSearchField(Cl.Channel_Setting(20),Cl.Channel_Setting(2))
		sTemp=sTemp & "&nbsp;<select name=""ClassID""><option value="""">所有栏目</option>"
		sTemp=sTemp & ShowClass_Option(sChannelID,0,2,3) & "</select>"
	Case 4
		sTemp=sTemp & ShowSearchField(Cl.Channel_Setting(20),Cl.Channel_Setting(2))
		sTemp=sTemp & "&nbsp;<select name=""SpecialID"">"
		sTemp=sTemp & ShowSpecial_Option(sChannelID,0,1) & "</select>"
	Case 5
		sTemp=sTemp & ShowSearchField(Cl.Channel_Setting(20),Cl.Channel_Setting(2))
		sTemp=sTemp & "&nbsp;<select name=""ClassID""><option value="""">所有栏目</option>"
		sTemp=sTemp & ShowClass_Option(sChannelID,0,2,3) & "</select>"
		sTemp=sTemp & "&nbsp;<select name=""SpecialID"">"
		sTemp=sTemp & ShowSpecial_Option(sChannelID,0,1) & "</select>"
	End Select
	sTemp=sTemp & "&nbsp;<input type=""text"" name=""keyword"" size=""18"" value=""关键字"" maxlength=""50"" onFocus=""this.select();"" />&nbsp;"
	sTemp=sTemp & "<input type=""submit"" name=""Submit""  value=""搜索"" />"
	sTemp=sTemp & "</td></tr></form></table>"
	ShowSearchForm=sTemp
End Function

Function ShowSearchField(sModuleID,sItemName)
	Dim sTemp
	sTemp="<select name=""Field"" size=""1"">"
   	select case Clng(sModuleID)
	case 1
		sTemp=sTemp & "<option value=""ID"">"&sItemName&"ID</option>"
		sTemp=sTemp & "<option value=""Title"" selected>"&sItemName&"标题</option>"
		sTemp=sTemp & "<option value=""Keyword"">关 键 字</option>"
		sTemp=sTemp & "<option value=""Intro"">"&sItemName&"简介</option>"
		sTemp=sTemp & "<option value=""CopyFrom"">"&sItemName&"来源</option>"
		sTemp=sTemp & "<option value=""Author"">"&sItemName&"作者</option>"
		sTemp=sTemp & "<option value=""Editor"">添加用户</option>"
		sTemp=sTemp & "<option value=""Censor"">审核用户</option>"
		sTemp=sTemp & "<option value=""Point"">"&sItemName&Cl.Web_Setting(28)&"</option>"
	case 2
		sTemp=sTemp & "<option value=""ID"">"&sItemName&"ID</option>"
		sTemp=sTemp & "<option value=""Title"" selected>"&sItemName&"名称</option>"
		sTemp=sTemp & "<option value=""Keyword"">关 键 字</option>"
		sTemp=sTemp & "<option value=""Intro"">"&sItemName&"简介</option>"
		sTemp=sTemp & "<option value=""Author"">"&sItemName&"作者</option>"
		sTemp=sTemp & "<option value=""Editor"">添加用户</option>"
		sTemp=sTemp & "<option value=""Censor"">审核用户</option>"
		sTemp=sTemp & "<option value=""Point"">"&sItemName&Cl.Web_Setting(28)&"</option>"
	case 3
		sTemp=sTemp & "<option value=""ID"">"&sItemName&"ID</option>"
		sTemp=sTemp & "<option value=""Title"" selected>"&sItemName&"名称</option>"
		sTemp=sTemp & "<option value=""Keyword"">关 键 字</option>"
		sTemp=sTemp & "<option value=""Intro"">"&sItemName&"简介</option>"
		sTemp=sTemp & "<option value=""Author"">"&sItemName&"作者</option>"
		sTemp=sTemp & "<option value=""Editor"">添加用户</option>"
		sTemp=sTemp & "<option value=""Censor"">审核用户</option>"
		sTemp=sTemp & "<option value=""Point"">"&sItemName&Cl.Web_Setting(28)&"</option>"
	case 4
		sTemp=sTemp & "<option value=""ID"">"&sItemName&"ID</option>"
		sTemp=sTemp & "<option value=""Title"" selected>"&sItemName&"名称</option>"
		sTemp=sTemp & "<option value=""Keyword"">关 键 字</option>"
		sTemp=sTemp & "<option value=""Intro"">"&sItemName&"简介</option>"
		sTemp=sTemp & "<option value=""Director"">"&sItemName&"导演</option>"
		sTemp=sTemp & "<option value=""ActName"">"&sItemName&"主演</option>"
		sTemp=sTemp & "<option value=""Editor"">添加用户</option>"
		sTemp=sTemp & "<option value=""Censor"">审核用户</option>"
		sTemp=sTemp & "<option value=""Point"">"&sItemName&Cl.Web_Setting(28)&"</option>"
	case 5
		sTemp=sTemp & "<option value=""ID"">"&sItemName&"ID</option>"
		sTemp=sTemp & "<option value=""Title"" selected>"&sItemName&"名称</option>"
		sTemp=sTemp & "<option value=""ProductSn"">"&sItemName&"编号</option>"
		sTemp=sTemp & "<option value=""Keyword"">关 键 字</option>"
		sTemp=sTemp & "<option value=""Intro"">"&sItemName&"简介</option>"
		sTemp=sTemp & "<option value=""Producer"">生 产 商</option>"
		sTemp=sTemp & "<option value=""Trademark"">品牌商标</option>"
		sTemp=sTemp & "<option value=""ProductModel"">"&sItemName&"型号</option>"
		sTemp=sTemp & "<option value=""Editor"">添加用户</option>"
		sTemp=sTemp & "<option value=""Censor"">审核用户</option>"
		sTemp=sTemp & "<option value=""MarketPrice"">"&sItemName&"价格</option>"
		sTemp=sTemp & "<option value=""Point"">"&sItemName&Cl.Web_Setting(28)&"</option>"
	case 6
		sTemp=sTemp & "<option value=""ID"">"&sItemName&"ID</option>"
		sTemp=sTemp & "<option value=""Title"" selected>"&sItemName&"标题</option>"
		sTemp=sTemp & "<option value=""Keyword"">关 键 字</option>"
		sTemp=sTemp & "<option value=""Intro"">"&sItemName&"简介</option>"
		sTemp=sTemp & "<option value=""CopyFrom"">"&sItemName&"来源</option>"
		sTemp=sTemp & "<option value=""Author"">"&sItemName&"作者</option>"
		sTemp=sTemp & "<option value=""Editor"">添加用户</option>"
		sTemp=sTemp & "<option value=""Censor"">审核用户</option>"
		sTemp=sTemp & "<option value=""Point"">"&sItemName&Cl.Web_Setting(28)&"</option>"
	end select
	ShowSearchField=sTemp & "</select>"
	sTemp=Empty
End Function

Function ShowRootClass(sChannelID,sRootID)
	dim sqlRoot,rsRoot,sTemp,i
	sqlRoot="select ClassID,ClassName,RootID,Child From Cl_Class where ChannelID="&Clng(sChannelID)&" and ParentID=0 and IsOuter=0 order by RootID"
	Set rsRoot = Cl.Execute(sqlRoot)
	if rsRoot.bof and rsRoot.eof then 
		sTemp="还没有任何栏目，请首先添加栏目。"
	else
		sqlRoot=rsRoot.GetRows(-1)
		For i=0 To Ubound(sqlRoot,2)
			if sqlRoot(2,i)=sRootID then
				sTemp = sTemp & "<a href=""" & FileName & "&ClassID=" & sqlRoot(0,i) & """><font color=red><b>" & sqlRoot(1,i) & "</b></font></a>"
			else
				sTemp = sTemp & "<a href=""" & FileName & "&ClassID=" & sqlRoot(0,i) & """>" & sqlRoot(1,i) & "</a>"
			end if
			if (i+1) mod 8=0 then
				sTemp=sTemp&"<br />"
			else
				sTemp=sTemp&"&nbsp;|&nbsp;"
			end if
		Next
	end if
	ShowRootClass=sTemp
	sqlRoot=Empty : sTemp=Empty
	rsRoot.Close : Set rsRoot=Nothing
End Function

Function ShowClass_Option(sChannelID,CurrentID,sDepth,ShowType)
	dim rsClass,sqlClass,sTemp,tmpDepth,i,n
	dim arrShowLine(10)
	CurrentID	= Clng(CurrentID)
	ShowType	= Clng(ShowType)
	sChannelID	= Clng(sChannelID)
	sDepth		= Clng(sDepth)
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	if ShowType=0 then
	    sTemp="<option value=""0"""
		if CurrentID=0 then sTemp=sTemp & " selected"
		sTemp=sTemp & ">无（作为一级栏目）</option>"
	end if
	sqlClass="Select ClassID,ClassName,Depth,NextID,IsOuter,Child From Cl_Class where ChannelID="&sChannelID&" "
	if sDepth>0 then
		sqlClass=sqlClass & " and Depth<"&sDepth&" order by RootID,OrderID"
	else
		sqlClass=sqlClass & " order by RootID,OrderID"
	end if
	set rsClass=Cl.Execute(sqlClass)
	if rsClass.bof and rsClass.bof then
		ShowClass_Option = sTemp & "<option value="""">请先添加栏目</option>"
		rsClass.close : set rsClass=Nothing : Exit Function
	End if
	sqlClass=rsClass.GetRows(-1)
	rsClass.close : set rsClass=Nothing
	Dim sChecked, sTClassName, sTPurview
	sTPurview=False
	For i=0 to Ubound(sqlClass,2)
		tmpDepth=sqlClass(2,i)
		if sqlClass(3,i)>0 then
			arrShowLine(tmpDepth)=True
		else
			arrShowLine(tmpDepth)=False
		end if
		sChecked = "" : sTClassName = ""
		if sqlClass(0,i)=CurrentID then sChecked = " selected"
		if tmpDepth>0 then
			for n=1 to tmpDepth
				sTClassName = sTClassName & "&nbsp;&nbsp;" 
				if n=tmpDepth then
					if sqlClass(3,i)>0 then
						sTClassName = sTClassName & "├&nbsp;"
					else
						sTClassName = sTClassName & "└&nbsp;"
					end if
				else
					if arrShowLine(n)=True then
						sTClassName = sTClassName & "│"
					else
						sTClassName = sTClassName & "&nbsp;"
					end if
				end if
			next
		else
 		sTPurview=Cl.TrueClassPurview_U(3,sChannelID,sqlClass(0,i))
		end if
		sTClassName = sTClassName & sqlClass(1,i)
		Select Case ShowType
		Case 0
			sTemp=sTemp & "<option value=""" & sqlClass(0,i) & """ "&sChecked&">" & sTClassName
			if sqlClass(4,i)=1 then sTemp=sTemp & "(外)"
			sTemp=sTemp & "</option>"
		Case 1
			if sqlClass(4,i)=1 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName & "(外)"
			elseif sqlClass(5,i)>0 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName
			else
				sTemp=sTemp & "<option value=""" & sqlClass(0,i) & """ "&sChecked&">" & sTClassName
			end if
			sTemp=sTemp & "</option>"
		Case 2
			if Not sTPurview then
				sTPurview=Cl.TrueClassPurview_U(3,sChannelID,sqlClass(0,i))
			end if
			if sqlClass(4,i)=1 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName & "(外)"
			elseif sqlClass(5,i)>0 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName
			elseif Not sTPurview then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName & "(*)"
			else
				sTemp=sTemp & "<option value=""" & sqlClass(0,i) & """ "&sChecked&">" & sTClassName
			end if
			sTemp=sTemp & "</option>"
		Case 3
			if sqlClass(4,i)=0 then
				sTemp=sTemp & "<option value=""" & sqlClass(0,i) & """ "&sChecked&">" & sTClassName & "</option>"
			end if
		Case 4
			if Not sTPurview then
				sTPurview=Cl.TrueClassPurview_U(3,sChannelID,sqlClass(0,i))
			end if
			if sqlClass(5,i)>0 then
				sTemp=sTemp & "<option value=""0"" "&sChecked&">" & sTClassName & "(*)"
			elseif sTPurview then
				sTemp=sTemp & "<option value=""" & sqlClass(0,i) & """ "&sChecked&">" & sTClassName
			end if
			sTemp=sTemp & "</option>"
		Case else
			sTemp=sTemp & "<option value=""" & sqlClass(0,i) & """ "&sChecked&">" & sTClassName & "</option>"
		End Select
	Next
	ShowClass_Option=sTemp
	sqlClass=Empty : sTemp=Empty
End Function

Function ShowManageClassPath(sChannelID,sClassName,sParentPath,iDepth)
	dim sTemp
	if iDepth<=0 then ShowManageClassPath = sClassName : Exit Function
	dim sqlPath,rsPath,i
	sqlPath="select ClassID,ClassName,Depth From Cl_Class where ChannelID="&Clng(sChannelID)&" and ClassID in (" & sParentPath & ") order by Depth"
	set rsPath=Cl.Execute(sqlPath)
	do while not rsPath.eof
		for i=1 to rsPath("Depth")
			sTemp= sTemp & "&nbsp;&nbsp;&nbsp;"
		next
		if rsPath("Depth")>0 then
			sTemp= sTemp & "└"
		end if
		sTemp= sTemp & rsPath("ClassName") & "<br />"
		rsPath.movenext
	loop
	Set rsPath=Nothing
	if iDepth>0 and sClassName<>"" then
		for i=1 to iDepth
			sTemp= sTemp & "&nbsp;&nbsp;&nbsp;"
		next
		sTemp= sTemp & "└" & sClassName
	end if
	ShowManageClassPath = sTemp
	sTemp=Empty
End Function

Function ShowManageChild(sChannelID,sClassID)
	dim sqlChild,rsChild,sTemp,i
	sqlChild = "select ClassID,ClassName,Child From Cl_Class where ChannelID="&Cint(sChannelID)&" and ParentID=" & sClassID & " order by OrderID"
	Set rsChild = Cl.Execute(sqlChild)
	If rsChild.bof and rsChild.eof then
		ShowManageChild = ""
		rsChild.Close : Set rsChild = Nothing : Exit Function
	End If
	sqlChild=rsChild.GetRows(-1)
	rsChild.Close : Set rsChild = Nothing
	sTemp = " &gt;&gt; "
	For i=0 to Ubound(sqlChild,2)
		sTemp = sTemp & "<a href=""" & FileName & "&ClassID=" & sqlChild(0,i) & """>" & sqlChild(1,i) & "</a>"
		if sqlChild(2,i)>0 then sTemp = sTemp & "(" & sqlChild(2,i) & ")"
		if (i+1) mod 8=0 then
			sTemp = sTemp & "<br />"
		else
			sTemp = sTemp & "&nbsp;&nbsp;"
		end if
	Next
	ShowManageChild=sTemp
	sqlChild=Empty
End Function

Function ShowRootSpecial(sChannelID,sSpecialID)
	dim sqlSpecial,rsSpecial,sTemp,i
	sqlSpecial="select SpecialID,SpecialName from Cl_Special where ChannelID=-1 or ChannelID="&sChannelID&" order by OrderID"
	set rsSpecial=Cl.Execute(sqlSpecial)
	if rsSpecial.bof and rsSpecial.eof then
		sTemp="没有任何专题"
	else
		sqlSpecial=rsSpecial.GetRows(-1)
		For i=0 to Ubound(sqlSpecial,2)
			if sqlSpecial(0,i)=sSpecialID then
				sTemp=sTemp&"<a href=""" & FileName & "&SpecialID=" & sqlSpecial(0,i) & """><font color=red><b>" & sqlSpecial(1,i) & "</b></font></a>"
			else
				sTemp=sTemp&"<a href=""" & FileName & "&SpecialID=" & sqlSpecial(0,i) & """>" & sqlSpecial(1,i) & "</a>"
			end if
			if (i+1) mod 8=0 then
				sTemp=sTemp&"<br />"
			else
				sTemp=sTemp&"&nbsp;|&nbsp;"
			end if
		Next
	end if
	ShowRootSpecial=sTemp
	sqlSpecial=Empty : sTemp=Empty
	rsSpecial.Close : Set rsSpecial=Nothing
End Function

Function ShowSpecial_Option(sChannelID,sSpecialID,ShowType)
	dim sqlSpecial,rsSpecial,sTemp,i
	ShowType	= Clng(ShowType)
	sChannelID	= Clng(sChannelID)
	sTemp = "<option value=""0"""
	if sSpecialID="0" then sTemp = sTemp & " selected"
	sTemp = sTemp & ">不指定专题</option>"
	sqlSpecial = "select SpecialID,SpecialName,AddGroup from Cl_Special where (ChannelID=-1 or ChannelID="&sChannelID&") order by OrderID Desc"
	set rsSpecial=Cl.Execute(sqlSpecial)
	if Not (rsSpecial.bof and rsSpecial.bof) then
		sqlSpecial=rsSpecial.GetRows(-1)
		for i=0 to Ubound(sqlSpecial,2)
		if Cl.ChkUserLevel(sqlSpecial(2,i),Cl.UserLevel) or ShowType=1 then
			if Instr(","&sSpecialID&",",","&sqlSpecial(0,i)&",")>0 then
				sTemp = sTemp & "<option value=""" & sqlSpecial(0,i) & """ selected>" & sqlSpecial(1,i) & "</option>"
			else
				sTemp = sTemp & "<option value=""" & sqlSpecial(0,i) & """>" & sqlSpecial(1,i) & "</option>"
			end if
		end if
		Next
	end if
	Set rsSpecial = Nothing
	ShowSpecial_Option = sTemp
	sqlSpecial=Empty
End Function

'=================================================
'显示专题名称:ShowSpecial(sChannelID,TopNum)
'sChannelID		----- (频道ID，为区分链接)
'TopNum			----- (最多显示多少个专题名称)
'=================================================
Function ShowSpecial(sChannelID,TopNum)
	Dim Sql, Rs, i, sTemp
	TopNum		= Cl.ChkClng(TopNum)
	sChannelID	= Cl.ChkClng(sChannelID)
	if TopNum = 0 then TopNum = 10
	if sChannelID = 0 then sChannelID = 1
	Sql="Select Top "&TopNum&" SpecialID,SpecialName,ChannelID from Cl_Special where ChannelID=-1 or ChannelID="&sChannelID&" order by OrderID"
	Set Rs = Cl.Execute(sql)
	if Rs.bof and Rs.eof then
		ShowSpecial= "&nbsp;没有任何专题栏目"
		Rs.Close : Set Rs = Nothing : Exit Function
	else
		Sql=Rs.GetRows(-1)
		Rs.Close : Set Rs = Nothing
		Cl.GetChannelSetting(sChannelID)
		sTemp = "<li><a href=""" & Cl.WebDir & Cl.Channel_Setting(4) & "/ShowSpecial.Asp?SpecialID=" & Sql(0,0) & """>" & Sql(1,0) & "</a></li><br />"
		For i = 1 to Ubound(Sql,2)
			sTemp = sTemp & "<li><a href=""" & Cl.WebDir & Cl.Channel_Setting(4) & "/ShowSpecial.Asp?SpecialID=" & Sql(0,i) & """>" & Sql(1,i) & "</a></li><br />"
		Next
		ShowSpecial=sTemp & "<p align=""right""><a href=""" & Cl.WebDir & "SpecialList.asp?ChannelID="&sChannelID&""">更多专题</a></p>"
		SQL=Empty
	end if
End Function
'分页显示所有专题
Function ShowSpecialList(sChannelID)
	Dim SQL,Rs,i,sTemp
	SQL="select SpecialID,SpecialName,ChannelID from Cl_Special where ChannelID=-1 or ChannelID="&sChannelID&" order by OrderID"
	Set Rs= server.CreateObject ("adodb.recordset")
	OpenConn : Rs.open SQL,Conn,1,1
	if rs.bof and rs.eof then
		TotalPut=0
		ShowSpecialList = "&nbsp;没有任何专题栏目"
		Rs.close : Set Rs=Nothing : Exit Function
	else
		Cl.GetChannelSetting(sChannelID)
		TotalPut=rs.recordcount
		if (TotalPut mod MaxPerPage)=0 then
			TotalPages = TotalPut \ MaxPerPage
		else
			TotalPages = TotalPut \ MaxPerPage + 1
		end if
		if CurrentPage > TotalPages then CurrentPage=TotalPages
		if CurrentPage < 1 then CurrentPage=1
		rs.move (CurrentPage-1)*MaxPerPage
		SQL = Rs.GetRows(-1)
		Rs.close:Set Rs=Nothing
		if sChannelID=0 then
			For i=0 to Ubound(SQL,2)
				sTemp=sTemp & "<li>" & SQL(1,i) & "&nbsp;-->&nbsp;"
				Cl.Name="Channel"
				If Cl.ObjIsEmpty() Then Cl.Load_Channel()
				dim sTrRow,sTrCol,n
				sTrRow=Split(Cl.value,"$$$")
				For n = 0 to UBound(sTrRow)-1
					sTrCol=Split(sTrRow(n),"|||")
					if Cint(sTrCol(4))<2 and Cint(strcol(0))<>0 and Cint(strcol(0))<>6 then
						sTemp = sTemp & "&nbsp;[<a href='" & Cl.WebDir & sTrCol(2) &"/ShowSpecial.Asp?SpecialID=" & SQL(0,i) & "'>" & sTrCol(1)&"</a>]"
					end if
				next
				sTemp = sTemp & "</li>"
			Next
		else
			For i=0 to Ubound(SQL,2)
				sTemp=sTemp & "<li><a href=""" & Cl.WebDir & Cl.Channel_Setting(4) & "/ShowSpecial.Asp?SpecialID=" & SQL(0,i) & """>" & SQL(1,i) & "</a></li>"
			Next
		end if
		ShowSpecialList = sTemp
		SQL=Empty
	end if
End Function

'==============================================
Sub RefreshJs(Byval sChannelID)
	Dim RsRe,sTr,sID,sModuleID,TempData
	sID=Cl.ChkClng(sChannelID)
	if sID>0 then
		Set RsRe=Cl.Execute("Select ChannelID,JsName,JsReadme,JsType,JsFileName,Config From Cl_Js where ChannelID="&sID&"")
	else
		Set RsRe=Cl.Execute("Select ChannelID,JsName,JsReadme,JsType,JsFileName,Config From Cl_Js")
	end if
	Do while Not Rsre.eof
		ChannelID=RsRe(0)
		Cl.GetChannelSetting(ChannelID)
		sModuleID=Cl.ChkClng(Cl.Channel_Setting(20))
		if sModuleID=0 then Exit do
		Cl.LoadTemplates("")
		if Rsre("JsType")=0 then
			TempData=Cl.ReplaceAllFlag(Rsre("Config"))
		else
			sTr=Split(Rsre("Config"),"@@")
			sTr(0)=Split(sTr(0),"||")
			sTr(1)=Split(sTr(1),"||")
			Select Case sModuleID
			Case 1
				TempData=GetArticle(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
			Case 2
				TempData=GetSoft(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
			Case 3
				TempData=GetPhoto(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
			Case 4
				TempData=GetMovie(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
			Case 5
				TempData=GetProduct(sTr(0)(0),sTr(0)(1),sTr(0)(2),sTr(0)(3),sTr(0)(4),sTr(0)(5),sTr(0)(6),sTr(0)(7),sTr(0)(8),sTr(0)(9),sTr(0)(10),sTr(1)(0),sTr(1)(1),sTr(1)(2))
			Case Else
				Exit do
			End Select
		end if
		TempData=replace(TempData,chr(34),"\"&chr(34))
		TempData=replace(replace(TempData,chr(10),"\n"),chr(13),"\n")
		TempData=Replace(TempData,Vbcrlf,"")
		TempData="document.write (""" & Replace(TempData,",","") & """);"
		Cl.MakeHtml TempData,Cl.WebDir & Cl.Channel_Setting(4) & "/Js/"&Rsre("JsFileName")&".Js"
		Rsre.Movenext
	Loop
	RsRe.Close:Set RsRe=Nothing
End Sub

Sub RefreshCountJs()
	Dim rs,strJs
	Set rs=Cl.Execute("Select ChannelID,ChannelName,ChannelItemName,ChannelItemUnit,CountConfig From Cl_Channel where ChannelType<=1 Order by OrderID")
	do while not rs.eof
		strJs=Replace(Cl.ChkNull(rs(4)),"{%channelid%}",rs(0))
		strJs=Cl.ReplaceFlag(strJs,"ShowWebCount","")
		strJs=Replace(strJs,"{%channelname%}",rs(1))
		strJs=Replace(strJs,"{%channelitemname%}",rs(2))
		strJs=Replace(strJs,"{%channelitemunit%}",rs(3))
		strJs=Replace(strJs,chr(34),"\"&chr(34))
		strJs="document.write ('"&Replace(strJs,VbCrLf,"<br />")&"');"
		Cl.MakeHtml strJs,Cl.WebDir&"Js/Count/Count_"&rs(0)&".Js"
		rs.MoveNext
	loop
	Set rs=Nothing
End Sub

Sub RefreshClassMenuJs()
	Dim rs
	Set rs=Cl.Execute("Select ChannelID From Cl_Channel where ChannelType<=1 and ChannelID>0 and ChannelID<>6  Order by OrderID")
	Cl.LoadTemplates("")
	do while not rs.eof
		ChannelID=rs(0)
		Cl.MakeHtml Cl.GetClassMenu(ChannelID),Cl.WebDir&"Js/ClassMenu/ClassMenu_" & ChannelID & ".Js"
		rs.MoveNext
	loop
	Set rs=Nothing
End Sub

Sub CreateClassJs(sChannelID)
	Cl.GetChannelSetting(sChannelID)
	Cl.LoadTemplates("")
	Cl.MakeHtml Cl.GetClassMenu(sChannelID),Cl.WebDir&"Js/ClassMenu/ClassMenu_" & sChannelID & ".Js"
	dim strSearchDate,i
	for i=3 to 5
	strSearchDate=Replace(Cl.ReplaceDir(ShowSearchForm(sChannelID,i)),chr(34),"\"&chr(34))
	strSearchDate="document.write (""" & Replace(strSearchDate,vbcrlf,"\n") & """);"
	Cl.MakeHtml strSearchDate,Cl.WebDir&"Js/Search/Search" & sChannelID & "_" & i & ".Js"
	next
End Sub

Function ChkPicUrl(sDir,sTopDir,PicUrl)
	If IsEmpTy(PicUrl) or PicUrl="" then
		ChkPicUrl=sDir & "Images/NoPic.Gif"
	else
		PicUrl=lcase(Trim(PicUrl))
		PicUrl=Replace(PicUrl,"{%webdir%}",sDir)
		PicUrl=Replace(PicUrl,"{%uploaddir%}",sTopDir & Cl.UploadDir)
		ChkPicUrl=PicUrl
	End if
End Function

Sub Admin_ShowErr(sErrMsg)
	Response.Write "<html><head><title>错误信息</title>"
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
	Response.Write "<link href=""../Skins/Admin_Style.Css"" rel=""stylesheet"" type=""text/css"">"
	Response.Write "</head><body><br /><br />"
	Response.Write "<table cellpadding=2 cellspacing=1 border=0 class=""border"" align=center>"
	Response.Write "<tr align=""center"" class=""title""><td height=""22""><strong>错误信息</strong></td></tr>"
	Response.Write "<tr class=""tdbg""><td height=""100"" valign=""top""><b>产生错误的可能原因：</b><br />"&sErrMsg&"</td></tr>"
	Response.Write "<tr align=""center"" class=""tdbg""><td>【<a href=""javascript:history.go(-1)"">返回上一步</a>】&nbsp;&nbsp;【<a href=""javascript:window.close();"">关闭窗口</a>】&nbsp;&nbsp;【<a href=""javascript:location.href='Admin_Index.asp'"" target=""_top"">重登录后台</a>】</td></tr>"
	Response.Write "</table></body></html>"
	CloseAllObj
	response.end
End Sub

'显示错误提示信息
Sub User_ShowErr(sErrMsg)
	Response.Write "<html><head><title>错误信息</title>"
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
	Response.Write "<link href=""../Skins/User_Style.Css"" rel=""stylesheet"" type=""text/css"">"
	Response.Write "</head><body><br /><br />"
	Response.Write "<table cellpadding=2 cellspacing=1 border=0 class=""border"" align=center>"
	Response.Write "<tr align=""center"" class=""title""><td height=""22""><strong>错误信息</strong></td></tr>"
	Response.Write "<tr class=""tdbg""><td height=""100"" valign=""top""><b>产生错误的可能原因：</b><br />"&sErrMsg&"</td></tr>"
	Response.Write "<tr align=""center"" class=""tdbg""><td>【<a href=""javascript:history.go(-1)"">返回上一步</a>】&nbsp;&nbsp;【<a href=""javascript:window.close();"">关闭窗口</a>】</td></tr>"
	Response.Write "</table></body></html>"
	CloseAllObj
	response.end
End Sub

Sub User_MsgNav()
	Response.Write "<table border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"">"
	Response.Write "<tr height=""22"">"
	Response.Write "	<td class=""title"" align=""center"">用户短消息功能</td>"
	Response.Write "</tr>"
	Response.Write "<TR><TD align=""center"" class=""tdbg"">"
	Response.Write "		<a href=""User_Message.asp?action=inbox""><img src="""&Cl.WebDir&"Images/Message/inbox.gif"" border=0 alt=""收件箱"" /></a> &nbsp; "
	Response.Write "		<a href=""User_Message.asp?action=outbox""><img src="""&Cl.WebDir&"Images/Message/outbox.gif"" border=0 alt=""发件箱"" /></a> &nbsp; "
	Response.Write "		<a href=""User_Message.asp?action=issend""><img src="""&Cl.WebDir&"Images/Message/issend.gif"" border=0 alt=""已发送邮件"" /></a> &nbsp; "
	Response.Write "		<a href=""User_Message.asp?action=recycle""><img src="""&Cl.WebDir&"Images/Message/recycle.gif"" border=0 alt=""废件箱"" /></a> &nbsp; "
	Response.Write "		<a href=""User_Friend.asp""><img src=""../images/Message/address.gif"" border=""0"" alt=""地址簿"" /></a> &nbsp; "
	Response.Write "		<a href=""User_Message.asp?action=new""><img src="""&Cl.WebDir&"Images/Message/write.gif"" border=0 alt=""发送消息"" /></a></td></tr>"
	Response.Write "</table><br />"
End Sub

Sub Header()
	Response.Write "<html>" & Vbcrlf & "<head>" & Vbcrlf
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"" />"  & Vbcrlf & _
		"<meta name=""generator"" content=""Aspoo"" />"  & Vbcrlf & _
		"<link rev=""MADE"" href=""mailto:asp"&"oo@12"&"6.com"">" & Vbcrlf
	Response.Write "<title>Aspoo创力网站管理系统--后台管理</title>" & Vbcrlf
	Response.Write "<link rel=""stylesheet"" type=""text/css"" href=""../Skins/Admin_Style.Css"" />" & Vbcrlf
	Response.Write "<script language=""JavaScript"" src=""../Inc/Js/Admin.js"" type=""text/javascript""></script>" & Vbcrlf
	Response.Write "</head>" & Vbcrlf
	Response.Write "<body leftmargin=""0"" topmargin=""0"" marginwidth=""0"" marginheight=""0"">"
End Sub

Sub Footer()
	Response.Write "<table border=""0"" cellpadding=""0"" cellspacing=""3"" align=""center"" class=""footer"">" & Vbcrlf & _
		"<tr>" & Vbcrlf & _
			"<td align=""center""><a href=""http://Www."&"Asp"&"oo.Cn/"" target=""_blank"">Cr"&"eate"&"Live C"&"MS V"&"ersion 3"&".1<font color=""blue"">."&Right(Cl.SysTemUpDate,4)&"</font></a></td>" & Vbcrlf & _
		"</tr>" & Vbcrlf & _
		"<tr>" & Vbcrlf & _
			"<td align=""center"">"& Cl.Web_info(9) &"</td>" & Vbcrlf & _
		"</tr>" & Vbcrlf & _
		"</table>" & Vbcrlf
	Response.Write "</body>" & Vbcrlf & "</html>"
	CloseAllObj
End Sub

Public Sub ShowCreateWindow(w_title,w_href)
	Response.Write "<table border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"">"
	Response.Write "<tr class=""title""><td align=""center"" height=""22""><b>HTML生成管理窗口</b></td></tr>"
	Response.Write "<tr class=""tdbg""><td align=""center"" height=""22""><span id=txt1 name=txt1 style=""font-size:12pt""><b>"&w_title&"</b><br /><font color=red>注意，在未完成时，请不要关闭浏览器或刷新本页。</font></span></td></tr>"
	Response.Write "<tr class=""tdbg""><td align=""center"" valign=""middle"">"
	Response.Write "<table cellpadding=""3"" cellspacing=""1"" border=""0"" width=""500"">"
	Response.Write "<tr><td height=""33"" align=""center"" colspan=2><span id=txt4 name=txt4 style=""font-size:9pt""></span></td></tr>"
	Response.Write "<tr><td width=""500"" height=""22"" align=""center"">"
	Response.Write "<table width=""500"" border=""1"" cellspacing=""0"" cellpadding=""1"">"
	Response.Write "<tr><td><img src=""../Images/bar/bar3.gif"" width=0 height=16 id=img1 name=img1 align=absmiddle></td></tr></table>"
	Response.Write "</td></tr>"
	Response.Write "<tr><td><span id=txt2 name=txt2 style=""font-size:9pt"">0</span><span style=""font-size:9pt"">%</span></td></tr>"
	Response.Write "<tr><td><span id=txt5 name=txt5 style=""font-size:9pt""></span></td></tr></table>"
	Response.Write "<table cellpadding=""3"" cellspacing=""1"" border=""0"" width=""500"">"
	Response.Write "<tr><td height=""33"" align=""center"" colspan=2><input type=""button"" name=""cancel"" value="" 取 消 "" onclick=""window.location.href='"&w_href&"';"">&nbsp;&nbsp;<Input id=isshowwork name=isshowwork type=Checkbox value=1 onclick=showwork()><span id=showw>查看详细进程</span></td></tr>"
	Response.Write "</table>"
	Response.Write "<Div ID=""work"" style=""display:none;""><table cellpadding=""3"" cellspacing=""1"" border=""0"" width=""500"">"
	Response.Write "<tr><td><span id=txt3 name=txt3 style=""font-size:9pt""></span></td></tr></table></Div>"
	Response.write "</td></tr></table>"
	Response.write "<script type=""text/javascript"">" & VbCrLf
	Response.write "<!--" & VbCrLf
	Response.write "function showwork(){" & VbCrLf
	Response.write "if (document.getElementById('isshowwork').checked == true) {" & VbCrLf
	Response.write "	document.getElementById('work').style.display = '';" & VbCrLf
	Response.write "	document.getElementById('showw').innerText='关闭详细进程';" & VbCrLf
	Response.write "}else{" & VbCrLf
	Response.write "	document.getElementById('work').style.display = 'none';" & VbCrLf
	Response.write "	document.getElementById('showw').innerText='查看详细进程';" & VbCrLf
	Response.write "}" & VbCrLf
	Response.write "}" & VbCrLf
	Response.write "//-->" & VbCrLf
	Response.write "</script>"
	Response.Flush
End Sub
Public Sub RefreshHtml(txt,Nown,Alln)
	Response.Write "<script language='JavaScript' type='text/javascript'>img1.width=" & Fix((Nown/Alln) * 500) & ";" & VbCrLf & _
					"txt2.innerHTML=""" & FormatNumber(Nown/Alln*100,2,-1) & """;" & VbCrLf & _
					"txt3.innerHTML+=""<br />"&txt&""";" & _
					"</script>"
	Response.Flush
End Sub
Public Sub RefreshHtml2(SName,SValue)
	Response.Write "<script language='JavaScript' type='text/javascript'>" & vbCrLf & _
					SName & ".innerHTML=""" & SValue & """;" & vbCrLf & _
					"</script>"
	Response.Flush
End Sub
%>
