<%
'===================================================
' CreateLive CMS Version 3.1
'							Powered by Aspoo.CoM
'===================================================
' File: Cl_Function_Article.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.
'===================================================
Public Sub Article_Setting()
	CurrentPath = Cl.lanstr(1) & "<a href='" & Cl.Web_info(4) & "'>" & Cl.Web_info(0) & "</a>&nbsp;&gt;&gt;&nbsp;<a href='" & Cl.WebDir & Cl.ChannelDir & "'>" & Cl.ChannelName & "</a>"
	Cl.Title = Cl.NoHtml(Cl.ChannelName) & " " & Cl.GotTopic(Cl.ChannelReadMe,50) & "[" & Cl.Web_info(1) & "]"
	if keyword<>"" then keyword=Cl.ReplaceBadChar(keyword)
	if ArticleID>0 then
		Set rs = Cl.Execute("select * From Cl_Article where ChannelID=" & ChannelID & " and Deleted=False and Passed=True and ArticleID=" & ArticleID & "")
		if rs.bof and rs.eof then Cl.OutErr(Replace(Template.Strings(0),"{%channelitemname%}",Cl.ChannelItemName))
		ClassID=rs("ClassID"):SpecialID=rs("SpecialID"):InfoTitle=rs("Title")
		if rs("Hot")=False then
			if rs("hits")>=Clng(Cl.Web_Setting(14)) then Cl.Execute("Update Cl_Article Set Hot=True where ArticleID=" & ArticleID & "")
		end if
	end if
	if ClassID>0 then
		sql="select ClassName,ParentID,ParentPath,ClassDir,ParentDir,RootID,Depth,Child,arrChildID,BrowsePurview,VipUser,StyleID,CssID From Cl_Class where ChannelID="&ChannelID&" and ClassID=" & ClassID
		set tClass=Cl.Execute(sql)
		if tClass.bof and tClass.eof then Cl.OutErr(Template.Strings(2))
		ClassName	= tClass(0) : ParentID	= tClass(1) : ParentPath= tClass(2)
		ClassDir	= tClass(3) : ParentDir	= tClass(4) : RootID	= tClass(5)
		Depth		= tClass(6) : Child		= tClass(7)	: arrChildID= tClass(8)
		BrowsePurview=tClass(9) : VipUser	= tClass(10): TStyleID	= tClass(11) : TCssID=tClass(12)
		if TStyleID > 0 or TCssID > -1 then
			If TStyleID > 0 then Cl.StyleID = TStyleID
			If TCssID > -1	then Cl.CssID	= TCssID
			Cl.LoadTempLates(Cl.Channel_Setting(4))
		end if
		if ParentID>0 then
			dim sqlPath,rsPath
			sqlPath="select ClassID,ClassName,ParentPath,ClassDir,ParentDir From Cl_Class where ChannelID="&ChannelID&" and ClassID in (" & ParentPath & ") order by Depth"
			set rsPath=Cl.Execute(sqlPath)
			do while not rsPath.eof
				CurrentPath=CurrentPath & "&nbsp;&gt;&gt;&nbsp;<a href='" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),rsPath(2),rsPath(0),rsPath(4),rsPath(3),Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & "'>" & rsPath(1) & "</a>"
				rsPath.movenext
			loop
			set rsPath=Nothing
		end if
		CurrentPath=CurrentPath & "&nbsp;&gt;&gt;&nbsp;<a href='" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),ParentPath,ClassID,ParentDir,ClassDir,Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & "'>" & ClassName & "</a>"
	end if
