classmenu.asp

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

					ChannelPath = Trim(Rs("DomainName")) & ""
					strChannelDomain = Trim(Rs("DomainName")) & ""
				End If
			End If
		Else
			If Rs("BindDomain") = "0" Then
				ChannelPath = Trim(Newasp.SiteUrl) & "/" & ChannelPath
				strChannelDomain = Trim(Newasp.SiteUrl) & ""
			Else
				If Rs("ChannelID") = CLng(Newasp.m_intChannelID) Then
					ChannelPath = "/"
					strChannelDomain = ""
				Else
					ChannelPath = Trim(Rs("DomainName")) & ""
					strChannelDomain = Trim(Rs("DomainName")) & ""
				End If
			End If
		End If

	End If
	Set Rs = Nothing

	SQL = "SELECT" & strMaxnum & " SpecialID,SpecialName,Topicformat,Readme,Reopen,SpecialDir,ChangeLink,SpecialUrl FROM [NC_Special] WHERE ChannelID="& ChannelID &" ORDER BY orders,SpecialID"
	Set Rs = Newasp.Execute(SQL)
	Do While Not Rs.EOF
		If Rs("Reopen") <> 0 Then
			LinkTarget = " target=""_blank"""
		Else
			LinkTarget = ""
		End If
		If Rs("ChangeLink") <> 0 Then
			'如果此专题是外部连接启用此连接URL
			SpecialPath = Rs("SpecialUrl")
		Else
			If IsCreateHtml <> 0 Then
				SpecialPath = strChannelDomain & Newasp.ReadDestination(strMoreDestination, strChannelDir, "",Rs("SpecialDir")&"/",Rs("SpecialID"),Rs("SpecialID"),1,"special")
				SpecialPath = Replace(SpecialPath, "//", "/")
			Else
				SpecialPath = ChannelPath & "special.asp?sid=" & Rs("SpecialID")
			End If
		End If
		Topicformat = Rs("Topicformat") & ""
		If Len(Topicformat) = 0 Then
			Topicformat = Rs("SpecialName")
		Else
			Topicformat = "<span " & Topicformat & ">" & Rs("SpecialName") & "</span>"
		End If
		'显示JS文件的格式
		strTemp = strTemp & "<li>" & frontstr & "<a href=""" & SpecialPath & """" & LinkTarget & LoadRemark(Rs("Readme")) & ">" & Topicformat & "</a></li>" & vbCrLf
		Rs.movenext
	Loop
	Rs.Close
	Set Rs = Nothing
	'---------------------------------------------//Begin
	'热门和推荐菜单连接开始,如果不需要请注释掉此段代码
	Dim ArrayModuleName(3)
	ArrayModuleName(0) = "推荐" & sModuleName
	ArrayModuleName(1) = "热门" & sModuleName
	ArrayModuleName(2) = "最新" & sModuleName
	ArrayModuleName(3) = "全部更新"
	If showother <> 0 Then
		If IsCreateHtml <> 0 Then
			Dim strPathArray(3)
			strPathArray(0) = Newasp.ReadDestination(strMoreDestination, strChannelDir, "","best/",1,1,1,"best")
			strPathArray(1) = Newasp.ReadDestination(strMoreDestination, strChannelDir, "","hot/",3,3,1,"hot")
			strPathArray(2) = Newasp.ReadDestination(strMoreDestination, strChannelDir, "","new/",0,0,1,"new")
			strPathArray(0) = Replace(strChannelDomain & strPathArray(0), "//", "/")
			strPathArray(1) = Replace(strChannelDomain & strPathArray(1), "//", "/")
			strPathArray(2) = Replace(strChannelDomain & strPathArray(2), "//", "/")
			strTemp = strTemp & "<li>" & frontstr & "<a href=""" & strPathArray(0) & """>" & ArrayModuleName(0) & "</a></li>" & vbCrLf
			strTemp = strTemp & "<li>" & frontstr & "<a href=""" & strPathArray(1) & """>" & ArrayModuleName(1) & "</a></li>" & vbCrLf
			strTemp = strTemp & "<li>" & frontstr & "<a href=""" & strPathArray(2) & """>" & ArrayModuleName(2) & "</a></li>" & vbCrLf
		Else
			strTemp = strTemp & "<li>" & frontstr & "<a href=""" & ChannelPath & "showbest.asp"">" & ArrayModuleName(0) & "</a></li>" & vbCrLf
			strTemp = strTemp & "<li>" & frontstr & "<a href=""" & ChannelPath & "showhot.asp"">" & ArrayModuleName(1) & "</a></li>" & vbCrLf
			strTemp = strTemp & "<li>" & frontstr & "<a href=""" & ChannelPath & "shownew.asp"">" & ArrayModuleName(2) & "</a></li>" & vbCrLf
		End If
		If Modules = 2 Then
			strTemp = strTemp & "<li>" & frontstr & "<a href=""" & ChannelPath & "showtype.asp"">" & ArrayModuleName(3) & "</a></li>" & vbCrLf
		End If
	End If
	LoadSpecialMenu = strTemp
