'## Flash 幻灯片 ################################################
Function FilterNewsEx(ClassListStr,NewsNumberStr,TitleNumberStr,CssFileStr,PicWidthStr,PicHeightStr,OpenModeStr,ShowTitleStr,RowSpaceStr)
Dim FilterSql,RsFilterObj,FilterStr,ImagesStr,TxtStr,TxtFirst,ClassSaveFilePath,LinkStr
TitleNumberStr = GetTitleNumberStr(TitleNumberStr)
if ClassListStr <> "" then
  FilterSql = "Select Top " & NewsNumberStr & " *,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.FilterNews=1 and FS_News.AuditTF=1 and FS_NewsClass.ClassEName='" & ClassListStr & "' order by FS_News.ID Desc"
else
  FilterSql = "Select Top " & NewsNumberStr & " *,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.FilterNews=1 and FS_News.AuditTF=1 order by FS_News.ID Desc"
end if
Set RsFilterObj = Conn.Execute(FilterSql)
TxtFirst=""
if not RsFilterObj.Eof then
  Dim Temp_Num
  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
   FilterNews = "至少需要两条幻灯新闻才能正确显示幻灯效果"
   Set RsFilterObj = Nothing
   Exit Function
  End If
  
  do while Not RsFilterObj.Eof
   if RsFilterObj("SaveFilePath") = "/" then
    ClassSaveFilePath = RsFilterObj("SaveFilePath")
   else
    ClassSaveFilePath = RsFilterObj("SaveFilePath") & "/"
   end if
  
   if (Not IsNull(RsFilterObj("PicPath"))) And (RsFilterObj("PicPath") <> "") then
    if ImagesStr = "" then
     If Instr(1,LCase(RsFilterObj("PicPath")),"http://") <> 0 then
      ImagesStr = RsFilterObj("PicPath")
     Else
      ImagesStr = AvailableDoMain  & RsFilterObj("PicPath")
     End If
     TxtStr = GotTopic(RsFilterObj("title"),TitleNumberStr)
     TxtFirst = GetOneNewsLinkURL(RsFilterObj("NewsID"))
     LinkStr =  GetOneNewsLinkURL(RsFilterObj("NewsID"))
    else
     If Instr(1,LCase(RsFilterObj("PicPath")),"http://") <> 0 then
      ImagesStr = ImagesStr &"|"& RsFilterObj("PicPath")
     Else
      ImagesStr = ImagesStr &"|"& AvailableDoMain  & RsFilterObj("PicPath")
     End If
     TxtStr = TxtStr & "|" & GotTopic(RsFilterObj("title"),TitleNumberStr)
     LinkStr = LinkStr & "|" & GetOneNewsLinkURL(RsFilterObj("NewsID"))
    end if
   end if
   RsFilterObj.MoveNext
  loop
  
    FilterStr = "" & vbcrlf
          FilterStr = FilterStr & "var focus_width="& PicWidthStr &";" & vbcrlf
          FilterStr = FilterStr & "var focus_height="& PicHeightStr &";" & vbcrlf
    
    if ShowTitleStr = "1" then
     FilterStr = FilterStr & "var text_height=20;" & vbcrlf
    else
           FilterStr = FilterStr & "var text_height=0;" & vbcrlf
          end if
    
    FilterStr = FilterStr & "var swf_height = focus_height+text_height;" & vbcrlf

          FilterStr = FilterStr & "var pics='"& ImagesStr &"';" & vbcrlf
          FilterStr = FilterStr & "var links='"& LinkStr &"';" & vbcrlf
          
    if ShowTitleStr = "1" then
     FilterStr = FilterStr & "var texts='"& TxtStr &"';" & vbcrlf
    else
     FilterStr = FilterStr & "var texts='';" & vbcrlf
    end if

          FilterStr = FilterStr & "document.write('');" & vbcrlf
          FilterStr = FilterStr & "document.write('');" & vbcrlf
          FilterStr = FilterStr & "document.write('');" & vbcrlf
          FilterStr = FilterStr & "document.write('');" & vbcrlf
          FilterStr = FilterStr & "document.write('');" & vbcrlf
       FilterStr = FilterStr & "document.write('');" & vbcrlf
          FilterStr = FilterStr & "" & vbcrlf
else
  FilterStr="没有幻灯图片"
End if
RsFilterObj.Close
Set RsFilterObj = Nothing
FilterNewsEx = FilterStr
End Function
'###############################################################################################

打开同目录下的 selectfunction.asp 添加如下代码到 case "sitemap" 之前

'############ Flash 幻灯片 ###################    
   Case "filternewsEx"
    if UBound(ParaArray) = 9 then
     GetLableContent = FilterNewsEx(ParaArray(1),ParaArray(2),ParaArray(3),ParaArray(4),ParaArray(5),ParaArray(6),ParaArray(7),ParaArray(8),ParaArray(9))
    else
     GetLableContent = ""
     Exit Function
    end if
   '#############################################

下载这个文件放在根目录下的 images 里
http://lady.33933.net/images/pixviewer.swf

这个Flash的幻灯片就添加好了。
按照原来的方法设置幻灯片 FilterNews
如果需要使用Flash幻灯片时就在 FilterNews 后面加上 Ex 如：FilterNewsEx 就可以了
演示地址：http://lady.33933.net/