syscode_article.asp

增添网站节日气氛

       			call SearchResultContent()
      		else 
        		currentPage=1 
       			call SearchResultContent()
      		end if 
	   	end if 
   	end if 
   	rsSearch.close 
   	set rsSearch=nothing   
end sub

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

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

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

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

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

'=================================================
'过程名：ShowComment
'作  用：显示相关评论
'参  数：CommentNum  ----最多显示多少个评论
'=================================================
sub ShowComment(CommentNum)
	dim rsComment,sqlComment,rsCommentUser
	if CommentNum>0 and CommentNum<=100 then
		sqlComment="select top " & CommentNum
	else
		sqlComment="select top 10 "
	end if
	sqlComment=sqlComment & " * from ArticleComment where ArticleID=" & ArticleID & " order by CommentID desc"
	Set rsComment= Server.CreateObject("ADODB.Recordset")
	rsComment.open sqlComment,conn,1,1
	if rsComment.bof and rsComment.eof then
		response.write "&nbsp;&nbsp;&nbsp;&nbsp;没有任何评论"
	else
		response.write "<table width='100%' border='0' cellspacing='0' cellpadding='0'>"
		do while not rsComment.eof
			response.write "<tr><td width='70%'>"
			if rsComment("UserType")=1 then
				response.write "<li>会员"
				set rsCommentUser=Conn_User.execute("select " & db_User_ID & "," & db_User_Name & "," & db_User_Email & "," & db_User_QQ & "," & db_User_Homepage & " from " & db_User_Table & " where " & db_User_Name & "='" & rsComment("UserName") & "'")
				if rsCommentUser.bof and rsCommentUser.eof then
					response.write rsComment("UserName")
				else
					response.write "『<a href='UserInfo.asp?UserID=" & rsCommentUser(0) & "' title='姓名：" & rsCommentUser(1) & vbcrlf & "信箱：" & rsCommentUser(2) & vbcrlf & "Oicq：" & rsCommentUser(3) & vbcrlf & "主页：" &  rsCommentUser(4)&"'><font color='blue'>" & rsComment("UserName") & "</font></a>』"
				end if
			else
				response.write "<li>游客『<span title='姓名：" & rsComment("UserName") & vbcrlf & "信箱：" & rsComment("Email") & vbcrlf & "Oicq：" & rsComment("Oicq") & vbcrlf & "主页：" &  rsComment("Homepage")&"' style='cursor:hand'><font color='blue'>" & rsComment("UserName") & "</font></span>』"
			end if
			response.write "于" & rsComment("WriteTime") & "发表评论：</li>"
			response.write "</td><td align=right>评分："&rsComment("Score")&"分</td></tr>"
			response.write "<tr><td colspan='2'>"
			response.write "&nbsp;&nbsp;&nbsp;&nbsp;" & rsComment("Content") & "<br>"
			if rsComment("ReplyContent")<>"" then
				response.write "&nbsp;&nbsp;&nbsp;&nbsp;<font color='009900'>★</font>&nbsp;管理员『<font color='blue'>" & rsComment("ReplyName") & "</font>』于 " & rsComment("ReplyTime") & " 回复道：&nbsp;&nbsp;&nbsp;&nbsp;" & rsComment("ReplyContent") & "<br>"			
			end if
			response.write "<br></td></tr>"
			rsComment.movenext
		loop
		response.write "<tr><td colspan='2' align='right'>"
		response.write "<a href='Article_CommentShow.asp?ArticleID=" & ArticleID & "'>查看关于此文章的所有评论</a>"
		response.write "</td></tr></table>"
	end if
end sub

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

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

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

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

	if intClassID>0 then
		set tClass=conn.execute("select ClassID,Child,ParentPath from ArticleClass where ClassID=" & intClassID)
		if not(tClass.bof and tClass.eof) then
			if tClass(1)>0 then
				arrClassID=ClassID
				set trs=conn.execute("select ClassID from ArticleClass where ParentID=" & tClass(0) & " or ParentPath like '%" & tClass(2) & "," & tClass(0) & ",%' and Child=0 and LinkUrl=''")
				do while not trs.eof
					arrClassID=arrClassID & "," & trs(0)
					trs.movenext
				loop
				set trs=nothing	
				sqlPic=sqlPic & " and A.ClassID in (" & arrClassID & ")"
			else
				sqlPic=sqlPic & " and A.ClassID=" & tClass(0)