flashchannel.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 1,498 行 · 第 1/5 页

			
			For i = 0 To UBound(arrTempContents)
				strLen = Newasp.ChkNumeric(arrTempContent(i))
				If strLen > 0 Then
					strTemp = Replace(strTemp, arrTempContents(i), Newasp.CutString(strIntro,strLen))
				Else
					strTemp = Replace(strTemp, arrTempContents(i), ChkDescription(strIntro))
				End If
			Next
		End If
		GetDescription = strTemp
	End Function
	Public Function ChkDescription(ByVal str)
		Dim re,strHtml
		strHtml = str
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		re.Pattern = "\[br\]"
		strHtml = re.Replace(strHtml, "")
		re.Pattern = "\[align=right\](.*)\[\/align\]"
		strHtml = re.Replace(strHtml, "")
		re.Pattern = "([\f\n\r\t\v])"
		strHtml = re.Replace(strHtml, "")
		re.Pattern = "<(.[^>]*)>"
		strHtml = re.Replace(strHtml, "")
		Set re = Nothing
		strHtml = Replace(strHtml, "&nbsp;", "")
		strHtml = Replace(strHtml, "====", "")
		strHtml = Replace(strHtml, "----", "")
		strHtml = Replace(strHtml, "////", "")
		strHtml = Replace(strHtml, "\\\\", "")
		strHtml = Replace(strHtml, "####", "")
		strHtml = Replace(strHtml, "@@@@", "")
		strHtml = Replace(strHtml, "****", "")
		strHtml = Replace(strHtml, "~~~~", "")
		strHtml = Replace(strHtml, "≡≡≡", "")
		strHtml = Replace(strHtml, "++++", "")
		strHtml = Replace(strHtml, "::::", "")
		strHtml = Replace(strHtml, Chr(34), "&quot;")
		strHtml = Replace(strHtml, Chr(39), "&#39;")
		strHtml = Replace(strHtml, "[InstallDir_ChannelDir]", "")
		strHtml = Replace(strHtml, "[NextPage]", "")
		strHtml = Replace(strHtml, "[Page_Break]", "")
		ChkDescription = strHtml
	End Function
	'=================================================
	'函数名：BackFlash
	'作  用：显示上一动画
	'=================================================
	Private Function BackFlash(flashid)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		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 = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsContext("HtmlFileDate"),rsContext("HtmlFileDir"),rsContext("ClassID"),rsContext("flashid"),1,"")
			Else
				If IsURLRewrite Then
					HtmlFileUrl = rsContext("flashid") & Newasp.HtmlExtName
				Else
					HtmlFileUrl = "?id=" & rsContext("flashid")
				End If
			End If
			HtmlContent = Replace(HtmlContent, "{$BackUrl}", HtmlFileUrl)
			BackFlash = "<a href=""" & HtmlFileUrl & """>" & rsContext("title") & "</a>"
		End If
		rsContext.Close
		Set rsContext = Nothing
	End Function
	'=================================================
	'函数名：NextFlash
	'作  用：显示下一动画
	'=================================================
	Private Function NextFlash(flashid)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		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 = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsContext("HtmlFileDate"),rsContext("HtmlFileDir"),rsContext("ClassID"),rsContext("flashid"),1,"")
			Else
				If IsURLRewrite Then
					HtmlFileUrl = rsContext("flashid") & Newasp.HtmlExtName
				Else
					HtmlFileUrl = "?id=" & rsContext("flashid")
				End If
			End If
			HtmlContent = Replace(HtmlContent, "{$NextUrl}", HtmlFileUrl)
			NextFlash = "<a href=""" & HtmlFileUrl & """>" & rsContext("title") & "</a>"
		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()
		
		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
		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
			RelatedFlash = ""
			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 = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsRdlated("HtmlFileDate"),rsRdlated("HtmlFileDir"),rsRdlated("ClassID"),rsRdlated("flashid"),1,"")
				Else
					If IsURLRewrite Then
						HtmlFileUrl = rsRdlated("flashid") & Newasp.HtmlExtName
					Else
						HtmlFileUrl = "show.asp?id=" & rsRdlated("flashid")
					End If
				End If
				FlashUrl = HtmlFileUrl
				title = "<a href=""" & FlashUrl & """" & LoadRemark(rsRdlated("title")) & ">" & strtitle & "</a>"
				If Not IsNull(rsRdlated("miniature")) Then
					strminiature = rsRdlated("miniature")
				End If
				miniatureUrl = Newasp.GetImageUrl(strminiature, ChannelRootDir)
				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"))
		strTemp = Replace(strTemp, "{$HtmlFileDate}", rs("HtmlFileDate"))
		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 = HTML.ReadArticlePic(HtmlContent)
		HtmlContent = HTML.ReadSoftPic(HtmlContent)
		HtmlContent = HTML.ReadArticleList(HtmlContent)
		HtmlContent = HTML.ReadSoftList(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent,"{$FlashIndex}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent,"{$ArticleID}", rs("flashid"))
	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)
		Dim rsClass
		Dim HtmlFileName,maxparent,strMaxParent
		Dim AdsCode, stopad,m_strFilePath

		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 = Newasp.ChkNumeric(Newasp.ChannelSkin)
			End If
			AdsCode = rsClass("AdsCode")
			stopad = rsClass("stopad")
		End If
		rsClass.Close: Set rsClass = Nothing