refreshfunction.asp

asp源码 图片ASP整站

	if Not RsDownLoadObj.Eof then
		GetDownLoadLocationStr = GetClassLocationStr(RsDownLoadObj("ClassID"),NaviType,CompatStr,OpenTypeStr,CSSStyleStr) & CompatStr & "下载"
	else
		GetDownLoadLocationStr = ""
	end if
	Set RsDownLoadObj = Nothing
End Function
'专题当前位置
Function GetSpecialLocationStr(SpecialID,NaviType,CompatStr,OpenTypeStr,CSSStyleStr)
	Dim SpecialSql,RsSpecialObj
	if NaviType = "1" then
		CompatStr = "<img src=""" & GetConfig(0) & CompatStr & """>"
	end if
	SpecialSql = "Select * from FS_Special where SpecialID='" & SpecialID & "'"
	Set RsSpecialObj = Conn.Execute(SpecialSql)
	if RsSpecialObj.Eof then
		GetSpecialLocationStr = ""
	else
		GetSpecialLocationStr = "<a " & OpenTypeStr & GetCSSStyleStr(CSSStyleStr) & " href=""" & GetConfig(0) & "/Index."&Application(LoginCacheNameStr)(18)&"""><font color=red>首页</font></a>" & CompatStr & RsSpecialObj("CName") & "专题"
	end if
	Set RsSpecialObj = Nothing
End Function
'总站导航
Function LocationNavi(NaviType,RowNumber,NaviPicStr,CompatPicStr,OpenTypeStr,CSSStyleStr,TxtNaviStr)
	Dim NaviArray,i,TempStr
	NaviPicStr = GetNewsNavitionStr(TxtNaviStr,NaviPicStr)
	if CompatPicStr <> "" then
		CompatPicStr = "src=""/" &SysRootDir& CompatPicStr & """"
	else
		CompatPicStr = ""
	end if
	RowNumber = RowNumber
	LocationNavi = "<table border=""0"" width=""100%;"">" & Chr(13) & Chr(10) & "<tr>" & Chr(13) & Chr(10)
	Select Case NaviType
		Case "1"
			TempStr = GetRootClassNavi(OpenTypeStr,CSSStyleStr)
		Case "2"
			TempStr = GetSpecialNavi(OpenTypeStr,CSSStyleStr)
		Case "3"
			TempStr = GetPlusNavi(OpenTypeStr,CSSStyleStr)
		Case "4"
			TempStr = GetRootClassNavi(OpenTypeStr,CSSStyleStr) & "{$$$}" & GetSpecialNavi(OpenTypeStr,CSSStyleStr)
		Case "5"
			TempStr = GetRootClassNavi(OpenTypeStr,CSSStyleStr) & "{$$$}" & GetPlusNavi(OpenTypeStr,CSSStyleStr)
		Case "6"
			TempStr = GetSpecialNavi(OpenTypeStr,CSSStyleStr) & "{$$$}" & GetPlusNavi(OpenTypeStr,CSSStyleStr)
		Case "7"
			TempStr = GetRootClassNavi(OpenTypeStr,CSSStyleStr) & "{$$$}" & GetSpecialNavi(OpenTypeStr,CSSStyleStr) & "{$$$}" & GetPlusNavi(OpenTypeStr,CSSStyleStr)
		Case Else
			LocationNavi = ""
			Exit Function
	End Select
	If Left(Trim(TempStr),5)="{$$$}" then TempStr=Mid(TempStr,6)
	NaviArray = Split(TempStr,"{$$$}")
	for i = LBound(NaviArray) to UBound(NaviArray)
		LocationNavi = LocationNavi & "<td>" & NaviPicStr & NaviArray(i) & "</td>" & Chr(13) & Chr(10)
		if ((i + 1) Mod RowNumber) = 0 then
			LocationNavi = LocationNavi & "</tr>" 
			If CompatPicStr<>"" then
				LocationNavi = LocationNavi & Chr(13) & Chr(10) & "<tr><td colspan="&RowNumber&"><img "&CompatPicStr&" width=""100%"" height=""1""></td></tr>"
			End If
			LocationNavi = LocationNavi  & Chr(13) & Chr(10) & "<tr>"
		end if
	Next
	LocationNavi = LocationNavi & "</tr>" & Chr(13) & Chr(10) & "</table>" & Chr(13) & Chr(10)
