refreshfunction.asp

asp源码 图片ASP整站

	HotNews = HotNews & "</table>"
End Function 
'最新新闻 
Function LastNews(ClassEName,SoonClassStr,NewNumberStr,TitleNumberStr,RowNumberStr,NaviPicStr,CompatPicStr,OpenTypeStr,CSSStyleStr,RowHeightStr,TxtNaviStr) 
	Dim LastNewsSql,RsLastNewsObj,i
	TitleNumberStr = GetTitleNumberStr(TitleNumberStr)
	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	
	if EndClassIDList <> "" then	
		LastNewsSql = "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 & ") order by FS_News.ID Desc"
	else
		LastNewsSql = "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 order by FS_News.ID Desc"
	end if
	Set RsLastNewsObj = Conn.Execute(LastNewsSql)
	LastNews = "<table cellpadding=""0"" cellspacing=""0"" border=""0"" width=""100%"">" & Chr(13) & Chr(10)
	do while Not RsLastNewsObj.Eof
		LastNews = LastNews & "<tr>" & Chr(13) & Chr(10)
		Dim OneWeekNewPic
        for i = 1 to RowNumberStr
            if DateDiff("d",RsLastNewsObj("AddDate"),Now())<1 Then
                OneWeekNewPic = "<img src='/images/New.gif' border=0>"
                 else
                   OneWeekNewPic = ""
                 end if
			LastNews = LastNews & "<td " & RowHeightStr & ">" & NaviPicStr & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetOneNewsLinkURL(RsLastNewsObj("NewsID")) & """ title="""& RsLastNewsObj("Title")&""">" & GetHTMLTitle(RsLastNewsObj("TitleStyle"),GotTopic(RsLastNewsObj("Title"),TitleNumberStr)) & "</a>"&OneWeekNewPic&"</td>" & Chr(13) & Chr(10)
			RsLastNewsObj.MoveNext
			if RsLastNewsObj.Eof then
				Exit For
			end if
		Next
		LastNews = LastNews & "</tr>" & Chr(13) & Chr(10) & CompatPicStr & Chr(13) & Chr(10)
	loop
	Set RsLastNewsObj = Nothing
	LastNews = LastNews & "</table>"
End Function
'推荐新闻
Function RecNews(ClassEName,SoonClassStr,NewNumberStr,TitleNumberStr,RowNumberStr,NaviPicStr,CompatPicStr,OpenTypeStr,CSSStyleStr,RowHeightStr,TxtNaviStr,nei_xStr,nei_zStr,nei_yStr,shijianStr)
	Dim RecNewsSql,RsRecNewsObj,i
	nei_yStr = GetTitleNumberStr(nei_yStr)
	TitleNumberStr = GetTitleNumberStr(TitleNumberStr)
	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
if shijianStr=1 then
if EndClassIDList <> "" then
RecNewsSql = "Select FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and FS_News.DelTF=0 and FS_News.RecTF=1 and FS_News.AuditTF=1 and FS_News.ClassID in(" & EndClassIDList & ") order by FS_News.ID Desc"
else
RecNewsSql = "Select FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and FS_News.DelTF=0 and FS_News.RecTF=1 and FS_News.AuditTF=1 order by FS_News.ID Desc"
end if
elseif shijianStr=0 then
if EndClassIDList <> "" then
RecNewsSql = "Select FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and FS_News.DelTF=0 and FS_News.RecTF=1 and FS_News.AuditTF=1 and FS_News.ClassID in(" & EndClassIDList & ") order by FS_News.AddDate Desc"
else
RecNewsSql = "Select FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and FS_News.DelTF=0 and FS_News.RecTF=1 and FS_News.AuditTF=1 order by FS_News.AddDate Desc"
end if
else

	if EndClassIDList <> "" then
		RecNewsSql = "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 FS_News.DelTF=0 and FS_News.RecTF=1 and FS_News.AuditTF=1 and FS_News.ClassID in(" & EndClassIDList & ") order by FS_News.ID Desc"
	else
		RecNewsSql = "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 FS_News.DelTF=0 and FS_News.RecTF=1 and FS_News.AuditTF=1 order by FS_News.ID Desc"
	end if
	end if


if nei_xStr="1" then 
dim qjsw,qjazhro,z2,aqj
aqj=0
qjsw=0 
i=0
qjazhro=nei_yStr '定义行字节，一个汉字为2个字节,默认44 
RecNews = "" & NaviPicStr & "" & Chr(13) & Chr(10)
else
    RecNews = "<table cellpadding=""0"" cellspacing=""0"" border=""0"" width=""100%"">" & Chr(13) & Chr(10)
	end if
	Set RsRecNewsObj = Conn.Execute(RecNewsSql)
	do while Not RsRecNewsObj.Eof
	if nei_xStr="1" then
dim biaoti

if RsRecNewsObj("SubTitle")<>"" then
biaoti=RsRecNewsObj("SubTitle")
else
biaoti=RsRecNewsObj("Title")
end if 

aqj=aqj+strLen(biaoti) 
qjsw=qjsw+strLen(biaoti)

if qjsw>=qjazhro then
dim t1,z,z1
t1=(qjsw-qjazhro)
z=strLen(biaoti)
z1=(z-t1)

RecNews = RecNews & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetOneNewsLinkURL(RsRecNewsObj("NewsID")) & """ title="""& RsRecNewsObj("Title")&""">" & GetHTMLTitle(RsRecNewsObj("TitleStyle"),GotTopic(biaoti,z1)) & "</a>"
if i<(int(nei_zStr)-1) then RecNews = RecNews & "<br>" & NaviPicStr & "" & Chr(13) & Chr(10)

