function.asp

完美政府版,正版网站解决方案

	Set objNewsTemplatesFile=Nothing
	Set objFSO = Nothing
End Function

'获取评论模版
Function GetReviewBoxTemplate()
	Set objFSOReviewBox = Server.CreateObject("Scripting.FileSystemObject")
	Set objReviewBoxTemplatesFile = objFSOReviewBox.OpenTextFile(Server.MapPath("Templates/ReviewBox.htm"),1,True)
	If Not objReviewBoxTemplatesFile.AtEndOfStream Then
		GetReviewBoxTemplate = objReviewBoxTemplatesFile.ReadAll
	end if
	objReviewBoxTemplatesFile.Close
	Set objReviewBoxTemplatesFile=Nothing
	Set objFSOReviewBox = nothing
End Function

'获取BOTTOM模版
Function GetBottomTemplate()
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
	Set objTemplatesFile = objFSO.OpenTextFile(Server.MapPath("Templates/Bottom.htm"),1,True)
	If Not objTemplatesFile.AtEndOfStream Then
		GetBottomTemplate = objTemplatesFile.ReadAll
	end if
	objTemplatesFile.Close
	Set objNewsTemplatesFile=Nothing
	Set objFSO = Nothing
End Function
%>
<%
'****************************************************************************
'' @功能说明: 生成相关文章js文件
'' @参数说明:  - 
'' @返回值:   - 
'****************************************************************************
function WriteJsAboutNews(NewsID)
	set rs1=server.CreateObject("ADODB.RecordSet") 
	rs1.Source="select * from "& db_News_Table &" where NewsID="&NewsID
	rs1.Open rs1.Source,conn,1,1
	if (not rs1.bof) and (not rs1.eof) then 
		HTMLFileName=rs1("HTMLFileName")
		if CreatHTML<>0 and UCase(HTMLFileName)<>"NO" and HTMLFileName<>"" then
			About=rs1("About")
			UpdateTime=trim(rs1("UpdateTime"))

			lsend=instr(HTMLFileName,"/")
			SavePathTemp=left(HTMLFileName,lsend)

			SaveFileName=SavePathTemp & year(UpdateTime) &"-"& month(UpdateTime) &"/"& year(UpdateTime) & month(UpdateTime) & day(UpdateTime) & hour(UpdateTime) & "-" & NewsID &".js"
			Set fso=Server.CreateObject("Scripting.FileSystemObject")
			set hf=fso.CreateTextFile(Server.mappath(SaveFileName),true)
			hf.write "document.writeln("& chr(34) &"<table border='0' cellpadding='0' cellspacing='0' style='border-collapse: collapse' width='98%' id='AutoNumber5'>"& chr(34) &");"& vbcrlf
			dim ii
			ii = 0
			set rs=server.CreateObject("ADODB.RecordSet") 
			rs.Source="select top " & top_txt & " * from "& db_News_Table &" where (about like '%" & About & "%' or title like '%" & About & "%') and checkked=1 order by NewsID desc"
			rs.Open rs.Source,conn,1,1
			if rs.bof and rs.eof then 
				hf.write "document.writeln("& chr(34) &"<td align=center><br>暂 无<br><br></td>"& chr(34) &");"& vbcrlf
			else 
				do while not rs.eof 
					hf.write "document.writeln("& chr(34) &"<tr><td height=12> · "& chr(34) &");"& vbcrlf
					if rs("picnews")=1 then
						hf.write "document.writeln("& chr(34) &"<img src='images/news_img.gif'>"& chr(34) &");"& vbcrlf 
					end if
					HtmlFileName=rs("HTMLFileName")
					if UCase(HTMLFileName)<>"NO" and HTMLFileName<>"" then
						hf.write "document.writeln("& chr(34) &"<a class=middle href='"& xpurl & HtmlFileName &"' title='"& htmlencode4(rs("title")) &"'>"& CutStr(htmlencode4(rs("title")),14) &"</a>"& chr(34) &");"& vbcrlf
					else
						hf.write "document.writeln("& chr(34) &"<a class=middle href='Article.asp?NewsID="& rs("NewsID") &"' title='"& htmlencode4(rs("title")) &"'>"& CutStr(htmlencode4(rs("title")),14) &"</a>"& chr(34) &");"& vbcrlf
					end if
					hf.write "document.writeln("& chr(34) &"</td></tr>"& chr(34) &");"& vbcrlf
					ii =ii + 1
					if ii>top_txt-1 then exit do
					rs.movenext     
				loop
			end if  
			rs.close   
			set rs=nothing
			hf.write "document.writeln("& chr(34) &"</table>"& chr(34) &");"& vbcrlf
			hf.close
			set hf=nothing
			set fso=nothing
		end if
	end if
	rs1.close
	set rs1=nothing