End Function
'专题导航
Function GetSpecialNavi(OpenTypeStr,CSSStyleStr)
	Dim SpecialSql,RsSpecialObj
	OpenTypeStr = GetOpenTypeStr(OpenTypeStr)
	SpecialSql = "Select * from FS_Special where ShowNaviTF=1 order by ID desc"
	Set RsSpecialObj = Conn.Execute(SpecialSql)
	do while Not RsSpecialObj.Eof
		if GetSpecialNavi = "" then
			if RsSpecialObj("SaveFilePath") = "/" then
				GetSpecialNavi = "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetConfig(0) & RsSpecialObj("SaveFilePath") & RsSpecialObj("EName") & "/" & "index." & RsSpecialObj("FileExtName") & """ >" & RsSpecialObj("CName") & "</a>"
			else
				GetSpecialNavi = "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetConfig(0) & RsSpecialObj("SaveFilePath") & "/" & RsSpecialObj("EName") & "/" & "index." & RsSpecialObj("FileExtName") & """ >" & RsSpecialObj("CName") & "</a>"
			end if
		else
			if RsSpecialObj("SaveFilePath") = "/" then
				GetSpecialNavi = GetSpecialNavi & "{$$$}" & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetConfig(0) & RsSpecialObj("SaveFilePath") & RsSpecialObj("EName") & "/" & "index." & RsSpecialObj("FileExtName") & """ >" & RsSpecialObj("CName") & "</a>"
			else
				GetSpecialNavi = GetSpecialNavi & "{$$$}" & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetConfig(0) & RsSpecialObj("SaveFilePath") & "/" & RsSpecialObj("EName") & "/" & "index." & RsSpecialObj("FileExtName") & """ >" & RsSpecialObj("CName") & "</a>"
			end if
		end if
		RsSpecialObj.MoveNext
	Loop