qjsw=0
i=i+1
else
RecNews = RecNews & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & " href=""" & GetOneNewsLinkURL(RsRecNewsObj("NewsID")) & """ title="""& RsRecNewsObj("Title")&""">" & GetHTMLTitle(RsRecNewsObj("TitleStyle"),biaoti) & "</a>"& Chr(13) & Chr(10)
end if
RsRecNewsObj.movenext
if i=int(nei_zStr) then exit do
else

		RecNews = RecNews & "<tr>" & Chr(13) & Chr(10)
        for i = 1 to RowNumberStr
			RecNews = RecNews & "<td " & RowHeightStr & ">" & NaviPicStr & "<a " & GetCSSStyleStr(CSSStyleStr) & OpenTypeStr & "  href=""" & GetOneNewsLinkURL(RsRecNewsObj("NewsID")) & """ title="""& RsRecNewsObj("Title")&""">" & GetHTMLTitle(RsRecNewsObj("TitleStyle"),GotTopic(RsRecNewsObj("Title"),TitleNumberStr)) & "</a></td>" & Chr(13) & Chr(10)
			RsRecNewsObj.MoveNext
			if RsRecNewsObj.Eof then Exit For
		Next
		RecNews = RecNews & "</tr>" & Chr(13) & Chr(10) & CompatPicStr & Chr(13) & Chr(10)
		end if
	loop
	if nei_xStr="1" then
RecNews = RecNews & ""
else
	Set RsRecNewsObj = Nothing
	end if
	RecNews = RecNews & "</table>"
End Function
function strLen(str)
ON ERROR RESUME NEXT
dim WINNT_CHINESE
WINNT_CHINESE = (len("中国")=2)
if WINNT_CHINESE then
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+65536
if c>255 then
t=t+1
end if
next
strLen=t
else 
strLen=len(str)
end if
if err.number<>0 then err.clear
end function

'滚动新闻
Function MarqueeNews(MarqueeNumberStr,TitleNumberStr,RowNumberStr,MarqueeWidthStr,MarqueeHeightStr,MarqueeSpeedStr,MarqueeTypeStr,DateRuleStr,OpenTypeStr,CSSStyleStr,ClassEName,IsIncludeChildTF)
	Dim MarqueeSql,RsMarqueeObj,i,RikerDirection,ClassSql,RsClassObj,AllClassID
	TitleNumberStr = GetTitleNumberStr(TitleNumberStr)
	If MarqueeTypeStr <> "" and isnull(MarqueeTypeStr)=false then
		RikerDirection = LCase(Cstr(MarqueeTypeStr))
	Else
		RikerDirection = "left"
	End If
	if MarqueeSpeedStr <> "" then MarqueeSpeedStr = " scrollamount=""" & MarqueeSpeedStr & """"
	if MarqueeTypeStr <> "" then MarqueeTypeStr = " direction=""" & MarqueeTypeStr & """"
	if MarqueeWidthStr <> "" then MarqueeWidthStr = " width=""" & MarqueeWidthStr & """"
	if MarqueeHeightStr <> "" then MarqueeHeightStr = " Height=""" & MarqueeHeightStr & """"
	OpenTypeStr = GetOpenTypeStr(OpenTypeStr)
	ClassSql = "Select ClassCName,ClassEName,ClassID,SaveFilePath,FileExtName from FS_NewsClass where ClassEName='" & ClassEName & "'"
	Set RsClassObj = Conn.Execute(ClassSql)
	if Not RsClassObj.Eof then
		if IsIncludeChildTF = "1" then
			AllClassID = "'" & RsClassObj("ClassID") & "'" & ChildClassIDList(RsClassObj("ClassID"))
		else
			AllClassID = "'" & RsClassObj("ClassID") & "'"
		end if
		MarqueeSql = "Select Top " & MarqueeNumberStr & " *,FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and FS_News.MarqueeNews=1 and FS_News.DelTF=0 and FS_News.AuditTF=1 and FS_NewsClass.ClassID in (" & AllClassID & ") order by FS_News.ID Desc"
	else
		MarqueeSql = "Select Top " & MarqueeNumberStr & " *,FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and FS_News.MarqueeNews=1 and FS_News.DelTF=0 and FS_News.AuditTF=1 order by FS_News.ID Desc"
	end if
	Set RsClassObj = Nothing
	Set RsMarqueeObj = Conn.Execute(MarqueeSql)
	MarqueeNews = "<MARQUEE" & MarqueeSpeedStr & MarqueeTypeStr & MarqueeWidthStr & MarqueeHeightStr & " onmouseover=""this.stop();"" onmouseout=""this.start();"">"
	If Cstr(RikerDirection)<>"left" and Cstr(RikerDirection)<>"right" then MarqueeNews = MarqueeNews & "<table cellpadding=""0"" cellspacing=""0"" border=""0"" width=""100%"">" & Chr(13) & Chr(10)
	do while Not RsMarqueeObj.Eof
		If Cstr(RikerDirection)<>"left" and Cstr(RikerDirection)<>"right" then MarqueeNews = MarqueeNews & "<tr>" & Chr(13) & Chr(10)
		Dim OneWeekNewPic
        for i = 1 to RowNumberStr
            if DateDiff("d",RsNewsObj("AddDate"),Now())<1 Then
                OneWeekNewPic = "<img src='/images/New.gif' border=0>"
                 else
                   OneWeekNewPic = ""
                 end if
			if DateRuleStr = "" then
				If Cstr(RikerDirection)<>"left" and Cstr(RikerDirection)<>"right" then
					MarqueeNews = MarqueeNews & "<td><a class=""" & CSSStyleStr & """ href=""" & GetOneNewsLinkURL(RsMarqueeObj("NewsID")) & """ title="""& RsMarqueeObj("Title")&"""" & OpenTypeStr & ">" & GetHTMLTitle(RsMarqueeObj("TitleStyle"),GotTopic(RsMarqueeObj("Title"),TitleNumberStr)) & "</a>"&OneWeekNewPic&"</td>" & Chr(13) & Chr(10)
				Else
					MarqueeNews = MarqueeNews & "<a class=""" & CSSStyleStr & """ href=""" & GetOneNewsLinkURL(RsMarqueeObj("NewsID")) & """ title=""" & RsMarqueeObj("Title") &"""" & OpenTypeStr & ">" & GetHTMLTitle(RsMarqueeObj("TitleStyle"),GotTopi