End Sub
'Rem 文章
Function GetArticle(Byval sChannelID,Byval sClassID,Byval sSpecialID,Byval TopNum,Byval IncludeChild,Byval ShowType, _
Byval ColsNum,Byval IsHot,Byval IsElite,Byval DateNum,Byval OrderType,Byval Style1,Byval Style2,Byval Style3)
	Dim JsSQL,sHTML,sTitleMaxLen,TitleStr,LinkUrl,FileType
	Dim Author,AuthorName,AuthorEmail
	Dim SystemTopDir,SystemDir
	Dim Rs,i
	On Error Resume Next
	SystemTopDir	= "http://"&Request.servervariables("Server_Name")
	SystemDir		= SystemTopDir & Cl.WebDir
	sChannelID		= Clng(sChannelID)
	sClassID		= Clng(sClassID)
	sSpecialID		= Clng(sSpecialID)
	TopNum			= Clng(TopNum)
	IncludeChild	= CBool(IncludeChild)
	ShowType		= Clng(ShowType)
	ColsNum			= Clng(ColsNum)
	IsHot			= CBool(IsHot)
	IsElite			= CBool(IsElite)
	DateNum			= CLng(DateNum)
	OrderType		= CLng(OrderType)
	Style1			= Trim(Style1)
	Style2			= Trim(Style2)
	Style3			= Trim(Style3)
	if Err then Err.Clear : GetArticle="GetArticle参数错误。":Exit Function
	On Error GoTo 0
	Cl.GetChannelSetting(sChannelID)
	if TopNum > 0 then
		JsSQL="select top " & TopNum & " "
	else
		JsSQL="select top 100 "
	end if
	JsSQL=JsSQL & " A.ArticleID,A.ClassID,C.ClassName,C.ParentPath,C.ClassDir,C.ParentDir,A.Title,A.Prefixion,A.Author,A.CopyFrom,A.Editor,A.Keyword,A.Hits,A.DayHits,A.WeekHits,A.MonthHits,A.UpdateTime,A.OnTop,A.Hot,A.Elite,A.Passed,A.Content,A.DefaultPicUrl,A.ReadLevel,A.ReadPoint,A.Stars,A.TitleFontColor,A.TitleFontType,A.IsHtml,A.HtmlFileUrl,A.Intro,A.IsLink from Cl_Article A"
	JsSQL=JsSQL & " inner join Cl_Class C on A.ClassID=C.ClassID where A.Deleted=False and A.Passed=True and A.ChannelID="&sChannelID&""
	if sClassID>0 then
		if IncludeChild=True then
			Dim tClass
			set tClass=Cl.Execute("select ClassID,ParentPath,arrChildID From Cl_Class where ClassID=" & sClassID)
			if tClass.bof and tClass.eof then
				GetArticle="找不到指定的栏目。" : set tClass=Nothing : Exit Function
			else
				JsSQL=JsSQL & " and A.ClassID in (" & tClass(2) & ")"
			end if
			set tClass=Nothing
		else
			JsSQL=JsSQL & " and A.ClassID=" & sClassID & ""
		end if
	end if
	if sSpecialID>0 then JsSQL=JsSQL & " and A.SpecialID like '%" & sSpecialID & "%'"
	if ShowType >= 2 then JsSQL=JsSQL & " and A.DefaultPicUrl<>''"
	if IsHot=True then JsSQL=JsSQL & " and A.Hot=True"
	if IsElite=True then JsSQL=JsSQL & " and A.Elite=True"
	if DateNum>0 then
		JsSQL=JsSQL & " and DATEDIFF('d',A.UpdateTime,"&SQLNowString&")<=" & DateNum & " "
	end if
	JsSQL=JsSQL & " order by A.OnTop asc"
	Select Case OrderType
	Case 1 : JsSQL=JsSQL & " ,A.ArticleID desc"
	Case 2 : JsSQL=JsSQL & " ,A.ArticleID asc"
	Case 3 : JsSQL=JsSQL & " ,A.UpDateTime desc, A.ArticleID desc"
	Case 4 : JsSQL=JsSQL & " ,A.UpDateTime asc, A.ArticleID desc"
	Case 5 : JsSQL=JsSQL & " ,A.Hits desc, A.ArticleID desc"
	Case 6 : JsSQL=JsSQL & " ,A.Hits asc, A.ArticleID desc"
	Case else : JsSQL=JsSQL & " ,A.ArticleID desc"
	End Select
	set Rs=server.createObject("Adodb.recordset")
	OpenConn : Rs.open JsSQL,Conn,1,1
	if Rs.bof and Rs.eof then 
		GetArticle = "没有任何"&Cl.Channel_Setting(2)&"!"
		Rs.close:set Rs=Nothing : Exit Function
	End if
	JsSQL=Rs.GetRows(-1)
	Rs.close:set Rs=Nothing
	Dim TempBody
	Dim regEx,Matches,Match,TempStr
	Dim PropertyImg,ClassFileUrl,sImgUrl
	TempBody="":sHTML=""
	Set regEx	= New RegExp
	regEx.Pattern = "(\{%)(.[^\{]*)(\%\})"
	regEx.IgnoreCase = True
	regEx.Global = True
	For i=0 to Ubound(JsSQL,2)
		if JsSQL(28,i)=True and Clng(Cl.Channel_Setting(10))=1 then
			LinkUrl = SystemDir & JsSQL(29,i)
		elseif JsSQL(31,i)=True then
			LinkUrl = SystemDir & JsSQL(29,i)
		else
			LinkUrl = SystemDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID=" & JsSQL(0,i)
		end if
		if instr(JsSQL(8,i),"|")>0 then
			Author		= Split(JsSQL(8,i),"|")
			AuthorName	= Author(0)
			AuthorEmail = Author(1)
		else
			AuthorName	= JsSQL(8,i)
		end if
		if JsSQL(17,i)=True then
			PropertyImg = "<img src=""" & ChkPicUrl(SysTemDir,SysTemTopDir,Cl.mainpic(13)) & """ alt=""固顶"" />"
		elseif JsSQL(19,i)=True then
			PropertyImg = "<img src=""" & ChkPicUrl(SysTemDir,SysTemTopDir,Cl.mainpic(12)) & """ alt=""推荐"" />"
		else
			PropertyImg = "<img src=""" & ChkPicUrl(SysTemDir,SysTemTopDir,Cl.mainpic(11)) & """ alt=""普通"" />"
		end if
		ClassFileUrl = SystemDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),JsSQL(3,i),JsSQL(1,i),JsSQL(5,i),JsSQL(4,i),Cl.Channel_Setting(10),Cl.Channel_Setting(13))
		if ShowType >= 2 then
			FileType=right(lcase(JsSQL(22,i)),3)
			JsSQL(22,i) = ChkPicUrl(SysTemDir,SysTemTopDir,JsSQL(22,i))
			Select Case FileType
			Case "swf"
				sImgUrl = "<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=""{%ImgWidth%}"" height=""{%ImgHeight%}""><param name=""movie"" value=""" & JsSQL(22,i) & """><param name=""quality"" value=""high""><embed src=""" & JsSQL(22,i) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""{%ImgWidth%}"" height=""{%ImgHeight%}""></embed></object>"
			Case "jpg", "bmp", "png", "gif"
				sImgUrl = "<img src=""" & JsSQL(22,i) & """ width=""{%ImgWidth%}"" height=""{%ImgHeight%}"" border=0>"
			Case Else
				sImgUrl = "<img src=""" & SystemDir & "images/NoPic2.jpg"" width=""{%ImgWidth%}"" height=""{%ImgHeight%}"" border=0>"
			End Select
		end if
		TempBody	= Style2
		TempBody	= Replace(TempBody,"{%InfoID%}",JsSQL(0,i))
		TempBody	= Replace(TempBody,"{%Prefixion%}",JsSQL(7,i)&"")
		TempBody	= Replace(TempBody,"{%PropertyImg%}",PropertyImg)
		TempBody	= Replace(TempBody,"{%LinkUrl%}",LinkUrl)
		TempBody	= Replace(TempBody,"{%ClassID%}",JsSQL(1,i))
		TempBody	= Replace(TempBody,"{%ClassName%}",JsSQL(2,i))
		TempBody	= Replace(TempBody,"{%ClassUrl%}",ClassFileUrl)
		TempBody	= Replace(TempBody,"{%AuthorName%}",AuthorName)
		TempBody	= Replace(TempBody,"{%AuthorEmail%}",AuthorEmail)
		TempBody	= Replace(TempBody,"{%Hits%}",JsSQL(12,i))
		TempBody	= Replace(TempBody,"{%DayHits%}",JsSQL(13,i))
		TempBody	= Replace(TempBody,"{%WeekHits%}",JsSQL(14,i))
		TempBody	= Replace(TempBody,"{%MonthHits%}",JsSQL(15,i))
		Set Matches = regEx.Execute(TempBody)
		For Each Match in Matches
			TempStr = Replace(Match.Value,"{%","")
			TempStr = Replace(TempStr,"%}","")
			TempStr = Replace(TempStr,"(",",")
			TempStr = Replace(TempStr,")","")
			TempStr = Replace(TempStr,"""","")
			TempStr = Split(Lcase(TempStr),",")
			Select Case TempStr(0)
			Case "title"
				TitleStr = Cl.GotTopic(JsSQL(6,i),TempStr(1))
				TitleStr = Cl.GetTitleFont(TitleStr,JsSQL(27,i))
				TitleStr = Cl.FormatColor(TitleStr,JsSQL(26,i))
				TempBody = Replace(TempBody,Match.Value,TitleStr)
			Case "imgurl"
				sImgUrl	 = Replace(sImgUrl,"{%ImgWidth%}",TempStr(1))
				sImgUrl	 = Replace(sImgUrl,"{%ImgHeight%}",TempStr(2))
				TempBody = Replace(TempBody,Match.Value,sImgUrl)
			Case "intro"
				TempBody = Replace(TempBody,Match.Value,Left(JsSQL(30,i)&"",TempStr(1)))
			Case "updatetime"
				TempBody = Replace(TempBody,Match.Value,Cl.Format_Time(JsSQL(16,i),TempStr(1)))
			End Select
		Next
		sHTML = sHTML & TempBody
		if (i+1) mod ColsNum=0 then sHTML = sHTML & Style3
	Next
	GetArticle=Replace(Style1,"{%ContentBody%}",sHTML)
	JsSQL=Empty
End Function

'=================================================
'过程名：ShowClassArticle(sChannelID,sClassID,ModNum,TopNum)
'参  数：
'		sChannelID	----	频道ID
'		sClassID	----	指定栏目，多个用“|”分隔，不指定请留空或0
'		ModNum      ---		多少个换行
'		TopNum      ---		最多显示记录数
'=================================================
Function ShowClassArticle(Byval sChannelID,Byval sClassID,Byval ModNum,Byval TopNum)
	dim sqlRoot,rsRoot,ClassCount,iClassID
	Dim sTemp,strValue
	sChannelID	= Cl.ChkClng(sChannelID)
	sClassID	= Trim(sClassID)
	ModNum		= Cl.ChkClng(ModNum)
	if sClassID="" or sClassID="0" then
		TopNum		= Cl.ChkClng(TopNum)
		if TopNum=0 then TopNum = 6
		sqlRoot="select Top "&TopNum&" ClassID,ClassName,ParentPath,ClassDir,ParentDir,RootID,Child,arrChildID,Readme From Cl_Class where ChannelID="&sChannelID&" and ParentID=0 and IsElite=True and IsOuter=0 order by RootID"
	Else
		sqlRoot="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,RootID,Child,arrChildID,Readme From Cl_Class where ChannelID="&sChannelID&" and IsElite=True and IsOuter=0 and ClassID In ("&Replace(sClassID,"|",",")&") order by RootID"
	End if
	Set rsRoot= Cl.Execute(sqlRoot)
	if rsRoot.bof and rsRoot.eof then
		sTemp="还没有任何栏目，请首先添加栏目。"
		rsRoot.Close:Set rsRoot=Nothing:Exit Function
	end if
	sqlRoot=rsRoot.GetRows(-1)
	rsRoot.Close:Set rsRoot=Nothing
	Cl.GetChannelSetting(sChannelID)
	Cl.LoadTempLates(Cl.Channel_Setting(4))
	for iClassID=0 to Ubound(sqlRoot,2)
		strValue=Replace(Template.html(8),"{%channelid%}",sChannelID)
		strValue=Replace(strValue,"{%classid%}",sqlRoot(0,iClassID))
		strValue=Replace(strValue,"{%classtitle%}",sqlRoot(8,iClassID)&"")
		strValue=Replace(strValue,"{%classname%}",sqlRoot(1,iClassID))
		strValue=Replace(strValue,"{%classfileurl%}",Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),sqlRoot(2,iClassID),sqlRoot(0,iClassID),sqlRoot(4,iClassID),sqlRoot(3,iClassID),Cl.Channel_Setting(10),Cl.Channel_Setting(13)))
		strValue=Cl.ReplaceFlag(strValue,"showarticle","")
		if ((iClassID+1) mod ModNum) = 0 then
			strValue = strValue & Split(Template.html(9),"||")(1)
		else
			strValue = strValue & Split(Template.html(9),"||")(0)
		end if
		sTemp=sTemp & strValue
	Next
	ShowClassArticle=Replace(Template.html(7),"{%classarticlebody%}",sTemp)
	sqlRoot=Empty
End Function

'====================================================================================================
'过程：ShowPicArticle(sChannelID,sClassID,sSpecialID,TopNum,TitleLen,ShowType,Cols,ImgWidth,ImgHeight,ContentLen,IsHot,IsElite)
'参数：
'	sChannelID  ------  频道ID
'	sClassID    ------  栏目ID(0为所有栏目,若大于0，则调用指定栏目及其子栏目)
'	sSpecialID  ------  专题ID(0为所有栏目,若大于0，则调用指定专题)
'	TopNum      ------  最多显示多少篇
'	TitleLen    ------  标题最多字符数
'	ShowType    ------  显示方式。0(图),1(图+标),2(图+标+内),3(图+幻),4(图+标+幻)
'	Cols        ------  列数。超过此列数就换行
'	ImgWidth    ------  图片宽度
'	ImgHeight   ------  图片高度
'	ContentLen  ------  内容最多字符数
'	IsHot       ------  是否是热门(True为是，False为否)
'	IsElite     ------  是否是推荐(True为是，False为否)
'====================================================================================================
Function ShowPicArticle(Byval sChannelID,Byval sClassID,Byval sSpecialID, _
	Byval TopNum,Byval TitleLen,Byval ShowType,Byval Cols,Byval ImgWidth, _
	Byval ImgHeight,Byval ContentLen,Byval IsHot,Byval IsElite)
	On Error Resume Next
	sChannelID	= Clng(sChannelID)	: sClassID		= Clng(sClassID)
	sSpecialID	= Clng(sSpecialID)	: TopNum		= Clng(TopNum)
	TitleLen	= Clng(TitleLen)	: ShowType		= Clng(ShowType)
	Cols		= Clng(Cols)		: ImgWidth		= Clng(ImgWidth)
	ImgHeight	= Clng(ImgHeight)	: ContentLen	= Clng(ContentLen)
	IsHot		= CBool(IsHot)		: IsElite		= CBool(IsElite)
	if Err then Err.Clear : ShowPicArticle="ShowPicArticle参数错误。":Exit Function
	On Error GoTo 0
	Cl.GetChannelSetting(sChannelID)
	dim rsPic,sqlPic,tClass,j,strPic
	if TopNum<=0 then
		sqlPic="Select "
	else
		sqlPic="Select top "&TopNum&" "
	end if
	sqlPic=sqlPic & " ArticleID,ClassID,Title,Author,UpdateTime,Editor,TitleFontColor,TitleFontType,Content,OnTop,Hot,Elite,Passed,Prefixion,Stars,PaginationType,DefaultPicUrl,hits,IsHtml,HtmlFileUrl,Intro from Cl_Article where Deleted=False and Passed=True and DefaultPicUrl<>'' and ChannelID="&sChannelID&" "
	if sClassID>0 then
		set tClass=Cl.Execute("select ClassID,Child,ParentPath,arrChildID from Cl_Class where ChannelID="&sChannelID&" and ClassID=" & sClassID)
		if not(tClass.bof and tClass.eof) then
			if tClass(1)>0 then
				sqlPic=sqlPic & " and ClassID in (" & tClass(3) & ")"
			else
				sqlPic=sqlPic & " and ClassID=" & sClassID
			end if
		else
			sqlPic=sqlPic & " and ClassID=" & sClassID
		end if
		set tClass=Nothing
	end if
	if sSpecialID>0 then sqlPic=sqlPic & " and SpecialID Like '%" & sSpecialID & "%'"
	if IsHot=True then sqlPic=sqlPic & " and Hot=True "
	if IsElite=True then sqlPic=sqlPic & " and Elite=True "
	'if IsSqlDataBase=1 then
	sqlPic=sqlPic & " order by OnTop Asc,UpdateTime desc,ArticleID desc"
	Set rsPic= Server.CreateObject("ADODB.Recordset")
	OpenConn : rsPic.open sqlPic,Conn,1,1
	strPic= "<table width=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"" align=""center""><tr valign=""top"">"
	if rsPic.bof and rsPic.eof then
		strPic = strPic & "<td align=""center""><img src=""" & Cl.WebDir & "images/NoPic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" /><br />没有"&Cl.Channel_Setting(2)&"</td>"
		rsPic.Close : Set rsPic = Nothing
	else
		dim FileType,TitleStr,LinkUrl
		if TopNum<=0 or TopNum>=100 then
			TotalPut=rsPic.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
			rsPic.move (CurrentPage-1)*MaxPerPage
			sqlPic = rsPic.GetRows(MaxPerPage)
		else
			sqlPic=rsPic.GetRows(-1)
		end if
		rsPic.Close : Set rsPic = Nothing
		Select Case ShowType
		Case 0
			for j=0 to Ubound(sqlPic,2)
				if CBool(sqlPic(18,j)) and Clng(Cl.Channel_Setting(10))=1 then
					LinkUrl=Cl.WebDir & sqlPic(19,j)
				else
					LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID=" & sqlPic(0,j)
				end if
				strPic = strPic & "<td align=""center"">"
				FileType=right(lcase(sqlPic(16,j)),3)
				strPic = strPic & "<a href=""" & LinkUrl & """ title=""标题：" & sqlPic(2,j) & vbcrlf & "作者：" & sqlPic(3,j) & vbcrlf & "更新：" & sqlPic(4,j) & vbcrlf & "点击：" & sqlPic(17,j) & """ target=""_blank"">"
				sqlPic(16,j)=Cl.ReplaceDir(sqlPic(16,j))
				Select Case FileType
				Case "swf"
					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=""" & ImgWidth & """ height=""" & ImgHeight & """><param name=""movie"" value=""" & sqlPic(16,j) & """><param name=""quality"" value=""high""><embed src=""" & sqlPic(16,j) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""" & ImgWidth & """ height=""" & ImgHeight & """></embed></object>"
				Case "jpg", "bmp", "png", "gif"
					strPic = strPic & "<img src=""" & sqlPic(16,j) & """ width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
				Case else
					strPic = strPic & "<img src=""" & Cl.WebDir & "images/NoPic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
				end Select
				strPic = strPic & "</a></td>"
				if (j+1) Mod Cols=0 then strPic = strPic & "</tr><tr valign=""top"">"
			Next
		Case 1
			for j=0 to Ubound(sqlPic,2)
				if CBool(sqlPic(18,j)) and Clng(Cl.Channel_Setting(10))=1 then
					LinkUrl=Cl.WebDir & sqlPic(19,j)
				else
					LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID=" & sqlPic(0,j)
				end if
				strPic = strPic & "<td align=""center"">"
				FileType=right(lcase(sqlPic(16,j)),3)
				TitleStr=Cl.GotTopic(sqlPic(2,j),TitleLen)
				sqlPic(16,j)=Cl.ReplaceDir(sqlPic(16,j))
				strPic = strPic & "<a href=""" & LinkUrl & """ title=""标题：" & sqlPic(2,j) & vbcrlf & "作者：" & sqlPic(3,j) & vbcrlf & "更新：" & sqlPic(4,j) & vbcrlf & "点击：" & sqlPic(17,j) & """ target=""_blank"">"
				Select Case FileType
				Case "swf"
					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=""" & ImgWidth & """ height=""" & ImgHeight & """><param name=""movie"" value=""" & sqlPic(16,j) & """><param name=""quality"" value=""high""><embed src=""" & sqlPic(16,j) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""" & ImgWidth & """ height=""" & ImgHeight & """></embed></object>"
				Case "jpg", "bmp", "png", "gif"
					strPic = strPic & "<img src=""" & sqlPic(16,j) & """ width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
				Case else
					strPic = strPic & "<img src=""" & Cl.WebDir & "images/NoPic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
				end Select
				TitleStr=Cl.GetTitleFont(TitleStr,sqlPic(7,j))
				TitleStr=Cl.FormatColor(TitleStr,sqlPic(6,j))
				strPic = strPic & "<br />" & TitleStr & "</a>"
				strPic = strPic & "</td>"
				if (j+1) Mod Cols=0 then strPic = strPic & "</tr><tr valign=""top"">"
			Next
		Case 2
			for j=0 to Ubound(sqlPic,2)
				strPic = strPic & "<td align=""center"">"
				if CBool(sqlPic(18,j)) and Clng(Cl.Channel_Setting(10))=1 then
					LinkUrl=Cl.WebDir & sqlPic(19,j)
				else
					LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID=" & sqlPic(0,j)
				end if
				FileType=right(lcase(sqlPic(16,j)),3)
				TitleStr=Cl.GotTopic(sqlPic(2,j),TitleLen)
				sqlPic(16,j)=Cl.ReplaceDir(sqlPic(16,j))
				strPic = strPic & "<a href=""" & LinkUrl & """ title=""标题：" & sqlPic(2,j) & vbcrlf & "作者：" & sqlPic(3,j) & vbcrlf & "更新：" & sqlPic(4,j) & vbcrlf & "点击：" & sqlPic(17,j) & """ target=""_blank"">"
				Select Case FileType
				Case "swf"
					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=""" & ImgWidth & """ height=""" & ImgHeight & """><param name=""movie"" value=""" & sqlPic(16,j) & """><param name=""quality"" value=""high""><embed src=""" & sqlPic(16,j) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""" & ImgWidth & """ height=""" & ImgHeight & """></embed></object>"
				Case "jpg", "bmp", "png", "gif"
					strPic = strPic & "<img src=""" & sqlPic(16,j) & """ width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
				Case else
					strPic = strPic & "<img src=""" & Cl.WebDir & "images/NoPic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0"" alt="""" />"
				end Select
				TitleStr=Cl.GetTitleFont(TitleStr,sqlPic(7,j))
				TitleStr=Cl.FormatColor(TitleStr,sqlPic(6,j))
				strPic = strPic & "<br />" & TitleStr & "</a>"
				strPic = strPic & "</td><td valign=""top"" algin=""center"" class=""left""><a href=""" & LinkUrl & """>" & left(Cl.NoHtml(sqlPic(8,j)),ContentLen) & "……</a></td>"
				if (j+1) Mod Cols=0 then strPic = strPic & "</tr><tr valign=""top"">"
			Next
		Case 3, 4
			Dim sImgID
			sImgID=Cl.CreatePass(3) & "Cl" & ImgWidth & ImgHeight & ContentLen' & IsHot & IsElite
			strPic = strPic & "<script type=""text/javascript"">" & vbcrlf
			strPic = strPic & "<!--" & vbcrlf
			strPic = strPic & "var AImg"&sImgID&"=new Array();" & vbcrlf
			strPic = strPic & "var AImg"&sImgID&"link=new Array();" & vbcrlf
			strPic = strPic & "var AImg"&sImgID&"title=new Array();" & vbcrlf
			strPic = strPic & "var adNum"&sImgID&"=0;" & vbcrlf
			Dim FirstPicUrl
			for j=0 to Ubound(sqlPic,2)
				FileType=right(lcase(sqlPic(16,j)),3)
				TitleStr=Cl.GotTopic(sqlPic(2,j),TitleLen)
				if CBool(sqlPic(18,j)) and Clng(Cl.Channel_Setting(10))=1 then
					LinkUrl=Cl.WebDir & sqlPic(19,j)
				else
					LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID=" & sqlPic(0,j)
				end if
				strPic = strPic & "AImg"&sImgID&"link[" & cStr(j) & "]=""" & LinkUrl & """;" & vbcrlf
				if fileType="jpg" or fileType="bmp" or fileType="png" or fileType="gif" then
					strPic = strPic & "AImg"&sImgID&"[" & cStr(j) & "]=""" & Cl.ReplaceDir(sqlPic(16,j)) & """;" & vbcrlf
				else
					strPic = strPic & "AImg"&sImgID&"[" & cStr(j) & "]=""" & Cl.WebDir & "images/NoPic.gif"";" & vbcrlf
				end if
				if j=0 then FirstPicUrl=Cl.ReplaceDir(sqlPic(16,j))
				TitleStr=Cl.GetTitleFont(TitleStr,sqlPic(7,j))
				TitleStr=Cl.FormatColor(TitleStr,sqlPic(6,j))
				strPic = strPic & "AImg"&sImgID&"title[" & cStr(j) & "]=""" & Replace(TitleStr,Chr(34),"\" & Chr(34)) & """;" & vbcrlf
			Next
			strPic = strPic & "var preloadimg"&sImgID&"=new Array();" & vbcrlf
			strPic = strPic & "for (i=1;i<AImg"&sImgID&".length;i++){" & vbcrlf
			strPic = strPic & "preloadimg"&sImgID&"[i]=new Image();" & vbcrlf
			strPic = strPic & "preloadimg"&sImgID&"[i].src=AImg"&sImgID&"[i];}" & vbcrlf
			strPic = strPic & "function set"&sImgID&"Transition()" & vbcrlf
			strPic = strPic & "{" & vbcrlf
			strPic = strPic & "if (document.all){" & vbcrlf
			strPic = strPic & "AImg"&sImgID&"rotator.filters.revealTrans.Transition=Math.floor(Math.random()*23);" & vbcrlf
			strPic = strPic & "AImg"&sImgID&"rotator.filters.revealTrans.apply();" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "function play"&sImgID&"Transition()" & vbcrlf
			strPic = strPic & "{" & vbcrlf
			strPic = strPic & "if (document.all)" & vbcrlf
			strPic = strPic & "AImg"&sImgID&"rotator.filters.revealTrans.play()" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "function next"&sImgID&"Img()" & vbcrlf
			strPic = strPic & "{" & vbcrlf
			strPic = strPic & "if(adNum"&sImgID&"<AImg"&sImgID&".length-1)adNum"&sImgID&"++ ;" & vbcrlf
			strPic = strPic & "else adNum"&sImgID&"=0;" & vbcrlf
			strPic = strPic & "set"&sImgID&"Transition();" & vbcrlf
			strPic = strPic & "document.images.AImg"&sImgID&"rotator.src=AImg"&sImgID&"[adNum"&sImgID&"];" & vbcrlf
			strPic = strPic & "play"&sImgID&"Transition();" & vbcrlf
			strPic = strPic & "title"&sImgID&".innerHTML=""<A href='"" + AImg"&sImgID&"link[adNum"&sImgID&"] + ""'>"" + AImg"&sImgID&"title[adNum"&sImgID&"] +""</a>"";" & vbcrlf
			strPic = strPic & "theTimer=setTimeout(""next"&sImgID&"Img()"", 5000);" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "function jump2"&sImgID&"url()" & vbcrlf
			strPic = strPic & "{" & vbcrlf
			strPic = strPic & "jumpUrl=AImg"&sImgID&"link[adNum"&sImgID&"];" & vbcrlf
			strPic = strPic & "jumpTarget=""_blank"";" & vbcrlf
			strPic = strPic & "if (jumpUrl != ''){" & vbcrlf
			strPic = strPic & "if (jumpTarget != '')window.open(jumpUrl,jumpTarget);" & vbcrlf
			strPic = strPic & "else location.href=jumpUrl;" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "function display"&sImgID&"Msg()" & vbcrlf
			strPic = strPic & "{" & vbcrlf
			strPic = strPic & "status=AImg"&sImgID&"link[adNum"&sImgID&"];" & vbcrlf
			strPic = strPic & "document.returnValue = true;" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "//-->" & vbcrlf
			strPic = strPic & "</script>" & vbcrlf
			strPic = strPic & "<td align=""center"">" & vbcrlf
			strPic = strPic & "<a onmouseover=""display"&sImgID&"Msg();return document.returnValue;"" href=""javascript:jump2"&sImgID&"url();""><img style='FILTER: revealTrans(duration=2,transition=20)' width='" & ImgWidth & "' height='" & ImgHeight & "' border='0' src='" & FirstPicUrl & "' name='AImg"&sImgID&"rotator' alt="""" /></a>" & vbcrlf
			strPic = strPic & "</td>" & vbcrlf
			if ShowType=4 then
				strPic = strPic & "</tr><tr><td id=""title"&sImgID&""" align=""center""></td>" & vbcrlf
			else
				strPic = strPic & "</tr><tr><td id=""title"&sImgID&""" align=""center"" style=""display:none""></td>" & vbcrlf
			end if
			strPic = strPic & "<script type=""text/javascript"">title"&sImgID&".innerHTML=""<A href='"" + AImg"&sImgID&"link[0] + ""'>"" + AImg"&sImgID&"title[0] +""</a>"";setTimeout(""next"&sImgID&"Img()"", 3000);" & vbcrlf
			strPic = strPic & "</script>"
		Case 5
			strPic = strPic & vbcrlf & "<script type=""text/javascript"">" & vbcrlf
			strPic = strPic & "<!--" & vbcrlf
			for j=0 to Ubound(sqlPic,2)
				FileType=right(lcase(sqlPic(16,j)),3)
				TitleStr=Cl.GotTopic(sqlPic(2,j),TitleLen)
				if fileType="jpg" or fileType="bmp" or fileType="png" or fileType="gif" then
				strPic = strPic & "imgUrl" & cStr(j+1) & "=""" & Cl.ReplaceDir(sqlPic(16,j)) & """;" & vbcrlf
				else
				strPic = strPic & "imgUrl" & cStr(j+1) & "=""" & Cl.WebDir & "images/NoPic.gif"";" & vbcrlf
				end if
				strPic = strPic & "imgtext" & cStr(j+1) & "=""" & Replace(TitleStr,Chr(34),"\" & Chr(34)) & """;" & vbcrlf
				if CBool(sqlPic(18,j)) and Clng(Cl.Channel_Setting(10))=1 then
				LinkUrl=Cl.WebDir & sqlPic(19,j)
				else
				LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID=" & sqlPic(0,j)
				end if
				strPic = strPic & "imgLink" & cStr(j+1) & "=""" & LinkUrl & """;" & vbcrlf
			Next
			strPic = strPic & "if (navigator.appName == ""Netscape"")" & vbcrlf
			strPic = strPic & "{document.write('<a href=""'+imgLink1+'""><img src=""'+imgUrl1+'"" width=" & ImgWidth+10 & " height=" & ImgHeight+10 & " border=0><br> '+imgtext1+'</a> ')" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "else" & vbcrlf
			strPic = strPic & "{" & vbcrlf
			strPic = strPic & "var focus_width=" & Imgwidth & ";" & vbcrlf
			strPic = strPic & "var focus_height=" & ImgHeight & ";" & vbcrlf
			strPic = strPic & "var text_height=25;" & vbcrlf
			strPic = strPic & "var swf_height = focus_height+text_height;" & vbcrlf
			strPic = strPic & "var pics=imgUrl1;" & vbcrlf
			strPic = strPic & "var links=imgLink1;" & vbcrlf
			strPic = strPic & "var texts=imgtext1;" & vbcrlf
			for j=2 to Ubound(sqlPic,2)+1
			strPic = strPic & "pics += '|'+imgUrl" & j & ";" & vbcrlf
			strPic = strPic & "links += '|'+imgLink" & j & ";" & vbcrlf
			strPic = strPic & "texts += '|'+imgtext" & j & ";" & vbcrlf
			Next
			strPic = strPic & "document.write('<object classid=""clsid:d27cdb6e-ae6d-11cf-96b8-444553540000"" codebase=""http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0"" width=""'+ focus_width +'"" height=""'+ swf_height +'"">');" & vbcrlf
			strPic = strPic & "document.write('<param name=""allowScriptAccess"" value=""sameDomain""><param name=""movie"" value=""" & CL.WebDir & "images/focus.swf""><param name=""quality"" value=""high""><param name=""bgcolor"" value=""#F0F0F0"">');" & vbcrlf
			strPic = strPic & "document.write('<param name=""menu"" value=""false""><param name=wmode value=""opaque"">');" & vbcrlf
			strPic = strPic & "document.write('<param name=""FlashVars"" value=""pics='+pics+'&links='+links+'&texts='+texts+'&borderwidth='+focus_width+'&borderheight='+focus_height+'&textheight='+text_height+'"">');" & vbcrlf
			strPic = strPic & "document.write('<embed src=""" & CL.WebDir & "images/focus.swf"" wmode=""opaque"" FlashVars=""pics='+pics+'&links='+links+'&texts='+texts+'&borderwidth='+focus_width+'&borderheight='+focus_height+'&textheight='+text_height+'"" menu=""false"" bgcolor=""#F0F0F0"" quality=""high"" width=""'+ focus_width +'"" height=""'+ focus_height +'"" allowScriptAccess=""sameDomain"" type=""application/x-shockwave-flash"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" />');" & vbcrlf
			strPic = strPic & "document.write('</object>');" & vbcrlf
			strPic = strPic & "}" & vbcrlf
			strPic = strPic & "//-->" & vbcrlf
			strPic = strPic & "</script>" & vbcrlf
		end Select
	end if
	strPic = strPic &  "</tr></table>"
	ShowPicArticle=strPic
	sqlPic=Empty
End Function

'====================================================================================================
'过程：ShowArticle(sChannelID,sClassID,sSpecialID,TopNum,TitleLen,ShowClassName,ShowProperty,ShowPrefix,ShowAuthor,ShowDateType,ShowHits,ShowHot,IsElite,IsHot,UserName,CssStyle)
'参数：
'	sChannelID		------  频道ID
'	sClassID		------  栏目ID(0为全部，如果大于0，则调用指定栏目及其子栏目)
'	sSpecialID		------  专题ID(0为全部，如果大于0，刚调用指定专题)
'	TopNum			------  最多记录数，0为全部(用于分页显示)
'	TitleLen		------  标题最多字符数
'	ShowClassName	------  是否显示栏目名称(True为显示，False为不显示)
'	ShowProperty	------  是否显示文章属性(固顶/推荐/普通)，(True为显示，False为不显示)
'	ShowPrefix		------  是否显示前缀如：[推荐][图文][注意]字样(True为显示，False为不显示)
'	ShowAuthor		------  是否显示文章作者，True为显示，False为不显示)
'	ShowDateType	------  显示更新日期的样式
'							---- 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)
'	ShowHits		------  是否显示文章点击数(True为显示，False为不显示)
'	ShowHot			------  是否显示热门文章标志(True为显示，False为不显示)
'	IsHot			------  是否热门(True为是，False为否)
'	IsElite			------  是否推荐(True为是，False为否)
'	UserName		------  指定某用户(不指定请留空值或0)
'	CssClassName        ------  CSS样式
'====================================================================================================
Function ShowArticle(Byval sChannelID,Byval sClassID,Byval sSpecialID, _
	Byval TopNum,Byval TitleLen,Byval ShowClassName,Byval ShowProperty, _
	Byval ShowPrefix,Byval ShowAuthor,Byval ShowDateType,Byval ShowHits, _
	Byval ShowHot,Byval IsHot,Byval IsElite,Byval UserName,Byval CssClassName)
	On Error ReSume Next
	sChannelID		= Clng(sChannelID)		: sClassID		= Clng(sClassID)
	sSpecialID		= Clng(sSpecialID)		: TopNum		= Clng(TopNum)
	TitleLen		= Clng(TitleLen)		: ShowClassName	= CBool(ShowClassName)
	ShowProperty	= CBool(ShowProperty)	: ShowPrefix	= CBool(ShowPrefix)
	ShowAuthor		= CBool(ShowAuthor)		: ShowDateType	= Clng(ShowDateType)
	ShowHits		= CBool(ShowHits)		: ShowHot		= CBool(ShowHot)
	IsHot			= CBool(IsHot)			: IsElite		= CBool(IsElite)
	UserName		= Trim(UserName)		: CssClassName	= Trim(CssClassName)
	if Err then Err.Clear : ShowArticle="ShowArticle参数错误。" : Exit Function
	On Error GoTo 0
	Cl.GetChannelSetting(sChannelID)
	Dim SQLInfo
	if TopNum<=0 then
		SqlInfo="Select "
	else
		SqlInfo="Select Top "&TopNum&" "
	end if
	SqlInfo = SqlInfo & "A.ArticleID,A.ClassID,C.ClassName,C.ParentPath,C.ClassDir,C.ParentDir,A.Title,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.Prefixion,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl,A.IsHtml,A.HtmlFileUrl,Intro from Cl_Article A Inner Join Cl_Class C On A.ClassID=C.ClassID where A.Deleted=False and A.Passed=True and A.ChannelID="&sChannelID&" "
	if sClassID>0 then
		Dim tClass
		Set tClass=Cl.Execute("select ClassID,Child,ParentPath,arrChildID from Cl_Class where ChannelID="&sChannelID&" and ClassID=" & sClassID)
		if not(tClass.bof and tClass.eof) then
			if tClass(1)>0 then
				SqlInfo=SqlInfo & " and A.ClassID in (" & tClass(3) & ")"
			else
				SqlInfo=SqlInfo & " and A.ClassID=" & sClassID
			end if
		else
			SqlInfo=SqlInfo & " and A.ClassID=" & sClassID
		end if
		Set tClass=Nothing
	end if
	if sSpecialID>0 then SqlInfo=SqlInfo & " and A.SpecialID Like '%" & sSpecialID & "%'"
	if IsElite=True then SqlInfo=SqlInfo & " and A.Elite=True"
	if IsHot=True then SqlInfo=SqlInfo & " and A.Hot=True"
	if UserName<>"" and UserName<>"0" then SqlInfo=SqlInfo &  " and A.Editor='" & UserName & "'"
	'if IsSqlDataBase=1 then
	SqlInfo=SqlInfo & " order by A.OnTop Asc,A.UpdateTime desc,A.ArticleID desc"
	Set rsInfo= Server.CreateObject("ADODB.Recordset")
	OpenConn : rsInfo.open SqlInfo,Conn,1,1
	if rsInfo.bof and  rsInfo.eof then
		'TotalPut=0
		ShowArticle="<br /><li>没有任何"&Cl.Channel_Setting(2)&"</li>"
		rsInfo.close:set rsInfo=Nothing : Exit Function
	End if
	if TopNum<=0 or TopNum>=100 then
		TotalPut=rsInfo.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
		rsInfo.move (CurrentPage-1)*MaxPerPage
		SqlInfo=rsInfo.GetRows(MaxPerPage)
	else
		SqlInfo=rsInfo.GetRows(-1)
	end if
	rsInfo.close:set rsInfo=Nothing
   	dim sTemp,Linkurl,i
	dim TitleStr,Author,AuthorName,AuthorEmail,sTitleLen
    i=0:sTemp = "<table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""0"" class="""&CssClassName&""">" & VbCrlf
	For i=0 to Ubound(SqlInfo,2)
		sTitleLen = TitleLen
		sTemp = sTemp & "<tr><td align=""left"">&nbsp;"
		if ShowProperty=True then
			if SqlInfo(14,i)=True then
				sTemp = sTemp & "<img src=""" & Cl.mainpic(13) & """ alt=""固顶"" />&nbsp;"
			elseif SqlInfo(16,i)=True then
				sTemp = sTemp & "<img src=""" & Cl.mainpic(12) & """ alt=""推荐"" />&nbsp;"
			else
				sTemp = sTemp & "<img src=""" & Cl.mainpic(11) & """ alt=""普通"" />&nbsp;"
			end if
		end if
		if ShowClassName=True and SqlInfo(1,i)<>ClassID then
			sTemp=sTemp & "[<a href=""" & Cl.WebDir & Cl.GetClassUrl(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),SqlInfo(3,i),SqlInfo(1,i),SqlInfo(5,i),SqlInfo(4,i),Cl.Channel_Setting(10),Cl.Channel_Setting(13)) & """>" & SqlInfo(2,i) & "</a>]&nbsp;"
			sTitleLen=sTitleLen-Cl.strLength(SqlInfo(2,i))-1
		end if
		if ShowPrefix=True and SqlInfo(18,i)<>"" then
			sTemp = sTemp & "<font color=""blue"">"&SqlInfo(18,i)&"</font>"
			sTitleLen=sTitleLen-Cl.strLength(SqlInfo(18,i))-2
		end if
		if Instr(SqlInfo(7,i),"|")>0 then
			Author=Split(SqlInfo(7,i),"|")
			AuthorName=Author(0)
			AuthorEmail=Author(1)
		else
			AuthorName=SqlInfo(7,i)
			AuthorEmail="Aspoo@126.com"
		end if
		if CBool(SqlInfo(24,i)) and Clng(Cl.Channel_Setting(10))=1 then
			LinkUrl=Cl.WebDir & SqlInfo(25,i)
		else
			LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID="&SqlInfo(0,i)
		end if
		sTemp = sTemp & "<a href=""" & LinkUrl & """ title=""标题：" & SqlInfo(6,i) & vbcrlf & "作者：" & AuthorName & vbcrlf & "更新：" & SqlInfo(9,i) & vbcrlf & "点击：" & SqlInfo(13,i) & """ target=""_blank"">"
		TitleStr=Cl.GotTopic(SqlInfo(6,i),sTitleLen)
		TitleStr=Cl.GetTitleFont(TitleStr,SqlInfo(12,i))
		TitleStr=Cl.FormatColor(TitleStr,SqlInfo(11,i))
		sTemp=sTemp & TitleStr & "</a>"
		if ShowHot=True then
		    if CDate(FormatDateTime(SqlInfo(9,i),2))=Date() then
			   sTemp= sTemp & "<img src=""" & Cl.mainpic(7) & """ alt=""最新"" />"
            elseif SqlInfo(15,i)=True then
				sTemp= sTemp & "<img src=""" & Cl.mainpic(8) & """ alt=""热门"" />"
			end if
		end if
		if ShowAuthor=True or ShowHits=True or ShowDateType>0 then
			sTemp = sTemp & "</td>" & VbCrlf & "<td align=""right"">("
			if ShowAuthor=True then
				sTemp=sTemp & "<a href=""mailto:" & AuthorEmail & """>" & AuthorName & "</a>"
			end if
			if ShowHits=True then
				if ShowAuthor=True then
					sTemp=sTemp & ","
				end if
				sTemp=sTemp & Cl.FormatColor(SqlInfo(13,i),"#ff0033")
			end if
			if ShowDateType>0 then
				if ShowHits=True or ShowAuthor=True then
					sTemp=sTemp & ","
				end if
				if CDate(FormatDateTime(SqlInfo(9,i),2))=date() then
					sTemp = sTemp & "<font color=""red"">"
				else
					sTemp = sTemp & "<font color=""#999999"">"
				end if
		        sTemp = sTemp & Cl.Format_Time(SqlInfo(9,i),ShowDateType) & "</font>"
			end if
			sTemp = sTemp & ")"
		end if
		sTemp = sTemp & "</td></tr>" & VbCrlf
	Next
	ShowArticle=sTemp & "</table>"
	SqlInfo=Empty
end Function
'================================================================
'过程名：ShowTopArticle(sChannelID,sClassID,TopNum,TitleLen,ShowType,ShowHits)
'		sChannelID	----频道ID
'		sClassID	----栏目ID
'		TopNum		----下载TOP
'		TitleLen	----标题最多字符数，一个汉字=两个英文字符
'		ShowType	----- 1(本日)，2(本周),3(本月),4(累计)
'		ShowHits	------	(是否显示点击数，True为是)
'================================================================
Function ShowTopArticle(Byval sChannelID,Byval sClassID,Byval TopNum, _
	Byval TitleLen,Byval ShowType,Byval ShowHits)
	dim sqlTop,rsTop,LinkUrl
	On Error ReSume Next
	sChannelID	= Clng(sChannelID)	: sClassID = Clng(sClassID)
	TopNum		= Clng(TopNum)		: TitleLen = Clng(TitleLen)
	ShowType	= Clng(ShowType)	: ShowHits = CBool(ShowHits)
	if Err then Err.Clear : ShowTopArticle="ShowTopArticle参数错误。" : Exit Function
	On Error GoTo 0
	Cl.GetChannelSetting(sChannelID)
	if TopNum>0 then
		sqlTop="select top " & TopNum & " "
	else
		sqlTop="select top 10 "
	end if
	sqlTop=sqlTop & " ArticleID,ClassID,Title,Author,UpdateTime,Editor,TitleFontColor,TitleFontType,Content,OnTop,Hot,Elite,Passed,Prefixion,Stars,PaginationType,DefaultPicUrl,hits,IsHtml,HtmlFileUrl,Intro from Cl_Article where Deleted=False and Passed=True and ChannelID="&sChannelID&" "
	if sClassID>0 then
		Dim tClass
		Set tClass=Cl.Execute("select ClassID,Child,ParentPath,arrChildID from Cl_Class where ChannelID="&sChannelID&" and ClassID=" & sClassID)
		if not(tClass.bof and tClass.eof) then
			if tClass(1)>0 then
				sqlTop=sqlTop & " and ClassID in (" & tClass(3) & ")"
			else
				sqlTop=sqlTop & " and ClassID=" & sClassID
			end if
		else
			sqlTop=sqlTop & " and ClassID=" & sClassID
		end if
		Set tClass=Nothing
	end if
	Select Case ShowType
	Case 1
		sqlTop=sqlTop & " And datediff('D',LastHitTime,now())<=0 order by DayHits desc,ArticleID desc"
	Case 2
		sqlTop=sqlTop & " And datediff('ww',LastHitTime,now())<=0 order by WeekHits desc,ArticleID desc"
	Case 3
		sqlTop=sqlTop & " And datediff('m',LastHitTime,now())<=0 order by MonthHits desc,ArticleID desc"
	Case Else
		sqlTop=sqlTop & " order by Hits desc,ArticleID desc"
	end Select
	Set rsTop= Cl.Execute(sqlTop)
	if rsTop.bof and rsTop.eof then 
		ShowTopArticle = "<li>没有"&Cl.Channel_Setting(2)&"</li>"
		rsTop.Close:Set rsTop=Nothing:Exit Function
	End if
	Dim i,sTemp
	i=1:sTemp = ""
	sqlTop=rsTop.GetRows(-1)
	rsTop.Close:Set rsTop=Nothing
	For i=0 to Ubound(sqlTop,2)
		if sqlTop(18,i)=True and Clng(Cl.Channel_Setting(10))=1 then
			LinkUrl=Cl.WebDir & sqlTop(19,i)
		else
			LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID="&sqlTop(0,i)
		end if

		sTemp = sTemp & "<li><a href=""" & LinkUrl & """ title=""名称：" & sqlTop(2,i) & vbcrlf & "作者：" & sqlTop(3,i) & vbcrlf & "更新：" & sqlTop(4,i) & vbcrlf & "查看：" & sqlTop(17,i) & """ target=""_blank"">" & Cl.gotTopic(sqlTop(2,i),TitleLen) & "</a>"
		if ShowHits=True then
			sTemp=sTemp & "(<font color='red'>" & sqlTop(17,i) & "</font>)"
		end if
		sTemp = sTemp & "</li><br />"
    Next
	ShowTopArticle=sTemp
	sqlTop=Empty
End Function

'=======================================================================
'显示相关文章
'ShowCorrelativeArticle(sChannelID,TopNum,TitleLen,ShowHits)
'	sChannelID
'	TopNum		------	(文章数量)
'	TitleLen	------	(标题字符数)
'	ShowHits	------	(是否显示点击数，True为是)
'=======================================================================
Function ShowCorrelativeArticle(Byval sChannelID,Byval TopNum,Byval TitleLen,Byval ShowHits)
	dim rsC,SQL,sTemp
	dim strKey,arrKey,i
	sChannelID=Cl.ChkClng(sChannelID):ShowHits=Cl.ChkCBool(ShowHits)
	TopNum=Cl.ChkClng(TopNum):TitleLen=Cl.ChkClng(TitleLen)
	if TopNum>0 then
		SQL="select top " & TopNum
	else
		SQL="Select Top 5 "
	end if
	strKey=rs("Keyword")
	if instr(strkey,"|")>1 then
		arrKey=split(strKey,"|")
		strKey="((Keyword like '%" & arrKey(0) & "%')"
		for i=1 to ubound(arrKey)
			strKey=strKey & " or (Keyword like '%" & arrKey(i) & "%')"
		next
		strKey=strKey & ")"
	else
		strKey="(Keyword like '%" & strKey & "%')"
	end if
	SQL=SQL & " ArticleID,Title,Author,UpdateTime,Hits,IsHtml,HtmlFileUrl From Cl_Article Where Deleted=False and Passed=True and " & strKey & " and ArticleID<>" & ArticleID & " and ChannelID="&sChannelID&" Order by UpdateTime desc,ArticleID desc"
	Set rsC= Cl.Execute(SQL)
	if rsC.bof and rsC.Eof then
		sTemp="<li>无相关文章</li>"
	else
		sTemp=""
		Dim LinkUrl
		Cl.GetChannelSetting(sChannelID)
	 	do while not rsC.eof
			if rsC("IsHtml")=True and Clng(Cl.Channel_Setting(10))=1 then
				LinkUrl=Cl.WebDir & rsC("HtmlFileUrl")
			else
				LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID="&rsC("ArticleID")
			end if
			sTemp=sTemp&"<table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>"
			sTemp=sTemp&"<img src=""" & Cl.mainpic(9) & """ border=""0""> <a href=""" & LinkUrl & """>" & Cl.GotTopic(rsC("Title"),TitleLen) & "</a>"
			if ShowHits=True then
			sTemp=sTemp&"</td><td align=""right"">[<font color=red>" & rsC("hits") & "</font>]"
			end if
			sTemp=sTemp&"</td></tr></table>"
			rsC.movenext
		loop
	end if
	rsC.close:set rsC=Nothing
	ShowCorrelativeArticle=sTemp
End Function
'===================================================================
'显示上一篇或下一篇文章
'过程名：ShowNearArticle(sChannelID,sClassID,sInfoID,TitleLen,sType)
'参  数：
'sChannelID		------ sChannelID(频道ID)
'sClassID		------ sClassID(栏目ID)
'sInfoID		------ sInfoID(文章ID)
'TitleLen		------ TitleLen(标题最多字符数)
'sType			------ sType(n为下一篇文章)
'===================================================================
Function ShowNearArticle(Byval sChannelID,Byval sClassID,Byval sInfoID,Byval TitleLen,Byval sType)
	dim rsNear,sqlNear
	sChannelID	=Cl.ChkClng(sChannelID) : sInfoID	= Cl.ChkClng(sInfoID)
	sClassID	=Cl.ChkClng(sClassID)	: TitleLen	= Cl.ChkClng(TitleLen)
	sqlNear="Select Top 1 ArticleID,ClassID,Title,Author,UpdateTime,Hits,IsHtml,HtmlFileUrl From Cl_Article Where Deleted=False and Passed=True and ChannelID="&sChannelID&" and ClassID=" & sClassID & " "
	if Lcase(sType)="n" then
		sqlNear=sqlNear & " and ArticleID>" & sInfoID & " order by UpdateTime ASC,ArticleID ASC"
	else
		sqlNear=sqlNear & " and ArticleID<" & sInfoID & " order by UpdateTime DESC,ArticleID DESC"
	end if
	Set rsNear= Cl.Execute(sqlNear)
	if rsNear.Eof then
	  	ShowNearArticle="没有了"
	else
		Dim LinkUrl
		Cl.GetChannelSetting(sChannelID)
		sqlNear = rsNear.GetRows(-1)
		if sqlNear(6,0)=True and Clng(Cl.Channel_Setting(10))=1 then
			LinkUrl=Cl.WebDir & sqlNear(7,0)
		elseif CreateHtmlIng=True then
			LinkUrl=Cl.WebDir & Cl.GetItemPath(Cl.Channel_Setting(11),Cl.HtmlDir,Cl.Channel_Setting(4),ParentPath,ClassID,ParentDir,ClassDir) & Cl.GetItemFileName(Cl.Channel_Setting(12),sqlNear(1,0),sqlNear(0,0),sqlNear(4,0)) &"."&Cl.Channel_Setting(13)
		else
			LinkUrl=Cl.WebDir & Cl.Channel_Setting(4) & "/ArticleShow.asp?ArticleID="&sqlNear(0,0)
		end if
		ShowNearArticle = "<a href='" & LinkUrl & "' title='标题：" & sqlNear(2,0) & vbcrlf & "作者：" & sqlNear(3,0) & vbcrlf & "更新：" & sqlNear(4,0) & vbcrlf & "点击：" & sqlNear(5,0) &"'>" & Cl.GotTopic(sqlNear(2,0),TitleLen) & "</a>"
	end if
	rsNear.Close : Set rsNear=Nothing
End Function

'显示文章具体的内容：ShowArticleContent
Function ShowArticleContent()
	if (Cl.ChkUserLevel(rs("ReadLevel"),5)=False or rs("Receive")=True) and CreateHtmlIng=True then
		ShowArticleContent="<script type='text/Javascript' src='"&Cl.WebDir & Cl.ChannelDir & "/GetContent.asp?ArticleID="&rs("ArticleID")&"'></script>"
		Exit Function
	end if
	if Not ChkTrueRead then
		ErrMsg=Replace(Template.Strings(11),"{%content%}",Cl.NoHtml(rs("Intro"))) & ErrMsg
		ShowArticleContent=ErrMsg
		Exit Function
	end if
	dim sTContent
	Set ClUbb = New Cls_UbbCode
	ClUbb.OpenHTML = 1
	Select Case Rs("PaginationType")
	Case 0 : sTContent = Rs("Content")   '不分页显示
	Case 1 : sTContent = AutoPagination   '自动分页显示
	Case 2 : sTContent = ManualPagination   '手动分页显示
	End Select
	ShowArticleContent = ErrMsg & ClUbb.UbbCode(sTContent)
	Set ClUbb=Nothing
	if Not CreateHtmlIng then
		Cl.Execute("Update Cl_Article Set Hits=Hits+1 where ArticleID=" & ArticleID & "")
		'Cl.GetCookies "View_"&ChannelID&"_"&ArticleID,"OK"
	end if
End Function

'采用手动分页方式
Function ManualPagination()
	dim strContent
	dim ContentLen,MaxPerPage',pages,i
	dim arrContent
	strContent=rs("Content")
	ContentLen=len(strContent)
	if Instr(strContent,"[NextPage]")<=0 then
		ManualPagination=strContent : Exit Function
	else
		Dim sTemp
		arrContent=split(strContent,"[NextPage]")
		pages=Ubound(arrContent)+1
		if CurrentPage<1 then CurrentPage=1
		if CurrentPage>pages then CurrentPage=pages
		sTemp="<p class=content>" & arrContent(CurrentPage-1)
		sTemp=sTemp & "</p><p class=content_page>"
		if CreateHtmlIng=True then
			if CurrentPage>1 then
				if (CurrentPage-1) > 1 then
				sTemp=sTemp & "<a href='" & sInfoFileName & "_P" & CurrentPage-1 & "."&Cl.Channel_Setting(13)&"'>上一页</a>&nbsp;&nbsp;"
				else
				sTemp=sTemp & "<a href='" & sInfoFileName & "."&Cl.Channel_Setting(13)&"'>上一页</a>&nbsp;&nbsp;"
				end if
			end if
			for i=1 to pages
				if i=CurrentPage then
					sTemp=sTemp & "<strong><font color=""#ff0033"">[" & cstr(i) & "]</font></strong>&nbsp;"
				else
					if i>1 then
					sTemp=sTemp & "<a href='" & sInfoFileName & "_P" & i & "."&Cl.Channel_Setting(13)&"'>[" & i & "]</a>&nbsp;"
					else
					sTemp=sTemp & "<a href='" & sInfoFileName & "."&Cl.Channel_Setting(13)&"'>[" & i & "]</a>&nbsp;"
					end if
				end if
			next
			if CurrentPage<pages then
				sTemp=sTemp & "&nbsp;<a href='" & sInfoFileName & "_P" & CurrentPage+1 & "."&Cl.Channel_Setting(13)&"'>下一页</a>"
			end if
		else
			if CurrentPage>1 then
				sTemp=sTemp & "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&Page=" & CurrentPage-1 & "'>上一页</a>&nbsp;&nbsp;"
			end if
			for i=1 to pages
				if i=CurrentPage then
					sTemp=sTemp & "<strong><font color=""#ff0033"">[" & cstr(i) & "]</font></strong>&nbsp;"
				else
					sTemp=sTemp & "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&Page=" & i & "'>[" & i & "]</a>&nbsp;"
				end if
			next
			if CurrentPage<pages then
				sTemp=sTemp & "&nbsp;<a href='" & strFileName & "?ArticleID=" & ArticleID & "&Page=" & CurrentPage+1 & "'>下一页</a>"
			end if
		end if
		sTemp=sTemp & "</p>"
		ManualPagination=sTemp
	end if
End Function
'采用自动分页方式
Function AutoPagination()
	dim strContent,sMaxCharPerPage
	dim ContentLen,MaxPerPage,lngBound
	dim BeginPoint,EndPoint
	strContent=rs("Content")
	ContentLen=len(strContent)
	sMaxCharPerPage=rs("MaxCharPerPage")
	if Not IsNumeric(sMaxCharPerPage) then sMaxCharPerPage=0
	if ContentLen<=sMaxCharPerPage or sMaxCharPerPage<10 then
		AutoPagination=strContent
		Exit Function
	else
		pages=ContentLen\sMaxCharPerPage
		if sMaxCharPerPage*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=sMaxCharPerPage*(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
			elseif lngTemp2_1>lngTemp2_2 then
				lngtemp2=lngTemp2_2
			else
				lngTemp2=lngTemp2_1+4
			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
			elseif lngTemp3_1>lngTemp3_2 then
				lngtemp3=lngTemp3_2
			else
				lngTemp3=lngTemp3_1+5
			end if
			if lngTemp1<lngTemp2 then
				lngTemp=lngTemp2
			else
				lngTemp=lngTemp1
			end if
			if lngTemp<lngTemp3 then lngTemp=lngTemp3
			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
				elseif lngTemp4_1>lngTemp4_2 then
					lngtemp4=lngTemp4_2
				else
					lngTemp4=lngTemp4_1+5
				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=sMaxCharPerPage*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
				elseif lngTemp2_1>lngTemp2_2 then
					lngTemp2=lngTemp2_2-1
				else
					lngTemp2=lngTemp2_1+3
				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
				elseif lngTemp3_1>lngTemp3_2 then
					lngtemp3=lngTemp3_2-1
				else
					lngTemp3=lngTemp3_1+4
				end if
				if lngTemp1<lngTemp2 then
					lngTemp=lngTemp2
				else
					lngTemp=lngTemp1
				end if
				if lngTemp<lngTemp3 then lngTemp=lngTemp3
				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
					elseif lngTemp4_1>lngTemp4_2 then
						lngtemp4=lngTemp4_2-1
					else
						lngTemp4=lngTemp4_1+4
					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
		Dim sTemp
		if BeginPoint>EndPoint then '确保EndPoint大于BeginPoint。
			Dim sP
			sP=(BeginPoint-EndPoint)
			if sP>sMaxCharPerPage then
				EndPoint=BeginPoint+sMaxCharPerPage
			else
				EndPoint=EndPoint+sMaxCharPerPage
			end if
		end if
		sTemp="<p class=content>"
		sTemp=sTemp & mid(strContent,BeginPoint,EndPoint-BeginPoint)
		sTemp=sTemp & "</p><p class=content_page>"
		if CreateHtmlIng=True then
			if CurrentPage>1 then
				if (CurrentPage-1) > 1 then
				sTemp=sTemp & "<a href='" & sInfoFileName & "_P" & CurrentPage-1 & "."&Cl.Channel_Setting(13)&"'>上一页</a>&nbsp;&nbsp;"
				else
				sTemp=sTemp & "<a href='" & sInfoFileName & "."&Cl.Channel_Setting(13)&"'>上一页</a>&nbsp;&nbsp;"
				end if
			end if
			for i=1 to pages
				if i=CurrentPage then
					sTemp=sTemp & "<strong><font color=""#ff0033"">[" & cstr(i) & "]</font></strong>&nbsp;"
				else
					if i>1 then
					sTemp=sTemp & "<a href='" & sInfoFileName & "_P" & i & "."&Cl.Channel_Setting(13)&"'>[" & i & "]</a>&nbsp;"
					else
					sTemp=sTemp & "<a href='" & sInfoFileName & "."&Cl.Channel_Setting(13)&"'>[" & i & "]</a>&nbsp;"
					end if
				end if
			next
			if CurrentPage<pages then
				sTemp=sTemp & "&nbsp;<a href='" & sInfoFileName & "_P" & CurrentPage+1 & "."&Cl.Channel_Setting(13)&"'>下一页</a>"
			end if
		else
			if CurrentPage>1 then
				sTemp=sTemp & "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&Page=" & CurrentPage-1 & "'>上一页</a>&nbsp;&nbsp;"
			end if
			for i=1 to pages
				if i=CurrentPage then
					sTemp=sTemp & "<strong><font color=""#ff0033"">[" & cstr(i) & "]</font></strong>&nbsp;"
				else
					sTemp=sTemp & "<a href='" & strFileName & "?ArticleID=" & ArticleID & "&Page=" & i & "'>[" & i & "]</a>&nbsp;"
				end if
			next
			if CurrentPage<pages then
				sTemp=sTemp & "&nbsp;<a href='" & strFileName & "?ArticleID=" & ArticleID & "&Page=" & CurrentPage+1 & "'>下一页</a>"
			end if
		end if
		sTemp=sTemp & "</p>"
		AutoPagination=sTemp
	end if
End Function

Function ChkTrueRead()
	ChkTrueRead=True
	ErrMsg=""
'============================================================================
	if rs("Receive")=True and SysTemVersion > 0 then
		if request.Form("Receive")="now" then
			Call DoReceive(ArticleId)
		end if
		Dim sReceiveHTML,sUserMsg,sNotReceiveUser
		Dim IsPrivate,IsReceiveUser,IsReceived
		IsPrivate=False:IsReceiveUser=False:IsReceived=False
		sReceiveHTML=Split(Template.html(13),"||")
		ErrMsg=sReceiveHTML(0)
		if Rs("ReceiveType")=1 then IsPrivate=True
		if Cl.UserID>0 and Cl.UserLevel<>5 then
			if Instr(Rs("ReceiveUser"),"|"&Cl.User_Info(5)&"|")>0 then IsReceiveUser=True
			if Instr(Rs("Received"),"|"&Cl.User_Info(5)&"|")>0 then IsReceived=True
			ErrMsg=Replace(ErrMsg,"{%nologinmsg%}","")
		else
			ErrMsg=Replace(ErrMsg,"{%nologinmsg%}",sReceiveHTML(4))
		end if
		if IsReceiveUser then
			if Not IsReceived then
				ErrMsg=Replace(ErrMsg,"{%userreceivemsg%}",sReceiveHTML(1))
				if Rs("AutoReceiveTime")>0 then
					ErrMsg=ErrMsg & VbNewLine & Replace(sReceiveHTML(3),"{%time%}",Rs("AutoReceiveTime"))
				end if
			else
				ErrMsg=Replace(ErrMsg,"{%userreceivemsg%}",sReceiveHTML(2))
				ErrMsg=Replace(ErrMsg,"{%articleid%}",ArticleID)
			end if
		else
			ErrMsg=Replace(ErrMsg,"{%userreceivemsg%}","")
		end if
		ErrMsg=Replace(ErrMsg,"{%receiveuser%}",replace(DelHeadTail(Rs("ReceiveUser")),"|",","))
		ErrMsg=Replace(ErrMsg,"{%received%}",replace(DelHeadTail(Rs("Received")),"|",","))
		sNotReceiveUser=Trim(replace(DelHeadTail(Rs("NotReceiveUser")),"|",","))
		if sNotReceiveUser="" or IsNull(sNotReceiveUser) then
			ErrMsg=Replace(ErrMsg,"{%notreceiveuser%}","")
		else
			ErrMsg=Replace(ErrMsg,"{%notreceiveuser%}",sReceiveHTML(5))
			ErrMsg=Replace(ErrMsg,"{%notreceiveuser%}",sNotReceiveUser)
		end if
		If IsPrivate and Not IsReceiveUser then
			ChkTrueRead=False
			ErrMsg=Template.Strings(12) & ErrMsg
			Exit Function
		elseif IsPrivate then
			if Not IsReceived then
				ChkTrueRead=False
				ErrMsg=Template.Strings(13) & ErrMsg
				Exit Function
			end if
		end if
	end if
'=========================================================================
	if Not Cl.TrueBrowsePurview then
		ErrMsg=ErrMsg & Template.Strings(3)
		ChkTrueRead=False : Exit Function
	end if
	if Not Cl.ChkUserLevel(rs("ReadLevel"),5) or rs("ReadPoint")>0 or rs("ReadMoney")>0 then
		if Cl.UserID=0 Or Cl.UserLevel=5 then
			ErrMsg=ErrMsg & Template.Strings(6)
			ChkTrueRead=False : Exit Function
		End if
		if Not Cl.ChkUserLevel(rs("ReadLevel"),Cl.UserLevel) then
			ErrMsg=ErrMsg & Template.Strings(7)
			ChkTrueRead=False : Exit Function
		End if
		Dim rsL,SQLL,IsPay
		SQLL="Select Top 1 ID,ConsumePoint,ConsumeMoney,ConsumeNums,ConsumeLog,ConsumeTime From Cl_ConsumeLog Where ChannelID="&ChannelID&" and InfoID="&ArticleID&" and UserID="&Cl.UserID&" Order By ID Desc"
		Set rsL=Server.CreateObject("adodb.recordset")
		OpenConn_L : rsL.Open SQLL,Conn_L,1,3
		if rsL.Bof and rsL.Eof then
			IsPay=False
		else
			IsPay=True
			'if *** then IsPay=False
			rsL("ConsumeNums")=rsL("ConsumeNums")+1
			rsL.Update
		end if
		rsL.Close : Set rsL=Nothing
		Dim sBackMoney,sBackPoint
		Select Case Clng(Cl.User_Info(24))
		Case 1
			if Not IsPay and (Rs("ReadPoint") > 0 or Rs("ReadMoney") > 0) then '1
				if Clng(Cl.User_Info(22))<rs("ReadPoint") or Clng(Cl.User_Info(23))<rs("ReadMoney") then '2
					ChkTrueRead=False
					ErrMsg=ErrMsg & Template.Strings(8)
					ErrMsg=Replace(ErrMsg,"{%readpoint%}",rs("ReadPoint"))
					ErrMsg=Replace(ErrMsg,"{%userpoint%}",Cl.User_Info(22))
					ErrMsg=Replace(ErrMsg,"{%readmoney%}",rs("ReadMoney"))
					ErrMsg=Replace(ErrMsg,"{%usermoney%}",Cl.User_Info(23))
				else '2
					if lcase(Trim(request("Pay")))="yes" then
						Cl.Execute_U "update " & Db.UserTable & " set " & Db.UserPoint & "=" & Db.UserPoint & "-" & rs("ReadPoint") & "," & Db.UserMoney & "=" & Db.UserMoney & "-" & rs("ReadMoney") & " where " & Db.UserID & "=" & Clng(Cl.UserID) & ""
						Cl.Execute_L("Insert Into Cl_ConsumeLog (ChannelID,InfoID,Title,Url,UserID,UserName,ConsumePoint,ConsumeMoney,ConsumeNums,ConsumeTime) values ("&ChannelID&","&ArticleID&",'"&InfoTitle&"','"&Request.ServerVariables("PATH_INFO")&"',"&Cl.User_Info(4)&",'"&Cl.User_Info(5)&"',"&rs("ReadPoint")&","&rs("ReadMoney")&",0,'"&Now&"')")
						Cl.GetCacheUserInfo
						sBackMoney=rs("BackMoney") + Clng(rs("ReadMoney")*rs("BackMoneyRate")/100)
						sBackPoint=rs("BackPoint") + Clng(rs("ReadPoint")*rs("BackPointRate")/100)
						if sBackMoney>0 or sBackPoint>0 then
						Cl.Execute_U "update " & Db.UserTable & " set " & Db.UserPoint & "=" & Db.UserPoint & "+" & sBackPoint & "," & Db.UserMoney & "=" & Db.UserMoney & "+" & sBackMoney & " where " & Db.UserName & "='" & rs("Editor") & "'"
						end if
					else
						ChkTrueRead=False
						ErrMsg=Replace(Template.Strings(9),"{%readpoint%}",rs("ReadPoint"))
						ErrMsg=Replace(ErrMsg,"{%userpoint%}",Cl.User_Info(22))
						ErrMsg=Replace(ErrMsg,"{%readmoney%}",rs("ReadMoney"))
						ErrMsg=Replace(ErrMsg,"{%usermoney%}",Cl.User_Info(23))
						ErrMsg=Replace(ErrMsg,"{%filename%}",strFileName)
						ErrMsg=Replace(ErrMsg,"{%articleid%}",rs("ArticleID"))
					end if
				end if '2
			end if '1
		Case 2
			if Clng(Cl.User_Info(40))<=0 then
				ErrMsg=ErrMsg & Template.Strings(10)
				ChkTrueRead=False
			elseif IsPay=False and Rs("ReadMoney")>0 then '1
				if Clng(Cl.User_Info(23))<rs("ReadMoney") then '2
					ChkTrueRead=False
					ErrMsg=ErrMsg & Template.Strings(8)
					ErrMsg=Replace(ErrMsg,"{%readpoint%}",0)
					ErrMsg=Replace(ErrMsg,"{%userpoint%}",0)
					ErrMsg=Replace(ErrMsg,"{%readmoney%}",rs("ReadMoney"))
					ErrMsg=Replace(ErrMsg,"{%usermoney%}",Cl.User_Info(23))
				else '2
					if lcase(Trim(request("Pay")))="yes" then
						Cl.Execute_U "update " & Db.UserTable & " set " & Db.UserMoney & "=" & Db.UserMoney & "-" & rs("ReadMoney") & " where " & Db.UserID & "=" & Clng(Cl.UserID) & ""
						Cl.Execute_L("Insert Into Cl_ConsumeLog (ChannelID,InfoID,Ttile,Url,UserID,UserName,ConsumePoint,ConsumeMoney,ConsumeNums,ConsumeTime) values ("&ChannelID&","&ArticleID&",'"&InfoTitle&"','"&Request.ServerVariables("PATH_INFO")&"',"&Cl.User_Info(4)&",'"&Cl.User_Info(5)&"',0,"&rs("ReadMoney")&",0,'"&Now&"')")
						Cl.GetCacheUserInfo
						sBackMoney=rs("BackMoney") + Clng(rs("ReadMoney")*rs("BackMoneyRate")/100)
						sBackPoint=rs("BackPoint") + Clng(rs("ReadPoint")*rs("BackPointRate")/100)
						if sBackMoney>0 or sBackPoint>0 then
						Cl.Execute_U "update " & Db.UserTable & " set " & Db.UserPoint & "=" & Db.UserPoint & "+" & sBackPoint & "," & Db.UserMoney & "=" & Db.UserMoney & "+" & sBackMoney & " where " & Db.UserName & "='" & rs("Editor") & "'"
						end if
					else
						ChkTrueRead=False
						ErrMsg=Replace(Template.Strings(9),"{%readpoint%}",0)
						ErrMsg=Replace(ErrMsg,"{%userpoint%}",0)
						ErrMsg=Replace(ErrMsg,"{%readmoney%}",rs("ReadMoney"))
						ErrMsg=Replace(ErrMsg,"{%usermoney%}",Cl.User_Info(23))
						ErrMsg=Replace(ErrMsg,"{%filename%}",strFileName)
						ErrMsg=Replace(ErrMsg,"{%articleid%}",rs("ArticleID"))
					end if
				end if '2
			end if
		Case Else
			ErrMsg=ErrMsg & Template.Strings(7)
			ChkTrueRead=False
		End Select
	end if
End Function
%>