End Function
'栏目导航
Function GetRootClassNavi(OpenTypeStr,CSSStyleStr)
	Dim ClassSql,RsClassObj
	OpenTypeStr = GetOpenTypeStr(OpenTypeStr)
	ClassSql = "Select SaveFilePath,ClassEName,ClassCName,FileExtName,ShowTF,DoMain from FS_NewsClass where ParentID='0' and DelFlag=0 and ShowTF=1 order by orders desc"
	Set RsClassObj = Conn.Execute(ClassSql)
	do while Not RsClassObj.Eof
		'if RsClassObj("IsOutClass") = "1" then
		'	GetRootClassNavi = GetRootClassNavi & "{$$$}" &  "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & RsClassObj("ClassLink") & """ >" & RsClassObj("ClassCName") & "</a>"
		'else
			GetRootClassNavi = GetRootClassNavi & "{$$$}" & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetOneClassLinkURL(RsClassObj("ClassEName"),RsClassObj("SaveFilePath"),RsClassObj("FileExtName")) & """ >" & RsClassObj("ClassCName") & "</a>"
		'end if
		RsClassObj.MoveNext
	loop
	Set RsClassObj = Nothing
End Function
'插件导航
Function GetPlusNavi(OpenTypeStr,CSSStyleStr)
	Dim PlusSql,RsPlusObj,OpenType
	PlusSql = "Select Name,Link,OpenType from FS_Plus where ShowTF=1  order by ID asc"
	Set RsPlusObj = Conn.Execute(PlusSql)
	do while Not RsPlusObj.Eof
		if RsPlusObj("OpenType") = 1 then
			OpenType = " target=""_blank"""
		else
			OpenType = ""
		end if
		if GetPlusNavi = "" then
			GetPlusNavi = "<a " & GetCSSStyleStr(CSSStyleStr) & OpenType & " href=""" & RsPlusObj("Link") & """ >" & RsPlusObj("Name") & "</a>"
		else
			GetPlusNavi = GetPlusNavi & "{$$$}" & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenType & " href=""" & RsPlusObj("Link") & """ >" & RsPlusObj("Name") & "</a>"
		end if
		RsPlusObj.MoveNext
	loop
	Set RsPlusObj = Nothing
End Function
'栏目导航
Function ClassNavi(NaviPicStr,CompatPicStr,RowNumberStr,OpenTypeStr,CSSStyleStr,TxtNaviStr)
	Dim ClassSql,RsClassObj,i
	if Fun_Refresh_Type = "Class" then
	if CompatPicStr <> "" then
		CompatPicStr = "src=""/" &SysRootDir& CompatPicStr & """"
	else
		CompatPicStr = ""
	end if
		OpenTypeStr = GetOpenTypeStr(OpenTypeStr)
		NaviPicStr = GetNewsNavitionStr(TxtNaviStr,NaviPicStr)
		ClassSql = "Select SaveFilePath,ClassEName,ClassCName,FileExtName from FS_NewsClass where ShowTF=1 and DelFlag=0 and ParentID='" & Fun_Refresh_ID & "' order by orders desc"
		Set RsClassObj = Conn.Execute(ClassSql)
		'--------修改-----
  dim thisRefreshID
  if RsClassObj.Eof then
  Set RsClassObj = Nothing
  ClassSql = "Select SaveFilePath,ClassEName,ClassCName,FileExtName,ParentID from FS_NewsClass where ClassID='" & Fun_Refresh_ID & "'"
     Set RsClassObj = Conn.Execute(ClassSql)
     If Not RsClassObj.Eof Then thisRefreshID=RsClassObj("ParentID")
     Set RsClassObj = Nothing
  ClassSql = "Select SaveFilePath,ClassEName,ClassCName,FileExtName from FS_NewsClass where ShowTF=1 and DelFlag=0 and  ParentID='" & thisRefreshID & "' order by Orders desc"
  Set RsClassObj = Conn.Execute(ClassSql)
  end if
  '--------修改-----
		ClassNavi = "<table cellpadding=""0"" cellspacing=""0"" border=""0"" width=""100%"">" & Chr(13) & Chr(10)
		do while Not RsClassObj.Eof
			ClassNavi = ClassNavi & "<tr>" & Chr(13) & Chr(10)
			for i = 1 to RowNumberStr
				ClassNavi = ClassNavi & "<td>" & NaviPicStr & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetOneClassLinkURL(RsClassObj("ClassEName"),RsClassObj("SaveFilePath"),RsClassObj("FileExtName")) & """ >" & RsClassObj("ClassCName") & "</a></td>" & Chr(13) & Chr(10)
				RsClassObj.MoveNext
				if RsClassObj.Eof then Exit For
			Next
			ClassNavi = ClassNavi & "</tr>" & Chr(13) & Chr(10)

			If CompatPicStr<>"" then
				ClassNavi = ClassNavi & Chr(13) & Chr(10) & "<tr><td colspan="&RowNumberStr&"><img "&CompatPicStr&" width=""100%"" height=""1""></td></tr>"
			End If

		loop
		ClassNavi = ClassNavi & "</table>" & Chr(13) & Chr(10)
		Set RsClassObj = Nothing
	else
		ClassNavi = ""
	end if
End Function
'热点新闻
Function HotNews(ClassEName,SoonClassStr,NewNumberStr,TitleNumberStr,RowNumberStr,NaviPicStr,CompatPicStr,OpenTypeStr,CSSStyleStr,RowHeightStr,TxtNaviStr,HotDays)
	Dim HotNewsSql,RsHotNewsObj,i
	TitleNumberStr = GetTitleNumberStr(TitleNumberStr)
	NewNumberStr = GetTitleNumberStr(NewNumberStr)
	OpenTypeStr = GetOpenTypeStr(OpenTypeStr)
	CompatPicStr = GetCompatPicStr(CompatPicStr,"","",RowNumberStr)
	NaviPicStr = GetNewsNavitionStr(TxtNaviStr,NaviPicStr)
	if RowHeightStr <> "" then RowHeightStr = " Height=""" & RowHeightStr & """"
	'----------------------
	dim TemppID,TemppSql,EndClassIDList
	If ClassEName<>"" then
		If SoonClassStr="1" then 
			TemppSql="select ClassID from FS_NewsClass where ClassEName='" & ClassEName & "'"
			Set TemppID=conn.execute(TemppSql)
			EndClassIDList= "'" & TemppID(0) & "'" & AllChildClassIDStrList(TemppID(0))
		Else
			TemppSql="select ClassID from FS_NewsClass where ClassEName='" & ClassEName & "'"
			Set TemppID=conn.execute(TemppSql)
			EndClassIDList="'" & TemppID(0) & "'"
		End if
	Else
		EndClassIDList=""
	end If
	'===============================================
	Dim HotBeginTime,DateTimeStr
	HotBeginTime=DateAdd("d",HotDays,Now)
	If IsSqlDataBase=1 Then
		DateTimeStr=" And AddDate>'"&HotBeginTime&"' "
	Else
		DateTimeStr=" And AddDate>#"&HotBeginTime&"# "
	End If
	'================================================
	if EndClassIDList <> "" then
		HotNewsSql = "Select top "&NewNumberStr&" *,FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and DelTF=0 and FS_News.AuditTF=1 and FS_News.ClassID in (" & EndClassIDList & ")"&DateTimeStr &"order by FS_News.ClickNum Desc,FS_News.id desc" 
	else
		HotNewsSql = "Select top "&NewNumberStr&" *,FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and DelTF=0 and FS_News.AuditTF=1"&DateTimeStr &"order by FS_News.ClickNum Desc,FS_News.id desc" 
	end if
	Set RsHotNewsObj = Conn.Execute(HotNewsSql)
	HotNews = "<table cellpadding=""0"" cellspacing=""0"" border=""0"" width=""100%"">" & Chr(13) & Chr(10)
	do while Not RsHotNewsObj.Eof
		HotNews = HotNews & "<tr>" & Chr(13) & Chr(10)
		Dim OneWeekNewPic
		for i = 1 to RowNumberStr
		if DateDiff("d",RsHotNewsObj("AddDate"),Now())<1 Then
   OneWeekNewPic = "<img src='/images/New.gif' border=0>"
else
   OneWeekNewPic = ""
end if
			HotNews = HotNews & "<td " & RowHeightStr & ">" & NaviPicStr & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetOneNewsLinkURL(RsHotNewsObj("NewsID")) & """  title="""& RsHotNewsObj("Title")&""">" & GetHTMLTitle(RsHotNewsObj("TitleStyle"),GotTopic(RsHotNewsObj("Title"),TitleNumberStr)) & "</a>"&OneWeekNewPic&"</td>" & Chr(13) & Chr(10)
			RsHotNewsObj.MoveNext
			if RsHotNewsObj.Eof then Exit For
		Next
		HotNews = HotNews & "</tr>" & Chr(13) & Chr(10) & CompatPicStr & Chr(13) & Chr(10)
	loop
	Set RsHotNewsObj = Nothing