flashchannel.asp

网络上经典的图片程序

<!--#include file="ubbcode.asp"-->
<%
Dim NewCloud
Set NewCloud = New FlashChannel_Cls

Class FlashChannel_Cls
	
	Private ChannelID, CreateHtml, IsShowFlush
	Private Rs,SQL,ChannelRootDir,HtmlContent,strIndexName,HtmlFilePath
	private flashid,classid,skinid,strInstallDir
	Private strFileDir, ParentID, strParent, strClassName, ChildStr, Child
	Private maxperpage, TotalNumber, TotalPageNum, CurrentPage, i,j
	private ForbidEssay,ListContent,HtmlTemplate,TempListContent
	Private FoundErr,PageType,keyword,strlen

	Public Property Let Channel(ChanID)
		ChannelID = ChanID
	End Property
	Public Property Let ShowFlush(para)
		IsShowFlush = para
	End Property

	Private Sub Class_Initialize()
		On Error Resume Next
		ChannelID = 5
		PageType = 0
		FoundErr = False
		strlen = 0
	End Sub

	Private Sub Class_Terminate()
		Set HTML = Nothing
	End Sub

	Public Sub MainChannel()
		Newasp.ReadChannel(ChannelID)
		CreateHtml = CInt(Newasp.IsCreateHtml)
		ChannelRootDir = Newasp.InstallDir & Newasp.ChannelDir
		strInstallDir = Newasp.InstallDir
		strIndexName = "<a href=""" & ChannelRootDir & """>" & Newasp.ChannelName & "</a>"
		
	End Sub
	'=================================================
	'过程名：BuildFlashIndex
	'作  用：显示FLASH首页
	'=================================================
	Public Sub BuildFlashIndex()
		On Error Resume Next
		LoadFlashIndex
		If CreateHtml <> 0 Then
			Response.Write "<meta http-equiv=refresh content=0;url=index" & Newasp.HtmlExtName & ">"
		Else
			Response.Write HtmlContent
		End If
	End Sub
	'=================================================
	'过程名：CreateFlashIndex
	'作  用：生成动画首页的HTML
	'=================================================
	Public Sub CreateFlashIndex()
		On Error Resume Next
		LoadFlashIndex
		Dim FilePath
		FilePath = Newasp.InstallDir & Newasp.ChannelDir & "index" & Newasp.HtmlExtName
		Newasp.CreatedTextFile FilePath, HtmlContent
		If IsShowFlush = 1 Then Response.Write "<li style=""font-size: 12px;"">生成" & Newasp.ModuleName & "首页HTML完成... <a href=" & FilePath & " target=_blank>" & Server.MapPath(FilePath) & "</a></li>" & vbNewLine
		Response.Flush
	End Sub
	Private Sub LoadFlashIndex()
		On Error Resume Next
		Newasp.LoadTemplates ChannelID, 1, Newasp.ChannelSkin
		HtmlContent = Newasp.HtmlContent
		HtmlContent = Replace(HtmlContent,"{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent,"{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent,"{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent,"{$PageTitle}", Newasp.ChannelName)
		HtmlContent = Replace(HtmlContent,"{$ModuleName}", Newasp.ModuleName)
		HtmlContent = Replace(HtmlContent,"{$FlashIndex}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
		HtmlContent = HTML.ReadAnnounceContent(HtmlContent,ChannelID)
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = HTML.ReadArticlePic(HtmlContent)
		HtmlContent = HTML.ReadSoftPic(HtmlContent)
		HtmlContent = HTML.ReadSoftList(HtmlContent)
		HtmlContent = HTML.ReadArticleList(HtmlContent)
		HtmlContent = HTML.ReadFlashList(HtmlContent)
		HtmlContent = HTML.ReadFlashPic(HtmlContent)
		HtmlContent = HTML.ReadFlashList(HtmlContent)
		HtmlContent = HTML.ReadFlashPic(HtmlContent)
		HtmlContent = HTML.ReadFriendLink(HtmlContent)
		HtmlContent = HTML.ReadGuestList(HtmlContent)
		HtmlContent = HTML.ReadAnnounceList(HtmlContent)
		HtmlContent = HTML.ReadPopularArticle(HtmlContent)
		HtmlContent = HTML.ReadPopularSoft(HtmlContent)
		HtmlContent = HTML.ReadPopularFlash(HtmlContent)
		HtmlContent = HTML.ReadStatistic(HtmlContent)
		HtmlContent = HTML.ReadUserRank(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent,"{$InstallDir}", Newasp.InstallDir)
		HtmlContent = HtmlContent
	End Sub
	'#############################\\动画信息开始//#############################
	'=================================================
	'过程名：BuildFlashInfo
	'作  用：显示动画详细页面
	'=================================================
	Public Sub BuildFlashInfo()
		If CreateHtml <> 0 Then
			Response.Redirect (ChannelRootDir & "index" & Newasp.HtmlExtName)
			Exit Sub
		Else
			Newasp.PreventInfuse
			flashid = Newasp.ChkNumeric(Request("id"))
			Response.Write LoadFlashInfo(flashid)
		End If
	End Sub
	
	Public Function LoadFlashInfo(flashid)
		On Error Resume Next
		SQL = "SELECT A.*,C.ClassName,C.ParentID,C.ParentStr,C.skinid,C.HtmlFileDir,C.ChildStr,C.UseHtml,C.AdsCode,C.stopad FROM [NC_FlashList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.flashid=" & flashid
		Set Rs = Newasp.Execute(SQL)
		If Rs.BOF And Rs.EOF Then
			LoadFlashInfo = ""
			If CreateHtml = 0 Then
				Response.Write "<meta http-equiv=""refresh"" content=""2;url='/"">" & vbNewLine
				Response.Write "<p align=""center"" style=""font-size: 16px;color: red;"">对不起，该页面发生了错误，无法访问! 系统两秒后自动转到网站首页......</p>" & vbNewLine
			End If
			Set Rs = Nothing
			Exit Function
		End If

		If Rs("skinid") <> 0 Then
			skinid = Rs("skinid")
		Else
			skinid = Newasp.ChannelSkin
		End If
		
		Newasp.LoadTemplates ChannelID, 3, skinid
		HtmlContent = Newasp.HtmlContent
		'-- 新增分类广告代码
		HtmlContent = AdsReplace(HtmlContent,Rs("AdsCode"),Rs("stopad"))
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent, "{$Best}", Rs("isBest"))
		HtmlContent = Replace(HtmlContent, "{$Star}", Newasp.ChkNumeric(Rs("star")))
		HtmlContent = Replace(HtmlContent, "{$DateAndTime}", Rs("addTime"))
		HtmlContent = Replace(HtmlContent, "{$ClassName}", Rs("ClassName"))
		HtmlContent = Replace(HtmlContent, "{$Author}", Newasp.ChkNull(Rs("Author")))
		HtmlContent = Replace(HtmlContent, "{$Describe}", Newasp.ChkNull(Rs("Describe")))
		HtmlContent = Replace(HtmlContent, "{$UserName}", Rs("UserName"))
		HtmlContent = Replace(HtmlContent, "{$Grade}", Rs("grade"))
		HtmlContent = Replace(HtmlContent, "{$IsTop}", Rs("IsTop"))
		HtmlContent = Replace(HtmlContent, "{$FileSize}", ReadFilesize(Rs("filesize")))
		HtmlContent = Replace(HtmlContent, "{$ComeFrom}", ReadComeFrom(Rs("ComeFrom")))
		HtmlContent = Replace(HtmlContent, "{$Introduce}", UbbCode(Rs("Introduce")))
		HtmlContent = Replace(HtmlContent, "{$Display}", PreviewMode(Rs("showurl"),Rs("showmode")))
		HtmlContent = Replace(HtmlContent, "{$ShowThisUrl}", Newasp.ChkNull(Rs("showurl")))
		HtmlContent = Replace(HtmlContent, "{$ShowFullUrl}", FormatShowUrl(Rs("showurl")))
		
		If InStr(HtmlContent, "{$BackFlash}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$BackFlash}", BackFlash(flashid))
		End If
		If InStr(HtmlContent, "{$NextFlash}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$NextFlash}", NextFlash(flashid))
		End If
		If InStr(HtmlContent, "{$FlashComment}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$FlashComment}", FlashComment(Rs("flashid")))
		End If
		If InStr(HtmlContent, "{$RelatedFlash}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$RelatedFlash}", RelatedFlash(Newasp.ChkNull(Rs("Related")), Rs("title"), Rs("flashid")))
		End If
		
		HtmlContent = Replace(HtmlContent, "{$ShowUrl}", Newasp.ChkNull(Rs("showurl")))
		HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
		HtmlContent = Replace(HtmlContent, "{$PageTitle}", Rs("title"))
		HtmlContent = Replace(HtmlContent, "{$ClassID}", Rs("ClassID"))
		HtmlContent = Replace(HtmlContent, "{$FlashTitle}", Rs("title"))
		HtmlContent = Replace(HtmlContent, "{$FlashID}", Rs("flashid"))
		HtmlContent = HTML.ReadCurrentStation(HtmlContent, ChannelID, Rs("ClassID"), Rs("ClassName"), Rs("ParentID"), Rs("ParentStr"), Rs("HtmlFileDir"))
		HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = HTML.ReadFlashPic(HtmlContent)
		HtmlContent = HTML.ReadFlashList(HtmlContent)
		HtmlContent = HTML.ReadPopularFlash(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		If CreateHtml <> 0 Then
			Call CreateFlashInfo
		Else
			LoadFlashInfo = HtmlContent
		End If
		Rs.Close: Set Rs = Nothing
	End Function
	'=================================================
	'过程名：CreateFlashInfo
	'作  用：生成FLASH信息HTML
	'=================================================
	Private Sub CreateFlashInfo()
		Dim HtmlFileName
		HtmlFilePath = Newasp.InstallDir & Newasp.ChannelDir & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.HtmlPath)
		Newasp.CreatPathEx (HtmlFilePath)
		HtmlFileName = HtmlFilePath & Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("flashid"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, CurrentPage)
		Newasp.CreatedTextFile HtmlFileName, HtmlContent
		If IsShowFlush = 1 Then 
			Response.Write "<li style=""font-size: 12px;"">生成" & Newasp.ModuleName & "信息HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
			Response.Flush
		End If
	End Sub
	'=================================================
	'函数名：BackFlash
	'作  用：显示上一动画
	'=================================================
	Private Function BackFlash(flashid)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		On Error Resume Next
		SQL = "SELECT TOP 1 A.flashid,A.ClassID,A.title,A.HtmlFileDate,C.HtmlFileDir FROM [NC_FlashList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.flashid < " & flashid & " ORDER BY A.flashid DESC"
		Set rsContext = Newasp.Execute(SQL)
		If rsContext.EOF And rsContext.BOF Then
			HtmlContent = Replace(HtmlContent, "{$BackUrl}", "")
			BackFlash = "已经没有了"
		Else
			If CreateHtml <> 0 Then
				HtmlFileUrl = ChannelRootDir & rsContext("HtmlFileDir") & Newasp.ShowDatePath(rsContext("HtmlFileDate"), Newasp.HtmlPath)
				HtmlFileName = Newasp.ReadFileName(rsContext("HtmlFileDate"), rsContext("flashid"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
				HtmlContent = Replace(HtmlContent, "{$BackUrl}", HtmlFileUrl & HtmlFileName)
				BackFlash = "<a href=" & HtmlFileUrl & HtmlFileName & ">" & rsContext("title") & "</a>"
			Else
				HtmlContent = Replace(HtmlContent, "{$BackUrl}", "?id=" & rsContext("flashid"))
				BackFlash = "<a href=?id=" & rsContext("flashid") & ">" & rsContext("title") & "</a>"
			End If
		End If
		rsContext.Close
		Set rsContext = Nothing
	End Function
	'=================================================
	'函数名：NextFlash
	'作  用：显示下一动画
	'=================================================
	Private Function NextFlash(flashid)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		On Error Resume Next
		SQL = "SELECT TOP 1 A.flashid,A.ClassID,A.title,A.HtmlFileDate,C.HtmlFileDir FROM [NC_FlashList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.flashid > " & flashid & " ORDER BY A.flashid ASC"
		Set rsContext = Newasp.Execute(SQL)
		If rsContext.EOF And rsContext.BOF Then
			NextFlash = "已经没有了"
			HtmlContent = Replace(HtmlContent, "{$NextUrl}", "")
		Else
			If CreateHtml <> 0 Then
				HtmlFileUrl = ChannelRootDir & rsContext("HtmlFileDir") & Newasp.ShowDatePath(rsContext("HtmlFileDate"), Newasp.HtmlPath)
				HtmlFileName = Newasp.ReadFileName(rsContext("HtmlFileDate"), rsContext("flashid"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
				HtmlContent = Replace(HtmlContent, "{$NextUrl}", HtmlFileUrl & HtmlFileName)
				NextFlash = "<a href=" & HtmlFileUrl & HtmlFileName & ">" & rsContext("title") & "</a>"
			Else
				HtmlContent = Replace(HtmlContent, "{$NextUrl}", "?id=" & rsContext("flashid"))
				NextFlash = "<a href=?id=" & rsContext("flashid") & ">" & rsContext("title") & "</a>"
			End If
		End If
		rsContext.Close
		Set rsContext = Nothing
	End Function
	'=================================================
	'函数名：RelatedFlash
	'作  用：显示相关FLASH
	'参  数：sRelated ----相关FLASH
	'=================================================
	Private Function RelatedFlash(sRelated, topic, flashid)
		Dim rsRdlated, SQL, HtmlFileUrl, HtmlFileName
		Dim strtitle, title, strContent
		Dim strRelated, arrRelated, i, Resize, strRearrange
		Dim strKey,FlashUrl,miniatureUrl,miniature,strminiature
		Dim ArrayTemp()
		
		On Error Resume Next
		strRelated = Replace(Replace(Replace(Replace(sRelated, "[", ""), "]", ""), "'", ""), "%", "")
		strKey = Left(Newasp.ChkQueryStr(topic), 5)
		If Not IsNull(sRelated) And sRelated <> Empty Then
			If InStr(strRelated, "|") > 1 Then
				arrRelated = Split(strRelated, "|")
				strRelated = "((A.title like '%" & arrRelated(0) & "%')"
				For i = 1 To UBound(arrRelated)
					strRelated = strRelated & " Or (A.title like '%" & arrRelated(i) & "%')"
				Next
				'strRelated = strRelated & ")"
			Else
				strRelated = "((A.title like '%" & strRelated & "%')"
			End If
			strRelated = strRelated & " Or (A.title like '%" & strKey & "%'))"
		Else
			strRelated = "(A.title like '%" & strKey & "%')"
		End If