end function
%>

<%
'****************************************************************************
'' @功能说明: 将指定NewsID转换为HTML文件
'' @参数说明:  - int [NewsID]: 新闻ID号
'' @参数说明:  - int [Rewrite]: 重写标志，为1时强制重写
'' @返回值:   - [WriteNews] 转换后的新闻HTML文件名
'****************************************************************************
function WriteNews(NewsID,Rewrite)
	On Error Resume Next
	dim typename,page,FilePage,HTMLFileName,News_Content_Page
	WriteNews=""
	
	if (not IsNumeric(newsid)) or (not IsNumeric(Rewrite)) then
	else
		'判断该篇文章是否审核
		set rsNews=server.createobject("adodb.recordset")
		sqlNews="select * from "& db_News_Table &" where NewsId="& NewsId &" and checkked=1 and newslevel<1"
		rsNews.open sqlNews,conn,1,3
		if rsNews.eof and rsNews.bof then
			rsNews.close
			set rsNews=nothing
		else
			HTMLFileName=rsNews("HTMLFileName")
			if Rewrite=1 then
				HTMLFileName="No"
			end if
			if UCase(HTMLFileName)<>"NO" then
				rsNews.close
				set rsNews=nothing
				Response.Redirect HTMLFileName
			end if

			bigclassid=rsNews("bigclassid")
			smallclassid=rsNews("smallclassid")
			title=htmlencode4(trim(rsNews("title")))
			about=htmlencode4(trim(rsNews("about")))
			Author=htmlencode4(trim(rsNews("Author")))
			editor=htmlencode4(trim(rsNews("editor")))
			Original=htmlencode4(trim(rsNews("Original")))
			UpdateTime=trim(rsNews("UpdateTime"))
			News_Content=rsNews("Content")
			
			''添加图片鼠标滚轮缩放效果
			if mouse_wheel_zoom="on" then
				News_Content=replace(News_Content,"<IMG","<IMG onmousewheel='return img_zoom(event,this)' onload='javascript:if(this.width>screen.width-333)this.width=screen.width-333'",1,-1,1) 
			end if
			''图片上传路径还原为 config.asp 中设定的 [FileUploadPath] 值
			News_Content=replace(News_Content,"="&chr(34)&"uploadfile/","="&chr(34)&FileUploadPath,1,-1,1)
	
			SpecialID=rsNews("SpecialID")
			SpecialID2=rsNews("SpecialID2")
			click=rsNews("click")
			EnCode=trim(rsNews("EnCode"))
			typeid=rsNews("typeid")
			titletype=rsNews("titletype")
			titlecolor=rsNews("titlecolor")
			titleface=rsNews("titleface")
			backtype=rsNews("backtype")
	
			set rsType=server.CreateObject("ADODB.RecordSet")
			rsType.Source="select * from "& db_Type_Table &" where typeID=" & typeID
			rsType.Open rsType.Source,conn,1,1
			typename=rsType("typename")
			TypeFolderName=rsType("TypeFolderName")
			rsType.Close
			set rsType=nothing

			set rsBigClass=server.CreateObject("ADODB.RecordSet")
			rsBigClass.Source="select * from "& db_BigClass_Table &" Where BigClassid=" & BigClassid
			rsBigClass.Open rsBigClass.Source,conn,1,1
			bigclassname=rsBigClass("bigclassname")
			rsBigClass.close
			set rsBigClass=nothing
			if smallclassid<>"" then
				set rsSmallClass=server.CreateObject("ADODB.RecordSet")
				rsSmallClass.Source="select * from "& db_SmallClass_Table &" Where smallClassid=" & smallClassid
				rsSmallClass.Open rsSmallClass.Source,conn,1,1
				smallclassname=rsSmallClass("smallclassname")
				rsSmallClass.close
				set rsSmallClass=nothing
			end if		

			SavePath=TypeFolderName
			SaveSecondPath=year(UpdateTime) &"-"& month(UpdateTime)
			ServePath=server.mappath(SavePath)
			Set fso=server.createobject("scripting.filesystemobject")
		
			if fso.FolderExists(ServePath) then
				'检查有没有大类目录,无则自动建立
			else
		    Set f = fso.CreateFolder(ServePath)
		    set f=nothing
			End if
			
			if fso.FolderExists(ServePath &"\"& SaveSecondPath) then
				'检查上传目录有没有本年月目录,无则自动建立
			else
		    Set f = fso.CreateFolder(ServePath &"\"& SaveSecondPath)
		    set f=nothing
			End if
			set fso=nothing
		
			WriteFileNameTemp=TypeFolderName &"/"& SaveSecondPath &"/"& year(UpdateTime) & month(UpdateTime) & day(UpdateTime) & hour(UpdateTime) & "-" & NewsID

			Show_HtmlTitle=title &"_"& SmallClassName &"_"& BigClassName &"_"& typename &"_"&jjgn
			
			Show_NewsNavigation=" &nbsp;&nbsp;<STRONG><A class=daohang href='./'>网站首页</A>＞<A class=daohang href='Type.asp?TypeId="& TypeId &"'>"& TypeName &"</A></STRONG>"
			if BigClassName<>"" then
				Show_NewsNavigation=Show_NewsNavigation & "<STRONG>＞<A class=daohang href='BigClass.asp?TypeId="& TypeId &"&amp;BigClassid="& BigClassid &"'>"& BigClassName &"</A></STRONG>"
			end if
			if SmallClassName<>"" then
				Show_NewsNavigation=Show_NewsNavigation & "<STRONG>＞<A class=daohang href='SmallClass.asp?typeid="& TypeId &"&amp;BigClassID="& BigClassid &"&amp;SmallClassID="& SmallClassID &"'>"& SmallClassName &"</A></STRONG>"
			end if
			
			Show_NewsHits="<SCRIPT language=JavaScript src='News_GetHits.asp?NewsID="& NewsID &"'></SCRIPT>"
			Show_NewsCopyRightLogo="<img src="& ReadNews_CopyRight_Logo &" border=0>"

			Show_BaseUrl="<base href='"& xpurl &"'>"
			
			'菜单调用
			if B_BG=0 then	'判断菜单是否二级显示
				Show_TypeMenu="<SCRIPT language=JavaScript src='js/MenuNavSet.js'></SCRIPT><SCRIPT language=JavaScript src='js/MenuNav.js'></SCRIPT><SCRIPT language=JavaScript src='js/Show_TypeMenu2.js'></SCRIPT>"
			else
				Show_TypeMenu="<SCRIPT language=JavaScript src='js/Show_TypeMenu1.js'></SCRIPT>"
			end if
			'搜索条调用
			Show_SeachBar="<SCRIPT language=JavaScript src='js/Show_SearchBar.js'></SCRIPT>"
			Show_UserLogin="<SCRIPT language=JavaScript src='Show_UserLogin.asp'></SCRIPT>"
			Show_NewsID=NewsID
			Show_BaseMenu="<SCRIPT language=JavaScript src='js/Show_BaseMenu.js'></SCRIPT>"
			Show_BottomMenu="<SCRIPT language=JavaScript src='js/Show_BottomMenu.js'></SCRIPT>"
			Show_HotNews="<SCRIPT language=JavaScript src='js/Show_HotNews.js'></SCRIPT>"

			strAboutJsFileName=WriteFileNameTemp &".js"
			Show_AboutNews="<SCRIPT language=JavaScript src='"& strAboutJsFileName &"'></SCRIPT>"
			Show_NewsTitle=title
			Show_ReviewBox=GetReviewBoxTemplate()
			Show_AdminEmail=email

			Show_Banner
			TableWidth="760"
			SystemVersion=version & ver
			MetaKeyword="FORECAST NEWS"

			WriteData=GetHeadTemplate() & GetTopTemplate() & GetNewsTemplate() & GetBottomTemplate()
			WriteData=replace(WriteData,"{$Show_ReviewBox$}",Show_ReviewBox,1,-1,1)									'评论发表框此句应在第一行
			WriteData=replace(WriteData,"{$MetaKeyword$}",MetaKeyword,1,-1,1)									'评论发表框此句应在第一行
			WriteData=replace(WriteData,"{$Show_BaseUrl$}",Show_BaseUrl,1,-1,1)												'网页资源的基本路径
			WriteData=replace(WriteData,"{$Show_HtmlTitle$}",Show_HtmlTitle,1,-1,1)									'HTML的标题
			WriteData=replace(WriteData,"{$Show_NewsID$}",Show_NewsID,1,-1,1)												'新闻ID号
			WriteData=replace(WriteData,"{$Show_NewsNavigation$}",Show_NewsNavigation,1,-1,1)				'页面导航条
			WriteData=replace(WriteData,"{$Show_SeachBar$}",Show_SeachBar,1,-1,1)											'
			WriteData=replace(WriteData,"{$Show_BaseMenu$}",Show_BaseMenu,1,-1,1)											'
			WriteData=replace(WriteData,"{$Show_TypeMenu$}",Show_TypeMenu,1,-1,1)											'
			WriteData=replace(WriteData,"{$Show_BottomMenu$}",Show_BottomMenu,1,-1,1)
			WriteData=replace(WriteData,"{$Show_NewsTitle$}",Show_NewsTitle,1,-1,1)
			WriteData=replace(WriteData,"{$Show_NewsHits$}",Show_NewsHits,1,-1,1)
			WriteData=replace(WriteData,"{$Show_NewsUpdateTime$}",UpdateTime,1,-1,1)
			WriteData=replace(WriteData,"{$Show_NewsOriginal$}",Original,1,-1,1)
			WriteData=replace(WriteData,"{$Show_NewsEditor$}",Editor,1,-1,1)
			WriteData=replace(WriteData,"{$Show_NewsAuthor$}",Author,1,-1,1)
			WriteData=replace(WriteData,"{$Show_NewsCopyRightLogo$}",Show_NewsCopyRightLogo,1,-1,1)
			WriteData=replace(WriteData,"{$Show_UserLogin$}",Show_UserLogin,1,-1,1)
			WriteData=replace(WriteData,"{$Show_AdminEmail$}",Show_AdminEmail,1,-1,1)
			WriteData=replace(WriteData,"{$TableWidth$}",TableWidth,1,-1,1)
			WriteData=replace(WriteData,"{$SystemVersion$}",SystemVersion,1,-1,1)
			WriteData=replace(WriteData,"{$Show_HotNews$}",Show_HotNews,1,-1,1)
			WriteData=replace(WriteData,"{$Show_AboutNews$}",Show_AboutNews,1,-1,1)
			WriteData=replace(WriteData,"{$Show_Logo$}",Show_Logo(),1,-1,1)
			WriteData=replace(WriteData,"{$Show_Banner$}",Show_Banner(),1,-1,1)



			arr_Content=split(News_Content,"[---分页---]")					'文章分页处理
			MaxPages=ubound(arr_Content)
			page=1

			Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
			while page<MaxPages+2
				WriteData1=WriteData
				if MaxPages >0 then
					'Response.write "<center><font color=red>多页面HTML文件存入中...</font></center>"
					PageMessage= "<p align=right><a class=black href='"& WriteFileNameTemp &"-1.html' title='第1页'>首页</a> "
					if Page-1 > 0 then
						Prev_Page = Page - 1
						PageMessage=PageMessage &"<a class=black href='"& WriteFileNameTemp &"-"& Prev_Page &".html' title='第"& Prev_Page &"页'>上一页</a> "
					end if
			
					for PageCounter=0 to MaxPages
						PageLink = PageCounter+1
						if PageLink <> Page Then
							PageMessage=PageMessage &"<a class=black href='"& WriteFileNameTemp &"-"& PageLink &".html'>["& PageLink &"]</a> "
						else
							PageMessage=PageMessage &"<font color='#FF0000'><B>["& PageLink &"]</B></font> "
						end if
						If PageLink = MaxPages+1 Then Exit for
			
					Next
					if page <= Maxpages then
						bdd_Page = Page + 1
						PageMessage=PageMessage &"<a class=black href='"& WriteFileNameTemp &"-"& bdd_Page & ".html' title='第" & bdd_Page & "页'>下一页</A>"
					end if
					PageMessage=PageMessage &" <A class=black href='"& WriteFileNameTemp &"-"& Maxpages+1 &".html' title='第"& Maxpages+1 &"页'>尾页</A></P>"
					WriteFileName=WriteFileNameTemp &"-"& Page
					News_Content=arr_Content(page-1) & PageMessage

					'Response.write arr_Content(Page-1) & PageMessage &chr(10)

				else
					'Response.write "<center><font color=red>单页面HTML文件存入中...</font></center>"
					WriteFileName=WriteFileNameTemp
				end if
			
				WriteData1=replace(WriteData1,"{$Show_NewsContent$}",News_Content,1,-1,1)

				'生成HTML文件名
				WriteFileName=WriteFileName &".html"

				Set objNewsWriteFile=objFSO.CreateTextFile(Server.MapPath(WriteFileName),True)
				objNewsWriteFile.Write WriteData1
				objNewsWriteFile.Close
				Set objNewsWriteFile=Nothing

				'Response.write "<center><font color=red>HTML页文件存入完毕.</font></center>"
				page=page+1
			wend
			Set objFSO = Nothing
			if MaxPages >0 then
				HTMLFileName=WriteFileNameTemp &"-1.html"
			else
				HTMLFileName=WriteFileName
			end if
			rsNews("HTMLFileName")=HTMLFileName
			rsNews.update
			rsNews.close
			set rsNews=nothing
			WriteJsAboutNews(NewsID)
			'set conn=nothing
			WriteNews=HTMLFileName
		end if
	end if
end function
%>