End Function
'================================================
'函数名：ReadClassMenubar
'作  用：读取专题菜单
'参  数：str ----原字符串
'================================================
Public Function ReadSpecialMenu(str)
	Dim strTemp, i
	Dim sTempContent, nTempContent, ArrayList
	Dim arrTempContent, arrTempContents
	
	strTemp = str
	If InStr(strTemp, "{$ReadSpecialMenu(") > 0 Then
		sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadSpecialMenu(", ")}", 1)
		nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadSpecialMenu(", ")}", 0)
		arrTempContents = Split(sTempContent, "|||")
		arrTempContent = Split(nTempContent, "|||")
		For i = 0 To UBound(arrTempContents)
			ArrayList = Split(arrTempContent(i) & ",0,0,0", ",")
			strTemp = Replace(strTemp, arrTempContents(i), LoadSpecialMenu(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3)))
		Next
	End If
	ReadSpecialMenu = strTemp
End Function
Public Sub isWeb_Query()
	Dim keyword
	keyword = Replace(Request("keyword"), "'", "")
	
	Response.Write "<div id=""Seardata"" style=""height:500px;"">"
	Response.Write "<iframe name=""WebSearch"" id=""WebSearch"" frameborder=""0"" width=""100%"" height=""100%"" scrolling=""auto"" src=""http://so.newasp.net/search.asp?word="&keyword&"""></iframe>"
	Response.Write "</div>"
	Response.Write "<script language=""JavaScript"">" & vbNewLine
	Response.Write "<!--" & vbNewLine
	Response.Write "var obj=parent.document.getElementById(""searchmain"");" & vbNewLine
	Response.Write "var SearchData = document.getElementById(""Seardata"");" & vbNewLine
	Response.Write "obj.style.height=(parent.document.getElementById(""searchmain"").offsetHeight)+'px';" & vbNewLine
	Response.Write "obj.innerHTML = SearchData.innerHTML;" & vbNewLine
	Response.Write "//-->" & vbNewLine
	Response.Write "</script>" & vbNewLine
End Sub
Public Function SearchObj()
	Dim strTemp,keyword
	keyword = Replace(Request("keyword"), "'", "")
	strTemp = "<script language=""JavaScript"">" & vbNewLine
	strTemp = strTemp & "<!--" & vbNewLine
	strTemp = strTemp & "var ToUrl=""search.asp?act=isweb&keyword=" & keyword & "&s=1"";" & vbNewLine
	strTemp = strTemp & "var HFrame = document.getElementById(""hiddenquery"")" & vbNewLine
	strTemp = strTemp & "var obj = document.getElementById(""searchmain"");" & vbNewLine
	strTemp = strTemp & "if (HFrame){" & vbNewLine
	strTemp = strTemp & "	HFrame.src=ToUrl;" & vbNewLine
	strTemp = strTemp & "}" & vbNewLine
	strTemp = strTemp & "if (obj){" & vbNewLine
	strTemp = strTemp & "	obj.style.height=""1024"";" & vbNewLine
	strTemp = strTemp & "	obj.style.display=='none'" & vbNewLine
	strTemp = strTemp & "}" & vbNewLine
	strTemp = strTemp & "//-->" & vbNewLine
	strTemp = strTemp & "</script>" & vbNewLine
	SearchObj = strTemp
End Function

'================================================
'函数名：ShowListPage
'作  用：通用分页
'================================================
Public Function ShowListPage(CurrentPage, Pcount, totalrec, PageNum, strLink, ListName)
	Dim strTemp
	On Error Resume Next
	If Pagesmode = True Then
		ShowListPage = showlistpages(CurrentPage, Pcount, totalrec, PageNum, strLink, ListName)
		Exit Function
	End If
	strTemp = vbNewLine & "<script>"
	strTemp = strTemp & "ShowListPage("
	strTemp = strTemp & CurrentPage
	strTemp = strTemp & ","
	strTemp = strTemp & Pcount
	strTemp = strTemp & ","
	strTemp = strTemp & totalrec
	strTemp = strTemp & ","
	strTemp = strTemp & PageNum
	strTemp = strTemp & ",'"
	strTemp = strTemp & strLink
	strTemp = strTemp & "','"
	strTemp = strTemp & ListName
	strTemp = strTemp & "');"
	strTemp = strTemp & "</script>" & vbNewLine
	ShowListPage = strTemp
End Function
'================================================
'函数名：ShowHtmlPage
'作  用：通用HTML分页
'================================================
Public Function ShowHtmlPages(CurrentPage, Pcount, totalrec, PageNum, strLink, ExtName, ListName)
	Dim strTemp
	On Error Resume Next
	strTemp = vbNewLine & "<script>"
	strTemp = strTemp & "ShowHtmlPage("
	strTemp = strTemp & CurrentPage
	strTemp = strTemp & ","
	strTemp = strTemp & Pcount
	strTemp = strTemp & ","
	strTemp = strTemp & totalrec
	strTemp = strTemp & ","
	strTemp = strTemp & PageNum
	strTemp = strTemp & ",'"
	strTemp = strTemp & strLink
	strTemp = strTemp & "','"
	strTemp = strTemp & ExtName
	strTemp = strTemp & "','"
	strTemp = strTemp & ListName
	strTemp = strTemp & "');"
	strTemp = strTemp & "</script>" & vbNewLine
	ShowHtmlPages = strTemp
End Function

Public Function htmlshowpage(page,Pcount,totalnumber,maxperpage,strLink,ExtName,ListName)
	If Pagesmode = False Then
		htmlshowpage = ShowHtmlPage(page, Pcount, totalnumber, maxperpage, strLink, ExtName, ListName)
		Exit Function
	End If
	Dim strTemp, b, e
	Dim pagestart,pageend
	Dim i, ii,  n, p, s
	b = 5 : e = 5 : s = "五"
	pagestart = page - 50
	pageend = page + 50
	If pagestart < 1 Then
		pagestart = 2
	End If
	If pageend > Pcount Then
		pageend = Pcount
	End If

	If (page - 1) Mod b = 0 Then
		p = (page-1) \ b
	Else
		p = ((page-1) - (page-1) Mod b) \ b
	End If
	If totalnumber Mod maxperpage = 0 Then
		n = totalnumber \ maxperpage
	Else
		n = (totalnumber - totalnumber Mod maxperpage) \ maxperpage + 1
	End If
	
	strTemp = "<table border=""0"" cellpadding=""0"" cellspacing=""1"" class=""Tableborder5"">" & vbNewLine
	strTemp = strTemp & "	<form method=""post"">" & vbNewLine
	strTemp = strTemp & "	<tr align=""center"">" & vbNewLine
	strTemp = strTemp & "		<td class=""tabletitle1"" title=""" & ListName & """>&nbsp;" & ListName & "&nbsp;</td>" & vbNewLine
	strTemp = strTemp & "		<td class=""tabletitle1"" title=""总数"">&nbsp;" & totalnumber & "&nbsp;</td>" & vbNewLine
	strTemp = strTemp & "		<td class=""tabletitle1"" title=""每页"">&nbsp;" & maxperpage & "&nbsp;</td>" & vbNewLine
	strTemp = strTemp & "		<td class=""tabletitle1"" title=""页次"">&nbsp;" & page & "/" & Pcount & "页&nbsp;</td>" & vbNewLine
	
	If page = 1 Then
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<font face=""webdings"">9</font>&nbsp;</td>" & vbNewLine
	Else
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""index" & ExtName & """ title=""首页""><font face=""webdings"">9</font></a>&nbsp;</td>" & vbNewLine
	End If
	If p * b > 0 Then
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""" & strLink & (p*b) & ExtName & """ title=""上" & s & "页""><font face=""webdings"">7</font></a>&nbsp;</td>" & vbNewLine
	Else
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<font face=""webdings"">7</font>&nbsp;</td>" & vbNewLine
	End If
	
	For i = p * b + 1 To p * b + e
		
		If i = page Then
			strTemp = strTemp & "		<td class=""tablebody2"">&nbsp;<font class=""normalTextSmall""><u><b>" & i & "</b></u></font>&nbsp;</td>" & vbNewLine
		Else
			If i = 1 Then
				strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""index" & ExtName & """ title=""第1页"">1</a>&nbsp;</td>" & vbNewLine
			Else
				strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""" & strLink & i & ExtName & """ title=""第" & i & "页"">" & i & "</a>&nbsp;</td>" & vbNewLine
			End If
		End if
		If i = n Then Exit For
	Next
	
	If i < n Then
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""" & strLink & i & ExtName & """ title=""下" & s & "页""><font face=""webdings"">8</font></a>&nbsp;<td>" & vbNewLine
	Else
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<font face=""webdings"">8</font>&nbsp;<td>" & vbNewLine
	End If

	If page = n Then
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<Font face=""webdings"">:</font>&nbsp;</td>" & vbNewLine
	Else
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""" & strLink & n & ExtName & """ title=""尾页""><font face=""webdings"">:</font></a>&nbsp;</td>" & vbNewLine
	End If
	
	strTemp = strTemp & "		<td class=""tabletitle1"" title=""转到"">&nbsp;GO&nbsp;</td>" & vbNewLine
	strTemp = strTemp & "		<td class=""tablebody1""><select class=""PageInput"" name=""page"" size=""1"" onchange=""javascript:window.location=this.options[this.selectedIndex].value;"">" & vbNewLine
	strTemp = strTemp & "		<option value=""index" & ExtName & """>第1页</option>"
	If pagestart > 1 Then
		For ii = pagestart To pageend'Pcount
			If ii = page Then
				strTemp = strTemp & "<option value=""" & strLink & ii & ExtName & """ selected>第" & ii & "页</option>"
			Else
				strTemp = strTemp & "<option value=""" & strLink & ii & ExtName & """>第" & ii & "页</option>"
			End If
		Next
	End If

	strTemp = strTemp & "</select></td>" & vbNewLine
	strTemp = strTemp & "	</tr>" & vbNewLine
	strTemp = strTemp & "	</form>" & vbNewLine
	strTemp = strTemp & "</table>" & vbNewLine