flashchannel.asp

网络上经典的图片程序

		SQL = "SELECT Top " & CInt(Newasp.HtmlSetting(1)) & " A.flashid,A.ClassID,A.ColorMode,A.FontMode,A.title,A.AllHits,A.miniature,A.addTime,A.HtmlFileDate,C.HtmlFileDir,C.UseHtml 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 & " And " & strRelated & " ORDER BY A.flashid DESC"
		Set rsRdlated = Newasp.Execute(SQL)
		If rsRdlated.EOF And rsRdlated.BOF Then
			RelatedSoft = ""
			Set rsRdlated = Nothing
			Exit Function
		Else
			i = 0
			Resize = 0
			Do While Not rsRdlated.EOF
				ReDim Preserve ArrayTemp(i + Resize)
				strContent = ArrayTemp(i) & Newasp.HtmlSetting(4)
				strtitle = rsRdlated("title")
				strtitle = Newasp.GotTopic(strtitle, CInt(Newasp.HtmlSetting(2)))
				strtitle = Newasp.ReadFontMode(strtitle, rsRdlated("ColorMode"), rsRdlated("FontMode"))
				If CreateHtml <> 0 Then
					HtmlFileUrl = ChannelRootDir & rsRdlated("HtmlFileDir") & Newasp.ShowDatePath(rsRdlated("HtmlFileDate"), Newasp.HtmlPath)
					HtmlFileName = Newasp.ReadFileName(rsRdlated("HtmlFileDate"), rsRdlated("flashid"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
					FlashUrl = HtmlFileUrl & HtmlFileName
					title = "<a href=" & HtmlFileUrl & HtmlFileName & " title='" & rsRdlated("title") & "'>" & strtitle & "</a>"
				Else
					FlashUrl = "show.asp?id=" & rsRdlated("flashid")
					title = "<a href=show.asp?id=" & rsRdlated("flashid") & " title='" & rsRdlated("title") & "'>" & strtitle & "</a>"
				End If
				If Not IsNull(rsRdlated("miniature")) Then
					strminiature = rsRdlated("miniature")
				End If
				miniatureUrl = Newasp.GetImageUrl(strminiature, Newasp.ChannelDir)
				miniature = Newasp.GetFlashAndPic(miniatureUrl, CInt(Newasp.HtmlSetting(9)), CInt(Newasp.HtmlSetting(10)))
				miniature = "<a href='" & FlashUrl & "' title='" & Rs("title") & "'>" & miniature & "</a>"
				strContent = Replace(strContent, "{$Miniature}", miniature)
				strContent = Replace(strContent, "{$FlashTopic}", title)
				strContent = Replace(strContent, "{$AllHits}", rsRdlated("AllHits"))
				strContent = Replace(strContent, "{$DateTime}", Newasp.ShowDateTime(rsRdlated("addTime"), CInt(Newasp.HtmlSetting(3))))
				ArrayTemp(i) = strContent
				rsRdlated.MoveNext
				i = i + 1
			Loop
		End If
		rsRdlated.Close
		Set rsRdlated = Nothing
		strRearrange = Join(ArrayTemp, vbCrLf)
		RelatedFlash = strRearrange
	End Function
	Private Function PreviewMode(url,modeid)
		PreviewMode = ""
		If Len(url) < 3 Then Exit Function
		Dim strTemp
		Select Case CInt(modeid)
		Case 1
			strTemp = Newasp.HtmlSetting(11)
		Case 2
			strTemp = Newasp.HtmlSetting(12)
		Case 3
			strTemp =  Newasp.HtmlSetting(13)
		Case 4
			strTemp = Newasp.HtmlSetting(14)
		Case 5
			strTemp = Newasp.HtmlSetting(15)
		End Select
		strTemp = Replace(strTemp, "{$ShowUrl}", Rs("showurl"))
		PreviewMode = Replace(strTemp, "{$ShowPlayUrl}", FormatShowUrl(url))
	End Function
	Public Function FormatShowUrl(ByVal url)
		FormatShowUrl = ""
		Dim strUrl
		If IsNull(url) Then Exit Function
		If Len(url) < 3 Then Exit Function
		If Left(url,1) = "/" Then
			FormatShowUrl = Trim(url)
			Exit Function
		End If
		strUrl = Left(url,10)
		If InStr(strUrl, "://") > 0 Then
			FormatShowUrl = Trim(url)
			Exit Function
		End If
		If InStr(strUrl, ":\") > 0 Then
			FormatShowUrl = Trim(url)
			Exit Function
		End If
		FormatShowUrl = ChannelRootDir & Trim(url)
	End Function
	
	'================================================
	'过程名：ReplaceString
	'作  用：替换模板内容
	'================================================
	Private Sub ReplaceString()
		HtmlContent = Replace(HtmlContent, "{$SelectedType}", "")
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = HTML.ReadFlashPic(HtmlContent)
		HtmlContent = HTML.ReadFlashList(HtmlContent)
		HtmlContent = HTML.ReadPopularFlash(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent,"{$FlashIndex}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
	End Sub
	'#############################\\FLASH列表开始//#############################
	'=================================================
	'过程名：BuildFlashList
	'作  用：显示FLASH列表页面
	'=================================================
	Public Sub BuildFlashList()
		If CreateHtml <> 0 Then
			Response.Redirect (ChannelRootDir & "index" & Newasp.HtmlExtName)
			Exit Sub
		Else
			Newasp.PreventInfuse
			If Not IsNumeric(Request("page")) And Len(Request("page")) <> 0 Then
				Response.Write ("错误的系统参数!请输入整数")
				Response.End
			End If
			If Not IsEmpty(Request("page")) And Len(Request("page")) <> 0 Then
				CurrentPage = CLng(Request("page"))
			Else
				CurrentPage = 1
			End If
			classid = Newasp.ChkNumeric(Request("classid"))
			Response.Write LoadFlashList(ClassID, 1)
		End If
	End Sub
	'=================================================
	'过程名：LoadFlashList
	'作  用：载入FLASH列表
	'=================================================
	Public Function LoadFlashList(clsid, n)
		On Error Resume Next
		Dim rsClass
		Dim HtmlFileName,maxparent,strMaxParent
		Dim AdsCode, stopad

		PageType = 1
		
		If Not IsNumeric(clsid) Then Exit Function
		Set rsClass = Newasp.Execute("SELECT ClassID,ClassName,ChildStr,ParentID,ParentStr,Child,skinid,HtmlFileDir,UseHtml,AdsCode,stopad FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & clsid)
		If rsClass.BOF And rsClass.EOF Then
			If CreateHtml = 0 Then
				Response.Write "<meta http-equiv=""refresh"" content=""2;url='/"">" & vbNewLine
				Response.Write "<p align=""center"" style=""font-size: 12px;color: red;"">对不起，该页面发生了错误，无法访问! 系统两秒后自动转到网站首页......</p>" & vbNewLine
			End If
			Set rsClass = Nothing
			Exit Function
		Else
			strClassName = rsClass("ClassName")
			ClassID = rsClass("ClassID")
			ChildStr = rsClass("ChildStr")
			Child = rsClass("Child")
			strFileDir = rsClass("HtmlFileDir")
			ParentID = rsClass("ParentID")
			strParent = rsClass("ParentStr")
			If rsClass("skinid") <> 0 Then
				skinid = rsClass("skinid")
			Else
				skinid = CLng(Newasp.ChannelSkin)
			End If
			AdsCode = rsClass("AdsCode")
			stopad = rsClass("stopad")
		End If
		rsClass.Close: Set rsClass = Nothing

		Newasp.LoadTemplates ChannelID, 2, skinid
		HtmlFilePath = Newasp.InstallDir & Newasp.ChannelDir & strFileDir
		
		HtmlContent = Replace(Newasp.HtmlContent, "|||@@@|||", "")
		'-- 新增分类广告代码
		HtmlContent = AdsReplace(HtmlContent,AdsCode, stopad)
		HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
		HtmlContent = Replace(HtmlContent, "{$ClassID}", ClassID)
		HtmlContent = Replace(HtmlContent, "{$PageTitle}", strClassName)
		HtmlContent = Replace(HtmlContent, "{$FlashIndex}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$strClassName}", strClassName)
		ReplaceContent
		maxparent = Newasp.ChkNumeric(Newasp.HtmlSetting(5))
		maxperpage = CInt(Newasp.HtmlSetting(1))
		strlen = Newasp.ChkNumeric(Newasp.HtmlSetting(9))
		If CLng(CurrentPage) = 0 Then CurrentPage = 1
		TotalNumber = Newasp.Execute("SELECT COUNT(flashid) FROM NC_FlashList WHERE ChannelID = " & ChannelID & " And isAccept > 0 And ClassID in (" & ChildStr & ")")(0)
		If maxparent > 0 And Child > 0 And TotalNumber > maxparent Then
			strMaxParent = " TOP " & maxparent
			TotalNumber = maxparent
		Else
			strMaxParent = ""
		End If
		TotalPageNum = CLng(TotalNumber / maxperpage)  '得到总页数
		If TotalPageNum < TotalNumber / maxperpage Then TotalPageNum = TotalPageNum + 1
		If CurrentPage < 1 Then CurrentPage = 1
		If CurrentPage > TotalPageNum Then CurrentPage = TotalPageNum
		
		Set Rs = CreateObject("ADODB.Recordset")
		SQL = "SELECT" & strMaxParent & " A.flashid,A.ClassID,A.title,A.ColorMode,A.FontMode,A.Introduce,A.filesize,A.Author,A.star,A.miniature,A.UserName,A.addTime,A.AllHits,A.grade,A.HtmlFileDate,A.isBest,C.ClassName,C.ParentID,C.ParentStr,C.skinid,C.HtmlFileDir,C.ChildStr,C.UseHtml FROM [NC_FlashList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.ClassID in (" & ChildStr & ") ORDER BY A.isTop DESC, A.addTime DESC ,A.flashid DESC"
		If isSqlDataBase = 1 Then
			Set Rs = Newasp.Execute(SQL)
		Else
			Rs.Open SQL, Conn, 1, 1
		End If
		If Err.Number <> 0 Then Response.Write "SQL 查询错误"
		If Rs.BOF And Rs.EOF Then
			HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "还没有找到任何" & Newasp.ModuleName & "")
			HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1), "")
			If CreateHtml <> 0 Then
				Newasp.CreatPathEx (HtmlFilePath)
				HtmlFileName = HtmlFilePath & ReadListPageName(ClassID, 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 If
		Else
			TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
			If CreateHtml <> 0 Then
				Call LoadFlashHtmlList(n)
			Else
				Call LoadFlashAspList
			End If
		End If
		Rs.Close: Set Rs = Nothing
		LoadFlashList = HtmlContent
	End Function
	'================================================
	'过程名：ReplaceContent
	'作  用：替换模板内容
	'================================================
	Private Sub ReplaceContent()
		HtmlContent = HTML.ReadCurrentStation(HtmlContent, ChannelID, ClassID, strClassName, ParentID, strParent, strFileDir)
		HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = HTML.ReadNewsPicAndText(HtmlContent)
		HtmlContent = HTML.ReadPopularArticle(HtmlContent)
		HtmlContent = HTML.ReadFlashList(HtmlContent)
		HtmlContent = HTML.ReadFlashPic(HtmlContent)
		HtmlContent = HTML.ReadStatistic(HtmlContent)
		HtmlContent = HTML.ReadPopularFlash(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
	End Sub
	'================================================
	'过程名：LoadFlashHtmlList
	'作  用：装载FLASH列表HTML
	'================================================
	Private Sub LoadFlashHtmlList(n)
		Dim HtmlFileName
		Dim Perownum,ii,w
		
		Perownum = Newasp.ChkNumeric(Newasp.HtmlSetting(4))
		
		If IsNull(TempListContent) Then Exit Sub
		
		Newasp.CreatPathEx (HtmlFilePath)
		For CurrentPage = n To TotalPageNum
			Rs.MoveFirst
			i = 0
			If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
			ListContent = ""
			j = (CurrentPage - 1) * maxperpage + 1
			If Perownum > 1 Then 
				ListContent = Newasp.HtmlSetting(6)
				w = FormatPercent(100 / Perownum / 100,0)
			End If
			
			Do While Not Rs.EOF And i < CInt(maxperpage)
				If Not Response.IsClientConnected Then Response.end
				
				If Perownum > 1 Then
					ListContent = ListContent & "<tr valign=""top"">" & vbCrLf
					For ii = 1 To Perownum
						ListContent = ListContent & "<td width=""" & w & """ class=""Flashlistrow"">"
						If Not Rs.EOF Then
							Call LoadListDetail
							Rs.movenext
							i = i + 1
							j = j + 1
						End If
						ListContent = ListContent & "</td>" & vbCrLf
					Next
					ListContent = ListContent & "</tr>" & vbCrLf
				Else
					Call LoadListDetail
					Rs.MoveNext
					i = i + 1
					j = j + 1
				End If
				
				If i >= maxperpage Then Exit Do
			Loop