syscode_article.asp

功能齐全的oa网络办公源码asp+acce

		loop
	end if  
	rsHot.close
	set rsHot=nothing
end sub

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=0 and A.Passed=1 And A.Elite=1 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

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("Keywords"),2,len(rs("Keywords"))-2)
	if instr(strkey,"|")>1 then
		arrKey=split(strKey,"|")
		strKey="((A.Keywords like '%|" & arrKey(0) & "|%')"
		for i=1 to ubound(arrKey)
			strKey=strKey & " or (A.Keywords like '%|" & arrKey(i) & "|%')"
		next
		strKey=strKey & ")"
	else
		strKey="(A.Keywords 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=0 and A.Passed=1 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 "<li>无相关文章</li>"
	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

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

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=0 and Passed=1 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

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=0 and Passed=1 and ClassID=" & rs("ClassID") & " and ArticleID>" & rs("ArticleID")& " order by ArticleID ASC"
	Set rsNext= Server.CreateObject("ADODB.Recordset")
	rsNext.open sqlNext,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsNext.Eof then
	 	response.write "没有了"
	else
	  	response.write "<a href='"& rsNext("LayoutFileName") & "?ArticleID="&rsNext("ArticleID")& "' title='文章标题：" & rsNext("Title") & vbcrlf & "作    者：" & rsNext("Author") & vbcrlf & "更新时间：" & rsNext("UpdateTime") & vbcrlf & "点击次数：" & rsNext("Hits") &"'>" & gotTopic(rsNext("Title"),TitleLen) & "</a>"
	end if
	rsNext.close
	set rsNext=nothing
end sub

sub ManualPagination()
	dim ArticleID,strContent,CurrentPage
	dim ContentLen,MaxPerPage,pages,i
	dim arrContent
	ArticleID=rs("ArticleID")
	strContent=rs("Content")
	ContentLen=len(strContent)
	CurrentPage=trim(request("ArticlePage"))
	if Instr(strContent,"[NextPage]")<=0 then
		response.write strContent
		response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
	else
		arrContent=split(strContent,"[NextPage]")

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

		response.write arrContent(CurrentPage-1)

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

end sub

sub AutoPagination()
	dim ArticleID,strContent,CurrentPage
	dim ContentLen,MaxPerPage,pages,i,lngBound
	dim BeginPoint,EndPoint
	ArticleID=rs("ArticleID")
	strContent=rs("Content")
	ContentLen=len(strContent)
	CurrentPage=trim(request("ArticlePage"))
	if ContentLen<=rs("MaxCharPerPage") then
		response.write strContent
		response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
	else
		if CurrentPage="" then
			CurrentPage=1
		else
			CurrentPage=Cint(CurrentPage)
		end if
		pages=ContentLen\rs("MaxCharPerPage")
		if rs("MaxCharPerPage")*pages<ContentLen then
			pages=pages+1
		end if
		lngBound=ContentLen          '最大误差范围
		if CurrentPage<1 then CurrentPage=1
		if CurrentPage>pages then CurrentPage=pages

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

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

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

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