classmenu.asp

小游戏网站演示www.4399.io 拥有4万条游戏数据

<%
Const Pagesmode =  True
'================================================
'函数名：LoadClassMenu
'作  用：装载分类菜单
'参  数：ChannelID ----频道ID
'================================================
Public Function LoadClassMenu(ByVal ChannelID, ByVal ClassID, ByVal TopNum, _
	ByVal PerRowNum, ByVal Compart, ByVal styles)
	
	Dim Rs, SQL, i, strContent, foundsql
	Dim rsClass, ParentID, Child, TotalNumber
	Dim LinkTarget, HtmlFileUrl, ClassName, strClass
	Dim m_strFileUrl
	
	LoadClassMenu = ""
	ChannelID = Newasp.ChkNumeric(ChannelID)
	ClassID = Newasp.ChkNumeric(ClassID)
	If Not IsNumeric(TopNum) Then Exit Function
	If Not IsNumeric(PerRowNum) Then Exit Function
	If styles <> "0" And styles <> "" Then
		strClass = " class=""" & Trim(styles) & """"
	Else
		strClass = ""
	End If
	Newasp.LoadChannel(ChannelID)
	foundsql = "SELECT TOP " & TopNum & " C.ClassID,C.depth,C.ClassName,C.ColorModes,C.FontModes,C.Readme,C.Child,C.LinkTarget,C.TurnLink,C.TurnLinkUrl,C.HtmlFileDir,C.UseHtml,B.ChannelDir,B.StopChannel,B.IsCreateHtml,B.HtmlExtName,B.SortDestination FROM [NC_Classify] C inner join [NC_Channel] B On C.ChannelID=B.ChannelID WHERE C.ChannelID = " & CLng(ChannelID)
	If CLng(ClassID) > 0 Then
		Set rsClass = Newasp.Execute("SELECT parentid,Child FROM [NC_Classify] WHERE ChannelID = " & CLng(ChannelID) & " And ClassID = " & CLng(ClassID))
		If rsClass.BOF And rsClass.EOF Then
			Exit Function
		Else
			ParentID = rsClass("parentid")
			Child = rsClass("Child")
		End If
		rsClass.Close: Set rsClass = Nothing
		If Child <> 0 Then
			SQL = foundsql & " And C.Parentid = " & CLng(ClassID) & " Order By C.orders,C.ClassID"
		Else
			SQL = foundsql & " And C.Parentid = " & CLng(ParentID) & " Order By C.orders,C.rootid"
		End If
	Else
		'SQL = foundsql & " And C.depth=0 Order By C.rootid,C.ClassID"
		SQL = foundsql & " Order By C.depth,C.rootid,C.ClassID"
	End If
	Set Rs = Server.CreateObject("ADODB.Recordset")
	Rs.Open SQL, Conn, 1, 1
	Newasp.SqlQueryNum = Newasp.SqlQueryNum + 1
	If Rs.BOF And Rs.EOF Then
		Exit Function
	Else
		If Rs("StopChannel") <> 0 Then
			LoadClassMenu = ""
			Exit Function
		End If
		i = 0
		TotalNumber = Rs.RecordCount
		Do While Not Rs.EOF
			i = i + 1
			If Rs("LinkTarget") <> 0 Then
				LinkTarget = " target=""_blank"""
			Else
				LinkTarget = ""
			End If
			ClassName = Newasp.ReadFontMode(Rs("ClassName"), Rs("ColorModes"), Rs("FontModes"))
			If Rs("TurnLink") <> 0 Then
				ClassName = "<a href=""" & Rs("TurnLinkUrl") & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
			Else
				If Rs("IsCreateHtml") <> 0 Then
					m_strFileUrl = Newasp.ChannelDomain & Newasp.ReadDestination(Rs("SortDestination"), Rs("ChannelDir"), "",Rs("HtmlFileDir"),Rs("ClassID"),0,1,"")
					ClassName = "<a href=""" & m_strFileUrl & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
				Else
					If IsURLRewrite Then
						m_strFileUrl = Newasp.ChannelPath & "list_1_" & Rs("ClassID") & Newasp.ChannelHtmlExt
					Else
						m_strFileUrl = Newasp.ChannelPath & "list.asp?classid=" & Rs("ClassID")
					End If
					ClassName = "<a href=""" & m_strFileUrl & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
				End If
			End If
			strContent = strContent & ClassName
			If i Mod CInt(PerRowNum) = 0 Or i = TotalNumber Then
				If i = TotalNumber Then
					strContent = strContent
				Else
					strContent = strContent & "<br>"
				End If
			Else
				strContent = strContent & " " & Compart & " "
			End If
		Rs.MoveNext
		Loop
	End If
	Rs.Close: Set Rs = Nothing
	LoadClassMenu = strContent
