syscode_article.asp

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

					end if
				next
			end if
			strTemp=strTemp & rsClass(1)
			if rsClass(5)<>"" then
				strTemp=strTemp & "(外)"
			end if
			strTemp=strTemp & "</option>"
			response.write strTemp
			rsClass.movenext
		loop
	end if
	rsClass.close
	set rsClass=nothing
	response.write "</select></div>"
end sub

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

sub ShowSpecial(SpecialNum)
	dim i
	i=1
	if SpecialNum<=0 or SpecialNum>100 then
		SpecialNum=10
	end if
	sqlSpecial="select S.SpecialID,S.SpecialName,L.LayoutFileName from Special S inner join Layout L on L.LayoutID='5' where S.BrowsePurview>=" & UserLevel & " order by S.OrderID"
	Set rsSpecial= Server.CreateObject("ADODB.Recordset")
	rsSpecial.open sqlSpecial,conn,1,1
	totalPut=rsSpecial.recordcount
	if rsSpecial.bof and rsSpecial.eof then 
		response.Write "&nbsp;没有任何专题栏目"
	else
		rsSpecial.movefirst
		do while not rsSpecial.eof
			response.Write("<li><a href='" & rsSpecial(2) & "?SpecialID=" & rsSpecial(0) & "'>" & rsSpecial(1) & "</a></li><br>")
			rsSpecial.movenext
			i=i+1
			if i>SpecialNum then exit do
		loop
	end if
	if not rsSpecial.eof then
		response.write "<p align='right'><a href='Article_SpecialList.asp'>更多专题</a></p>"
	end if
end sub

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

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

sub ShowSiteCount()
	dim sqlCount,rsCount
	Set rsCount= Server.CreateObject("ADODB.Recordset")
	sqlCount="select count(ArticleID) from Article where Deleted=0"
	rsCount.open sqlCount,conn,1,1
	response.write "文章总数：" & rsCount(0) & "篇<br>"
	rsCount.close

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

	sqlCount="select sum(Hits) from article"
	rsCount.open sqlCount,conn,1,1
	response.write "文章阅读：" & rsCount(0) & "人次<br>"
	rsCount.close
	
	set rsCount=nothing
end sub

sub ShowUserArticle(TitleLen)
	if TitleLen<0 or TitleLen>200 then
		TitleLen=50
	end if

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

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

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

sub SearchResultContent()
   	dim i,strTemp,content
	i=1
	do while not rsSearch.eof
		strTemp=""
		strTemp=strTemp & cstr(MaxPerPage*(CurrentPage-1)+i) & ".<a href='" & rsSearch("LayoutFileName") & "?ArticleID=" & rsSearch("articleid") & "'>"
		if strField="Title" then
			strTemp=strTemp & "<b>" & replace(rsSearch("title"),""&keyword&"","<font color=red>"&keyword&"</font>") & "</b></font></a>"
		else
			strTemp=strTemp & "<b>" & rsSearch("title") & "</b>"
		end if
		if strField="Author" then
			strTemp=strTemp & "&nbsp;[" & replace(rsSearch("Author"),""&keyword&"","<font color=red>"&keyword&"</font>") & "]"
		else
			strTemp=strTemp & "&nbsp;[" & rsSearch("Author") & "]"
		end if
		strTemp=strTemp & "[" & FormatDateTime(rsSearch("UpdateTime"),1) & "][" & rsSearch("Hits") & "]"
		content=left(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 


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

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