classmenu.asp

采用的是新云内核

	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,HtmlPrefix,HtmlPath 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 = Newasp.InstallDir & Rs("ChannelDir")
		Modules = Rs("Modules")
		sModuleName = Rs("ModuleName")
		HtmlPrefix = Rs("HtmlPrefix")
		HtmlExtName = Rs("HtmlExtName")
	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 = ChannelPath & "special/" & Rs("SpecialDir")
			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 & ">" & 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
			strTemp = strTemp & "<li>" & frontstr & "<a href='" & ChannelPath & "special/" & HtmlPrefix & "Best001" & HtmlExtName & "'>" & ArrayModuleName(0) & "</a></li>" & vbCrLf
			strTemp = strTemp & "<li>" & frontstr & "<a href='" & ChannelPath & "special/" & HtmlPrefix & "Hot001" & HtmlExtName & "'>" & ArrayModuleName(1) & "</a></li>" & vbCrLf
			strTemp = strTemp & "<li>" & frontstr & "<a href='" & ChannelPath & "special/" & HtmlPrefix & "New001" & HtmlExtName & "'>" & 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
	On Error Resume Next
	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 ShowHtmlPage(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
	ShowHtmlPage = 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