End Function
'================================================
'函数名：ReadClassMenu
'作  用：读取分类菜单
'参  数：str ----原字符串
'================================================
Public Function ReadClassMenu(ByVal str)
	Dim strTemp, i
	Dim sTempContent, nTempContent, ArrayList
	Dim arrTempContent, arrTempContents
	
	'--增加专题菜单
	str = ReadSpecialMenu(str)
	strTemp = str
	If InStr(strTemp, "{$ReadClassMenu(") > 0 Then
		sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadClassMenu(", ")}", 1)
		nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadClassMenu(", ")}", 0)
		arrTempContents = Split(sTempContent, "|||")
		arrTempContent = Split(nTempContent, "|||")
		For i = 0 To UBound(arrTempContents)
			ArrayList = Split(arrTempContent(i), ",")
			strTemp = Replace(strTemp, arrTempContents(i), LoadClassMenu(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5)))
		Next
	End If
	ReadClassMenu = strTemp
End Function
'================================================
'函数名：LoadClassMenubar
'作  用：装载分类菜单栏
'参  数：ChannelID ----频道
'================================================

Public Function LoadClassMenubar(ByVal ChannelID, ByVal ClassID, _
	ByVal TopNum, ByVal PerRowNum, ByVal frontstr)
	
	Dim Rs, SQL, i, strContent, foundsql
	Dim rsClass, ParentID, Child, n
	Dim LinkTarget, HtmlFileUrl, ClassName, strClass
	Dim m_strFileUrl
	
	LoadClassMenubar = ""
	ChannelID = Newasp.ChkNumeric(ChannelID)
	ClassID = Newasp.ChkNumeric(ClassID)
	If Not IsNumeric(TopNum) Then Exit Function
	If Not IsNumeric(PerRowNum) Then Exit Function
	If frontstr <> "0" And frontstr <> "" Then
		frontstr = frontstr
	Else
		frontstr = ""
	End If
	Newasp.LoadChannel(ChannelID)
	foundsql = "SELECT TOP " & TopNum & " C.ClassID,C.depth,C.ClassName,C.ColorModes,C.FontModes,C.Readme,C.Child,C.LinkTarget,C.TurnLink,C.TurnLinkUrl,C.HtmlFileDir,C.UseHtml,C.ShowCount,B.ChannelDir,B.StopChannel,B.ModuleName,B.IsCreateHtml,B.HtmlExtName,B.SortDestination FROM [NC_Classify] C INNER JOIN [NC_Channel] B On C.ChannelID=B.ChannelID WHERE C.ChannelID=" & CInt(ChannelID)
	If CLng(ClassID) > 0 Then
		Set rsClass = Newasp.Execute("SELECT parentid,Child FROM [NC_Classify] WHERE ChannelID = " & CInt(ChannelID) & " And ClassID = " & CLng(ClassID))
		If rsClass.BOF And rsClass.EOF Then
			Exit Function
		Else
			ParentID = rsClass("parentid")
			Child = rsClass("Child")
		End If
		rsClass.Close: Set rsClass = Nothing
		If Child <> 0 Then
			SQL = foundsql & " And C.Parentid = " & CLng(ClassID) & " ORDER BY C.orders,C.ClassID"
		Else
			SQL = foundsql & " And C.Parentid = " & CLng(ParentID) & " ORDER BY C.orders,C.rootid"
		End If
	Else
		SQL = foundsql & " And C.depth = 0 ORDER BY C.rootid,C.ClassID"
	End If
	Set Rs = Newasp.Execute(SQL)
	If Rs.BOF And Rs.EOF Then
		Exit Function
	Else
		If Rs("StopChannel") <> 0 Then
			LoadClassMenubar = ""
			Exit Function
		End If
		n = 0
		Do While Not Rs.EOF
			For i = 1 To CInt(PerRowNum)
				n = n + 1
				strContent = strContent & "<li>"
				If Not Rs.EOF Then
					If Rs("LinkTarget") <> 0 Then
						LinkTarget = " target=""_blank"""
					Else
						LinkTarget = ""
					End If
					If Rs("ClassID") = CLng(ClassID) Then
						strClass = " class=""distinct"""
					Else
						strClass = " class=""menubar"""
					End If
					ClassName = Newasp.ReadFontMode(Replace(Rs("ClassName"), " ", "&nbsp;"), Rs("ColorModes"), Rs("FontModes"))
					If Rs("TurnLink") <> 0 Then
						ClassName = "<a href=""" & Rs("TurnLinkUrl") & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
					Else
						If Rs("IsCreateHtml") <> 0 Then
							m_strFileUrl = Newasp.ChannelDomain & Newasp.ReadDestination(Rs("SortDestination"), Rs("ChannelDir"), "",Rs("HtmlFileDir"),Rs("ClassID"),0,1,"")
							ClassName = "<a href=""" & m_strFileUrl & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
						Else
							If IsURLRewrite Then
								m_strFileUrl = Newasp.ChannelPath & "list_1_" & Rs("ClassID") & Newasp.ChannelHtmlExt
							Else
								m_strFileUrl = Newasp.ChannelPath & "list.asp?classid=" & Rs("ClassID")
							End If
							ClassName = "<a href=""" & m_strFileUrl & """" & LinkTarget & strClass & LoadRemark(Rs("Readme")) & ">" & ClassName & "</a>"
						End If
					End If
					strContent = strContent & Replace(frontstr, "*", n) & ClassName
					strContent = strContent & "</li>" & vbCrLf
					Rs.MoveNext
				Else
					strContent = strContent & Replace(frontstr, "*", n) & "<a href=""" & Newasp.InstallDir & "support/sitemap.asp"" class=""menubar"">更多分类</a></li>" & vbCrLf
					Exit Do
				End If
			Next
		Loop
	End If
	Rs.Close: Set Rs = Nothing
	LoadClassMenubar = strContent
