📄 refreshfunction.asp
字号:
<%
Dim Fun_Refresh_Type,Fun_Refresh_ID,Fun_More_Pages_Obj,Fun_Begin_Time,Fun_End_Time
Sub Set_Fun_Value(Type_Str,ID_Str,Begin_Time_Str,End_Time_Str)
Fun_Refresh_Type = Type_Str
Fun_Refresh_ID = ID_Str
Fun_Begin_Time = Begin_Time_Str
Fun_End_Time = End_Time_Str
Set Fun_More_Pages_Obj = Server.CreateObject(G_FS_DICT)
End Sub
'RSS
Function RSS()
RSS = "<a href=""" & GetConfig(0) & "/rss/main.asp"">RSS</a>"
End Function
'归档新闻列表
Function LableFile(TitleNumberStr,CompatPicStr,NaviPicStr,DateRuleStr,DateRightStr,RowHeightStr,RowNumberStr,ShowClassCNNameStr,CSSStyleStr,OpenTypeStr,DateCSSStyleStr,TxtNaviStr)
if Fun_Refresh_Type <> "Record" then
LableFile = ""
Exit Function
end if
Dim i,RsClassObj,ClassName,TempDateShowStr,RsRecordObj
OpenTypeStr = GetOpenTypeStr(OpenTypeStr)
NaviPicStr = GetNewsNavitionStr(TxtNaviStr,NaviPicStr)
CompatPicStr = GetCompatPicStr(CompatPicStr,DateRightStr,DateRuleStr,RowNumberStr)
if RowHeightStr <> "" then RowHeightStr = " Height=""" & RowHeightStr & """"
LableFile = "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & Chr(13) & Chr(10)
LableFile = LableFile & "<tr><td align=""center"" colspan=""" & RowNumberStr & """><font size=""5""><strong>" & RefreshTime & "归档新闻</strong></font></td></tr>" & Chr(13) & Chr(10)
Set RsRecordObj = RecordConn.Execute("Select * from FS_News where DateDiff('d',FileTime,#" & Fun_Begin_Time & "#)=0 order by ID Desc")
do while Not RsRecordObj.Eof
LableFile = LableFile & "<tr " & RowHeightStr & ">" & Chr(13) & Chr(10)
for i = 1 to RowNumberStr
if DateRuleStr <> "" then
if DateRightStr = "Left" then
TempDateShowStr = " <span " & GetCSSStyleStr(DateCSSStyleStr) & ">" & DateFormat(RsRecordObj("AddDate"),DateRuleStr) & "</span>"
elseif DateRightStr = "Center" then
TempDateShowStr = "<td align=""center""><span " & GetCSSStyleStr(DateCSSStyleStr) & ">" & DateFormat(RsRecordObj("AddDate"),DateRuleStr) & "</span>" & "</td>"& Chr(13) & Chr(10)
elseif DateRightStr = "Right" then
TempDateShowStr = "<td align=""Right""><span " & GetCSSStyleStr(DateCSSStyleStr) & ">" & DateFormat(RsRecordObj("AddDate"),DateRuleStr) & "</span>" & "</td>" & Chr(13) & Chr(10)
else
TempDateShowStr = " <span " & GetCSSStyleStr(DateCSSStyleStr) & ">" & DateFormat(RsRecordObj("AddDate"),DateRuleStr) & "</span>"
end if
else
TempDateShowStr = ""
end if
if ShowClassCNNameStr = "1" then
ClassName = ""
Set RsClassObj = Conn.Execute("Select * from FS_NewsClass where ClassID='" & RsRecordObj("ClassID") & "'")
if Not RsClassObj.Eof then ClassName = "[" & RsClassObj("ClassCName") & "]"
Set RsClassObj = Nothing
end if
if DateRightStr = "Center" Or DateRightStr = "Right" then
LableFile = LableFile & "<td>" & NaviPicStr & ClassName & "<a " & OpenTypeStr & GetCSSStyleStr(CSSStyleStr) & " href=""" & GetRecordOneNewsLink(RsRecordObj) & """ title="""& RsRecordObj("Title")&""">" & GetHTMLTitle(RsRecordObj("TitleStyle"),GotTopic(RsRecordObj("Title"),TitleNumberStr)) & "</a></td>" & TempDateShowStr & Chr(13) & Chr(10)
else
LableFile = LableFile & "<td>" & NaviPicStr & ClassName & "<a " & OpenTypeStr & GetCSSStyleStr(CSSStyleStr) & " href=""" & GetRecordOneNewsLink(RsRecordObj) & """ title="""& RsRecordObj("Title")&""">" & GetHTMLTitle(RsRecordObj("TitleStyle"),GotTopic(RsRecordObj("Title"),TitleNumberStr)) & "</a>" & TempDateShowStr & "</td>" & Chr(13) & Chr(10)
end if
RsRecordObj.MoveNext
if RsRecordObj.Eof then Exit For
Next
LableFile = LableFile & "</tr>" & Chr(13) & Chr(10)
LableFile = LableFile & CompatPicStr
Loop
Set RsRecordObj = Nothing
LableFile = LableFile & "<tr><td height=""50"" align=""center"" colspan=""" & RowNumberStr & """>" & GetRecordSearchForm & "</td></tr>" & Chr(13) & Chr(10)
LableFile = LableFile & "</table>" & Chr(13) & Chr(10)
End Function
Function GetRecordOneNewsLink(Obj)
Dim DoMain,TempParentID,RsParentObj,ReturnValue,RsClassObj,LoopTF
Dim CheckRootClassIndex,CheckRootClassNumber,TempClassSaveFilePath
CheckRootClassNumber = 30
LoopTF = False
ReturnValue = ""
if Obj("HeadNewsTF") = 1 then
ReturnValue = Obj("HeadNewsPath")
else
Set RsClassObj = Conn.Execute("Select * from FS_NewsClass where ClassID='" & Obj("ClassID") & "'")
if Not RsClassObj.Eof then
Set RsParentObj = Conn.Execute("Select ParentID,Domain from FS_NewsClass where ClassID='" & Obj("ClassID") & "'")
TempParentID = RsParentObj("ParentID")
do while Not (TempParentID = "0")
LoopTF = True
CheckRootClassIndex = CheckRootClassIndex + 1
RsParentObj.Close
Set RsParentObj = Nothing
Set RsParentObj = Conn.Execute("Select ParentID,Domain from FS_NewsClass where ClassID='" & TempParentID & "'")
if RsParentObj.Eof then
Set RsParentObj = Nothing
Set RsClassObj = Nothing
GetRecordOneNewsLink = ""
Exit Function
end if
TempParentID = RsParentObj("ParentID")
if CheckRootClassIndex > CheckRootClassNumber then TempParentID = "0" '防止死循环
Loop
if LoopTF = True then
DoMain = RsParentObj("DoMain")
else
DoMain = RsClassObj("DoMain")
end if
Set RsParentObj = Nothing
'=======================
'归档文件是否使用日期路径判断
dim NewsDatePath
if Application(LoginCacheNameStr)(21)="1" then NewsDatePath=Obj("Path") else NewsDatePath=""
if (Not IsNull(DoMain)) And (DoMain <> "") then
ReturnValue = "http://" & DoMain & "/" & RsClassObj("ClassEName")& NewsDatePath & "/" & Obj("FileName") & "." & Obj("FileExtName")
else
if RsClassObj("SaveFilePath") = "/" then
TempClassSaveFilePath = RsClassObj("SaveFilePath")
else
TempClassSaveFilePath = RsClassObj("SaveFilePath") & "/"
end if
ReturnValue = GetConfig(0) & TempClassSaveFilePath & RsClassObj("ClassEName") &NewsDatePath& "/" & Obj("FileName") & "." & Obj("FileExtName")
end if
'=======================
else
ReturnValue = ""
end if
Set RsClassObj = Nothing
end if
GetRecordOneNewsLink = ReturnValue
End Function
'调用大栏目
Function SelfClass(ClassEName,NewsListNumberStr,TitleNumberStr,CompatPicStr,NaviPicStr,DateRuleStr,DateRightStr,RowHeightStr,RowNumberStr,ShowClassCNNameStr,MoreLinkTypeStr,MoreLinkContentStr,CSSStyleStr,OpenTypeStr,DateCSSStyleStr,TxtNaviStr,IsIncludeChildTF)
Dim RsNewsObj,NewsSql,RsClassObj,ClassSql,AllClassID,i,ClassCNName
Dim TempDateShowStr,ReViewStr
TitleNumberStr = GetTitleNumberStr(TitleNumberStr)
OpenTypeStr = GetOpenTypeStr(OpenTypeStr)
NaviPicStr = GetNewsNavitionStr(TxtNaviStr,NaviPicStr)
if RowHeightStr <> "" then RowHeightStr = " Height=""" & RowHeightStr & """"
CompatPicStr = GetCompatPicStr(CompatPicStr,DateRightStr,DateRuleStr,RowNumberStr)
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") & "'" & AllChildClassIDStrList(RsClassObj("ClassID"))
else
AllClassID = "'" & RsClassObj("ClassID") & "'"
end if
NewsSql = "Select top " & NewsListNumberStr & " *,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.AuditTF=1 and FS_News.delTF=0 and FS_NewsClass.ClassID in (" & AllClassID & ") order by FS_News.ID Desc"
SelfClass = "<table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">" & Chr(13) & Chr(10)
Set RsNewsObj = Conn.Execute(NewsSql)
do while Not RsNewsObj.Eof
SelfClass = SelfClass & "<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 RsNewsObj("TitleShowReview")="1" then
ReViewStr=" <a href="""&GetConfig(0)&"/NewsReview.asp?NewsID="&RsNewsObj("NewsID")&""">评论</a>"
Else
ReViewStr=""
End If
if DateRuleStr <> "" then
if DateRightStr = "Left" then
TempDateShowStr = " <span " & GetCSSStyleStr(DateCSSStyleStr) & ">" & DateFormat(RsNewsObj("AddDate"),DateRuleStr) & "</span>"
elseif DateRightStr = "Center" then
TempDateShowStr = "<td align=""center""><span " & GetCSSStyleStr(DateCSSStyleStr) & ">" & DateFormat(RsNewsObj("AddDate"),DateRuleStr) & "</span>" & "</td>"& Chr(13) & Chr(10)
elseif DateRightStr = "Right" then
TempDateShowStr = "<td align=""Right""><span " & GetCSSStyleStr(DateCSSStyleStr) & ">" & DateFormat(RsNewsObj("AddDate"),DateRuleStr) & "</span>" & "</td>" & Chr(13) & Chr(10)
else
TempDateShowStr = " <span " & GetCSSStyleStr(DateCSSStyleStr) & ">" & DateFormat(RsNewsObj("AddDate"),DateRuleStr) & "</span>"
end if
else
TempDateShowStr = ""
end if
if ShowClassCNNameStr = "1" then
ClassCNName = "<a " & OpenTypeStr & GetCSSStyleStr(CSSStyleStr) & " href=""" & GetOneClassLinkURL(RsNewsObj("ClassEName"),RsNewsObj("SaveFilePath"),RsNewsObj("ClassFileExtName")) & """ >[" & GotTopic(RsNewsObj("ClassCName"),TitleNumberStr) & "]</a> "
else
ClassCNName = ""
end if
if DateRightStr = "Center" Or DateRightStr = "Right" then
SelfClass = SelfClass & "<td " & RowHeightStr & ">" & NaviPicStr & ClassCNName & "<a " & OpenTypeStr & GetCSSStyleStr(CSSStyleStr) & " href=""" & GetOneNewsLinkURL(RsNewsObj("NewsID")) & """ title="""& RsNewsObj("Title")&""">" & GetHTMLTitle(RsNewsObj("TitleStyle"),GotTopic(RsNewsObj("Title"),TitleNumberStr)) & "</a>"& OneWeekNewPic & ReViewStr & "</td>" & TempDateShowStr & Chr(13) & Chr(10)
else
SelfClass = SelfClass & "<td " & RowHeightStr & ">" & NaviPicStr & ClassCNName & "<a " & OpenTypeStr & GetCSSStyleStr(CSSStyleStr) & " href=""" & GetOneNewsLinkURL(RsNewsObj("NewsID")) & """ title="""& RsNewsObj("Title")&""">" & GetHTMLTitle(RsNewsObj("TitleStyle"),GotTopic(RsNewsObj("Title"),TitleNumberStr)) & "</a>"& OneWeekNewPic & ReViewStr & TempDateShowStr & "</td>" & Chr(13) & Chr(10)
end if
RsNewsObj.MoveNext
if RsNewsObj.Eof then Exit For
Next
SelfClass = SelfClass & "</tr>" & Chr(13) & Chr(10)
SelfClass = SelfClass & CompatPicStr
Loop
if MoreLinkContentStr <> "" then
if MoreLinkTypeStr = "1" then
MoreLinkContentStr="<a " & OpenTypeStr & GetCSSStyleStr(CSSStyleStr) & " href=""" & GetOneClassLinkURL(RsClassObj("ClassEName"),RsClassObj("SaveFilePath"),RsClassObj("FileExtName")) & """ ><img border=0 src=""" & GetConfig(0) & MoreLinkContentStr & """></a>"
elseif MoreLinkTypeStr = "0" then
MoreLinkContentStr = "<a " & OpenTypeStr & GetCSSStyleStr(CSSStyleStr) & " href=""" & GetOneClassLinkURL(RsClassObj("ClassEName"),RsClassObj("SaveFilePath"),RsClassObj("FileExtName")) & """ >" & MoreLinkContentStr & "</a>"
else
MoreLinkContentStr = ""
end if
if DateRuleStr <> "" then
SelfClass = SelfClass & "<tr><td " & GetRowSpanNumber(DateRuleStr,DateRightStr,RowNumberStr) & " align=""right"">" & MoreLinkContentStr & "</td></tr>" & Chr(13) & Chr(10)
else
SelfClass = SelfClass & "<tr><td align=""right"" " & GetRowSpanNumber(DateRuleStr,DateRightStr,RowNumberStr) & ">" & MoreLinkContentStr & "</td></tr>" & Chr(13) & Chr(10)
end if
end if
SelfClass = SelfClass & "</table>" & Chr(13) & Chr(10)
Set RsNewsObj = Nothing
else
SelfClass = ""
end if
Set RsClassObj = Nothing
End Function
'调用栏目子栏目
Function ChildClassList(ClassNumberStr,NewsNumberStr,CompatPicStr,NaviPicStr,ClassRowHeightStr,NewsRowHeightStr,ClassRowNumberStr,NewsRowNumberStr,DateRuleStr,DateRightStr,TitleNumberStr,MoreLinkTypeStr,MoreLinkContentStr,ClassBGPicStr,CSSStyleStr,OpenTypeStr,DateCSSStyleStr,TxtNaviStr,ClassCSSSTyle)
Dim TempSetNewsRowHeightStr
Dim TempSetNewsNumberStr
Dim TempSetTitleNumberStr
Dim TempSetCompatPicStr
Dim TempSetNaviPicStr
Dim TempSetDateRuleStr
Dim TempSetDateRightStr
Dim TempSetNewsRowNumberStr
Dim TempSetMoreLinkTypeStr
Dim TempSetMoreLinkContentStr
Dim TempSetCSSStyleStr
Dim TempSetOpenTypeStr
Dim TempSetDateCSSStyleStr
Dim TempSetTxtNaviStr
Dim TempClassCSSSTyle
TempSetNewsRowHeightStr = NewsRowHeightStr
If TitleNumberStr <> "" then
TitleNumberStr = Cint(TitleNumberStr)
Else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -