修改二:\FS_InterFace\NS_Public.asp
case "norfilt"
if ubound(f_array)<>9
and ubound(f_array)<>10 then:get_LableChar="标签错误,by Foosun.cn":else:get_LableChar=NorFilter(f_Lablechar,"NorFilt",f_Id):end if
修改三:同上页
'轮换幻灯______edit by newstar QQ:228770305
Public Function NorFilter(f_Lablechar,f_type,f_id)
dim FilterSql,RsFilterObj,FilterStr,ImagesStr,TxtStr,TxtFirst,ClassSaveFilePath,LinkStr,CssFileStr
Dim PicWidthStr, PicHeightStr,ChildClassTF,AllClassIDStr,Str_target
dim fltheightstr,fltwidthstr,Temp_Num,TitleNumberStr,NewsNumberStr,ClassId,InSQL_Search,str_filt,str_Opentype
dim str_Num 'edit by newstar QQ:228770305 TitleNumberStr= split(split(f_Lablechar,"┆")(3),"$")(1)
NewsNumberStr= split(split(f_Lablechar,"┆")(2),"$")(1)
ChildClassTF = split(split(f_Lablechar,"┆")(8),"$")(1)
str_Opentype = split(split(f_Lablechar,"┆")(9),"$")(1)
str_Num = split(split(f_Lablechar,"┆")(10),"$")(1)
if trim(NewsNumberStr)<>"" and isNumeric(NewsNumberStr) then
NewsNumberStr = cint(NewsNumberStr)
else
NewsNumberStr = 6
end if
If ChildClassTF = "" Or Not IsNumeric(ChildClassTF) Then
ChildClassTF = 0
Else
ChildClassTF = Cint(ChildClassTF)
End If
ClassId=split(split(f_Lablechar,"┆")(1),"$")(1)
if trim(ClassId)<>"" then
If ChildClassTF = 1 Then
AllClassIDStr = get_SubClass(ClassId)
InSQL_Search = " and ClassId in('" & AllClassIDStr & "')"
Else
InSQL_Search = " and ClassId='"& ClassId &"'"
End if
else
if f_Id <> "" then
InSQL_Search = " and ClassId='"& f_Id &"'"
else
InSQL_Search = ""
end if
end if
str_filt=" and "& all_substring &"(NewsProperty,21,1)='1'"
FilterSql="select top "& NewsNumberStr &" ID,NewsId,PopId,ClassID,SpecialEName,NewsTitle,CurtTitle,NewsNaviContent,isShowReview,TitleColor,titleBorder,TitleItalic,IsURL,URLAddress"
FilterSql = FilterSql &",Content,isPicNews,NewsPicFile,NewsSmallPicFile,isPop,Source,Editor,Keywords,Author,Hits,SaveNewsPath,FileName,FileExtName,NewsProperty,isLock,addtime,TodayNewsPic "
FilterSql = FilterSql &"From FS_NS_News where 1=1 and isPicNews=1 "&InSQL_Search & str_filt &" and isRecyle=0 and isdraft=0 order by addtime desc,id desc"
Set RsFilterObj = Conn.Execute(FilterSql)
'response.Write(FilterSql)
'response.end
if not RsFilterObj.Eof then
Temp_Num = 0
Do While Not RsFilterObj.Eof
Temp_Num = Temp_Num + 1
RsFilterObj.MoveNext
Loop
RsFilterObj.MoveFirst
If Temp_Num <=1 then
Set RsFilterObj = Nothing
FilterStr = "至少需要两条幻灯新闻才能正确显示幻灯效果"
Set RsFilterObj = Nothing
Exit Function
End If
fltheightstr = split(split(split(f_Lablechar,"┆")(4),"$")(1),",")(0)
fltwidthstr = split(split(split(f_Lablechar,"┆")(4),"$")(1),",")(1)
CssFileStr = split(split(f_Lablechar,"┆")(5),"$")(1)
PicWidthStr = " width=""" & fltwidthstr & """"
PicHeightStr = " height=""" & fltheightstr & """"
if CssFileStr <> "" then CssFileStr = " Class='" & CssFileStr & "'"
do while Not RsFilterObj.Eof
if (Not IsNull(RsFilterObj("NewsSmallPicFile"))) And (RsFilterObj("NewsSmallPicFile") <> "") then
if ImagesStr = "" then
If Instr(1,LCase(RsFilterObj("NewsSmallPicFile")),"http://") <> 0 then
ImagesStr = RsFilterObj("NewsSmallPicFile")
Else
ImagesStr = RsFilterObj("NewsSmallPicFile")
End If
If str_Opentype="1" Then
TxtStr = "<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "' target='_blank'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
TxtFirst = "<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "' target='_blank'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
Else
TxtStr = "<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
TxtFirst = "<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
End If
LinkStr = get_NewsLink(RsFilterObj("NewsID"))
else
ImagesStr = ImagesStr &","& RsFilterObj("NewsSmallPicFile")
If str_Opentype="1" Then
TxtStr = TxtStr &",<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "' target='_blank'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
Else
TxtStr = TxtStr &",<a " & CssFileStr & " href='" & get_NewsLink(RsFilterObj("NewsID")) & "'>" & GotTopic(RsFilterObj("NewsTitle"),TitleNumberStr)&"</a>"
End If
LinkStr = LinkStr & ","& get_NewsLink(RsFilterObj("NewsID"))
end if
end if
RsFilterObj.MoveNext
loop
FilterStr="<script language=""vbscript"">"& Chr(13)
FilterStr = FilterStr & "Dim FileList
"&str_Num&",FileListArr
"&str_Num&",TxtList
"&str_Num&",TxtListArr"&
str_Num&",LinkList"&
str_Num&",LinkArr"&str_Num&""& Chr(13)
FilterStr = FilterStr & "FileList"&
str_Num&" = """ & ImagesStr & """"& Chr(13)
FilterStr = FilterStr & "LinkList"&
str_Num&" = """ & LinkStr & """"& Chr(13)
FilterStr = FilterStr & "TxtList"&
str_Num&" = """ & TxtStr & """"& Chr(13)
FilterStr = FilterStr & "FileListArr"&
str_Num&" = Split(FileList"&
str_Num&","","")"& Chr(13)
FilterStr = FilterStr & "LinkArr"&
str_Num&" = Split(LinkList"&
str_Num&","","")"& Chr(13)
FilterStr = FilterStr & "TxtListArr"&
str_Num&" = Split(TxtList"&
str_Num&","","")"& Chr(13)
FilterStr = FilterStr & "Dim CanPlay"&
str_Num&""& Chr(13)
FilterStr = FilterStr & "CanPlay"&
str_Num&" = CInt(Split(Split(navigator.appVersion,"";"")(1),"" "")(2))>5"& Chr(13)
FilterStr = FilterStr & "Dim FilterStr"&
str_Num&""& Chr(13)
FilterStr = FilterStr & "FilterStr"&
str_Num&" = ""RevealTrans(duration=2,transition=23)"""& Chr(13)
FilterStr = FilterStr & "FilterStr"&
str_Num&" = FilterStr"&
str_Num&" + "";BlendTrans(duration=2)"""& Chr(13)
FilterStr = FilterStr & "If CanPlay"&
str_Num&" Then"& Chr(13)
FilterStr = FilterStr & "FilterStr"&
str_Num&" = FilterStr"&
str_Num&" + "";progid:DXImageTransform.Microsoft.Fade(duration=2,overlap=0)"""& Chr(13)
FilterStr = FilterStr & "FilterStr"&
str_Num&" = FilterStr"&
str_Num&" + "";progid:DXImageTransform.Microsoft.Wipe(duration=3,gradientsize=0.25,motion=reverse)"""& Chr(13)
FilterStr = FilterStr & "Else"& Chr(13)
FilterStr = FilterStr & "Msgbox ""幻灯片播放具有多种动态图片切换效果,但此功能需要您的浏览器为IE5.5或以上版本,否则您将只能看到部分的切换效果。"",64"& Chr(13)
FilterStr = FilterStr & "End If"& Chr(13)
FilterStr = FilterStr & "Dim FilterArr"&
str_Num&""& Chr(13)
FilterStr = FilterStr & "FilterArr"&
str_Num&" = Split(FilterStr"&
str_Num&","";"")"& Chr(13)
FilterStr = FilterStr & "Dim PlayImg_M"&
str_Num&""& Chr(13)
FilterStr = FilterStr & "PlayImg_M"&
str_Num&" = 5 * 1000 "& Chr(13)
FilterStr = FilterStr & "Dim I"&
str_Num&""& Chr(13)
FilterStr = FilterStr & "I"&
str_Num&" = 1"& Chr(13)
FilterStr = FilterStr & "Sub ChangeImg"&
str_Num&""& Chr(13)
FilterStr = FilterStr & "Do While FileListArr"&
str_Num&"(I"&
str_Num&")="""""& Chr(13)
FilterStr = FilterStr & "I"&
str_Num&" = I"&str_Num&" + 1"& Chr(13)
FilterStr = FilterStr & "If I"&
str_Num&">UBound(FileListArr"&
str_Num&") Then I"&
str_Num&" = 0"& Chr(13)
FilterStr = FilterStr & "Loop"& Chr(13)
FilterStr = FilterStr & "Dim J"&
str_Num&""& Chr(13)
FilterStr = FilterStr & "If I"&
str_Num&">UBound(FileListArr"&
str_Num&") Then I"&
str_Num&" = 0"& Chr(13)
FilterStr = FilterStr & "Randomize"& Chr(13)
FilterStr = FilterStr & "J"&
str_Num&" = Int(Rnd * (UBound(FilterArr"&
str_Num&")+1))"& Chr(13)
FilterStr = FilterStr & "Img"&
str_Num&".style.filter = FilterArr"&
str_Num&"(J"&
str_Num&")"& Chr(13)
FilterStr = FilterStr & "Img"&
str_Num&".filters(0).Apply"& Chr(13)
FilterStr = FilterStr & "Img"&
str_Num&".Src = FileListArr"&
str_Num&"(I"&
str_Num&")"& Chr(13)
FilterStr = FilterStr & "Img"&
str_Num&".filters(0).play"& Chr(13)
FilterStr = FilterStr & "Link"&
str_Num&".Href = LinkArr"&
str_Num&"(I"&
str_Num&")"& Chr(13)
If split(split(f_Lablechar,"┆")(7),"$")(1) = "1" Then
FilterStr = FilterStr & "Txt"&
str_Num&".filters(0).Apply"& Chr(13)
FilterStr = FilterStr & "Txt"&
str_Num&".innerHTML = TxtListArr"&
str_Num&"(I"&
str_Num&")"& Chr(13)
FilterStr = FilterStr & "Txt"&
str_Num&".filters(0).play"& Chr(13)
End If
FilterStr = FilterStr & "I"&
str_Num&" = I"&
str_Num&" + 1"& Chr(13)
FilterStr = FilterStr & "If I"&
str_Num&">UBound(FileListArr"&
str_Num&") Then I"&
str_Num&" = 0"& Chr(13)
FilterStr = FilterStr & "TempImg"&
str_Num&".Src = FileListArr"&
str_Num&"(I"&
str_Num&")"& Chr(13)
FilterStr = FilterStr & "TempLink"&
str_Num&".Href = LinkArr"&
str_Num&"(I"&
str_Num&")"& Chr(13)
FilterStr = FilterStr & "SetTimeout ""ChangeImg"&
str_Num&""", PlayImg_M"&
str_Num&",""VBScript"""& Chr(13)
FilterStr = FilterStr & "End Sub"& Chr(13)
FilterStr = FilterStr & "</SCRIPT>"& Chr(13)
FilterStr = FilterStr & "<TABLE WIDTH=""100%"" height=""100%"" BORDER=""0"" CELLSPACING="""" CELLPADDING=""0"">" &vbcrlf
FilterStr = FilterStr & "<TR ID=""NoScript"&
str_Num&""">"&vbcrlf
FilterStr = FilterStr & "<TD Align=""Center"" Style=""Color:White"">对不起,图片浏览功能需脚本支持,但您的浏览器已经设置了禁止脚本运行。请您在浏览器设置中调整有关安全选项。</TD>"&vbcrlf
FilterStr = FilterStr & "</TR>"&vbcrlf
If str_Opentype="1" Then
Str_target = " target='_blank'"
Else
Str_target = ""
End If
FilterStr = FilterStr & "<TR Style=""Display:none"" ID=""CanRunScript"&
str_Num&"""><TD HEIGHT=""100%"" Align=""Center"" vAlign=""Center""><a id=""Link"&
str_Num&""""&Str_target&"><Img ID=""Img"&
str_Num&"""" & PicWidthStr & PicHeightStr & " Border=""0"" ></a>"&vbcrlf
FilterStr = FilterStr & "</TD></TR><TR Style=""Display:none""><TD><a id=TempLink"&
str_Num&" ><Img ID=""TempImg"&
str_Num&""" Border=""0""></a></TD></TR>"&vbcrlf
If split(split(f_Lablechar,"┆")(7),"$")(1) = "1" Then
FilterStr = FilterStr & "<TR><TD HEIGHT=""100%"" Align=""Center"" vAlign=""Top"">"&vbcrlf
FilterStr = FilterStr & "<div ID=""Txt"&
str_Num&""" style=""PADDING-LEFT: 5px; Z-INDEX: 1; FILTER: progid:DXImageTransform.Microsoft.Fade(duration=1,overlap=0); POSITION:"">"&TxtFirst&"</div>"
FilterStr = FilterStr & "</TD></TR>"&vbcrlf
End If
FilterStr = FilterStr & "</TABLE>"& Chr(13)
FilterStr = FilterStr & "<Script Language=""VBScript"">"& Chr(13)
FilterStr = FilterStr & "NoScript"&
str_Num&".Style.Display = ""none"""& Chr(13)
FilterStr = FilterStr & "CanRunScript"&
str_Num&".Style.Display = """""& Chr(13)
FilterStr = FilterStr & "Img"&
str_Num&".Src = FileListArr"&
str_Num&"(0)"& Chr(13)
FilterStr = FilterStr & "Link"&
str_Num&".Href = LinkArr"&
str_Num&"(0)"& Chr(13)
FilterStr = FilterStr & "SetTimeout ""ChangeImg"&
str_Num&""", PlayImg_M"&
str_Num&",""VBScript"""& Chr(13)
FilterStr = FilterStr & "</Script>"& Chr(13)
else
FilterStr="没有幻灯图片"
End if
RsFilterObj.Close
Set RsFilterObj = Nothing
NorFilter = FilterStr
End Function
红色为大体标注!^&^