End Function
'================================================
'函数名：ReadClassMenubar
'作  用：读取分类菜单栏
'参  数：str ----原字符串
'================================================
Public Function ReadClassMenubar(str)
	Dim strTemp, i
	Dim sTempContent, nTempContent, ArrayList
	Dim arrTempContent, arrTempContents
	
	strTemp = str
	If InStr(strTemp, "{$ReadClassMenubar(") > 0 Then
		sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadClassMenubar(", ")}", 1)
		nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadClassMenubar(", ")}", 0)
		arrTempContents = Split(sTempContent, "|||")
		arrTempContent = Split(nTempContent, "|||")
		For i = 0 To UBound(arrTempContents)
			ArrayList = Split(arrTempContent(i), ",")
			strTemp = Replace(strTemp, arrTempContents(i), LoadClassMenubar(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4)))
		Next
	End If
	ReadClassMenubar = strTemp
End Function
'================================================
'函数名：LoadSpecialMenu
'作  用：专题栏目菜单
'================================================
Function LoadSpecialMenu(ByVal ChannelID, ByVal showother, ByVal maxnum, ByVal frontstr)
	Dim SQL, Rs
	Dim strTemp, SpecialPath,strContext
	Dim LinkTarget,ChannelPath,Topicformat,IsCreateHtml
	Dim Modules,sModuleName,HtmlExtName,strMaxnum
	Dim strChannelDir,strMoreDestination,strChannelDomain
	ChannelID = Newasp.ChkNumeric(ChannelID)
	showother = Newasp.ChkNumeric(showother)
	maxnum = Newasp.ChkNumeric(maxnum)
	If maxnum = 0 Then
		strMaxnum = vbNullString
	Else
		strMaxnum = " TOP " & maxnum
	End If
	If frontstr = "0" Then
		frontstr = vbNullString
	End If
	LoadSpecialMenu = vbNullString
	If ChannelID < 1 Or ChannelID = 4 Then 
		Exit Function
	End If
	'On Error Resume Next
	SQL = "SELECT ChannelID,ChannelDir,StopChannel,ModuleName,Modules,IsCreateHtml,HtmlExtName,MoreDestination,BindDomain,DomainName FROM [NC_Channel] WHERE ChannelID="& ChannelID
	Set Rs = Newasp.Execute(SQL)
	If Rs.BOF And Rs.EOF Then
		Set Rs = Nothing
		Exit Function
	Else
		IsCreateHtml = Rs("IsCreateHtml")
		ChannelPath = Rs("ChannelDir")
		strChannelDir = Rs("ChannelDir")
		Modules = Rs("Modules")
		sModuleName = Rs("ModuleName")
		strMoreDestination = Rs("MoreDestination")
		HtmlExtName = Rs("HtmlExtName")
		If Newasp.IsBindDomain = 0 Then
			If Rs("BindDomain") = "0" Then
				ChannelPath = Newasp.InstallDir & ChannelPath
				strChannelDomain = ""
			Else
				If Rs("ChannelID") = CLng(Newasp.m_intChannelID) Then
					ChannelPath = "/"
					strChannelDomain = "/"
				Else