<%
'================================================
'函数名：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
	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
	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.HtmlPath,B.HtmlPrefix FROM [xp90com_Classify] C inner join [xp90com_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 [xp90com_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 = 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 & ">" & ClassName & "</a>"
			Else
				If Rs("IsCreateHtml") <> 0 Then
					ClassName = "<a href=""" & Newasp.InstallDir & Rs("ChannelDir") & Rs("HtmlFileDir") & """" & LinkTarget & strClass & ">" & ClassName & "</a>"
				Else
					ClassName = "<a href=""" & Newasp.InstallDir & Rs("ChannelDir") & "list.asp?classid=" & Rs("ClassID") & """" & LinkTarget & strClass & ">" & 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
	On Error Resume Next
	'--增加专题菜单
	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
	Dim LinkTarget, HtmlFileUrl, ClassName, strClass
	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
	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.HtmlPath FROM [xp90com_Classify] C INNER JOIN [xp90com_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 [xp90com_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
		'strContent = "<table border=0 cellpadding=1 cellspacing=3 class=tabmenubar>" & vbCrLf
		Do While Not Rs.EOF
			'strContent = strContent & "<tr>" & vbCrLf
			For i = 1 To CInt(PerRowNum)
				'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(Rs("ClassName"), Rs("ColorModes"), Rs("FontModes"))
					If Rs("TurnLink") <> 0 Then
						ClassName = "<a href='" & Rs("TurnLinkUrl") & "'" & LinkTarget & strClass & ">" & ClassName & "</a>"
					Else
						If Rs("IsCreateHtml") <> 0 Then
							ClassName = "<a href=""" & Newasp.InstallDir & Rs("ChannelDir") & Rs("HtmlFileDir") & """" & LinkTarget & strClass & ">" & ClassName & "</a>" & vbCrLf
						Else
							ClassName = "<a href=""" & Newasp.InstallDir & Rs("ChannelDir") & "list.asp?classid=" & Rs("ClassID") & """" & LinkTarget & strClass & ">" & ClassName & "</a>" & vbCrLf
						End If
					End If
					strContent = strContent & frontstr & ClassName
					'strContent = strContent & "</li>" & vbCrLf
					Rs.MoveNext
				Else
					'strContent = strContent & "</td>" & vbCrLf
				End If
			Next
			'strContent = strContent & "</tr>" & vbCrLf
		Loop
		'strContent = strContent & "</table>" & vbCrLf
	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
	On Error Resume Next
	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
Const Pagesmode = False
'================================================
'函数名：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,HtmlPrefix,HtmlExtName,strMaxnum
	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,HtmlPrefix,HtmlPath FROM [xp90com_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 [xp90com_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 & "" & frontstr & "<a href=""" & SpecialPath & """" & LinkTarget & ">" & Topicformat & "</a>" & 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 & "" & frontstr & "<a href=""" & ChannelPath & "special/" & HtmlPrefix & "Best001" & HtmlExtName & """>" & ArrayModuleName(0) & "</a>" & vbCrLf
			strTemp = strTemp & "" & frontstr & "<a href=""" & ChannelPath & "special/" & HtmlPrefix & "Hot001" & HtmlExtName & """>" & ArrayModuleName(1) & "</a>" & vbCrLf
			strTemp = strTemp & "" & frontstr & "<a href=""" & ChannelPath & "special/" & HtmlPrefix & "New001" & HtmlExtName & """>" & ArrayModuleName(2) & "</a>" & vbCrLf
		Else
			strTemp = strTemp & "" & frontstr & "<a href=""" & ChannelPath & "showbest.asp"">" & ArrayModuleName(0) & "</a>" & vbCrLf
			strTemp = strTemp & "" & frontstr & "<a href=""" & ChannelPath & "showhot.asp"">" & ArrayModuleName(1) & "</a>" & vbCrLf
			strTemp = strTemp & "" & frontstr & "<a href=""" & ChannelPath & "shownew.asp"">" & ArrayModuleName(2) & "</a>" & vbCrLf
		End If
		'If Modules = 2 Then
			'strTemp = strTemp & "" & frontstr & "<a href=""" & ChannelPath & "showtype.asp"">" & ArrayModuleName(3) & "</a>" & 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
	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
	htmlshowpage = strTemp
End Function
Public Function htmlmorepage(page,Pcount,totalnumber,maxperpage,strLink,ExtName,ListName)
	If Pagesmode = False Then
		htmlmorepage = 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=""" & strLink & "001" & 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 & Newasp.Supplemental(p*b,3) & 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
			strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""" & strLink & Newasp.Supplemental(i,3) & ExtName & """ title=""第" & i & "页"">" & i & "</a>&nbsp;</td>" & vbNewLine
		End if
		If i = n Then Exit For
	Next
	If i < n Then
		strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""" & strLink & Newasp.Supplemental(i,3) & 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 & Newasp.Supplemental(n,3) & 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
	If pagestart > 0 Then
		For ii = pagestart To pageend'Pcount
			If ii = page Then
				strTemp = strTemp & "<option value=""" & strLink & Newasp.Supplemental(ii,3) & ExtName & """ selected>第" & ii & "页</option>"
			Else
				strTemp = strTemp & "<option value=""" & strLink & Newasp.Supplemental(ii,3) & 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
	htmlmorepage = strTemp
End Function
Public Function showlistpages(page, Pcount, totalnumber, maxperpage, strLink, ListName)
        Dim strTemp, sName
        Dim i, n, p, s, b, e
        b = 5
        e = 5
        s = "五"
        sName = ""
        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"" action=""" & sName & "?pcount="& Pcount & strLink & """>" & 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=""" & sName & "?page=1" & strLink & """ 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=""" & sName & "?page="& p * b & strLink & """ 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
                        strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""" & sName & "?page=" & i & strLink & """ title=""第" & i & "页"">" & i & "</a>&nbsp;</td>" & vbNewLine
                End If
                If i = n Then Exit For
        Next
        If i < n Then
                strTemp = strTemp & "		<td class=""tablebody1"">&nbsp;<a href=""" & sName & "?page=" & i & strLink & """ 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=""" & sName & "?page=" & n & strLink & """ title=""尾页""><font face=""webdings"">:</font></a>&nbsp;</td>" & vbNewLine
        End If
        strTemp = strTemp & "		<td class=""tablebody1""><input class=""PageInput"" type=""text"" name=""page"" size=""1"" maxlength=""10"" value=""" & page & """></td>" & vbNewLine
        strTemp = strTemp & "		<td class=""tablebody1""><input type=""submit"" value=""Go"" name=""submit"" class=""PageInput""></td>" & vbNewLine
        strTemp = strTemp & "	</tr>" & vbNewLine
        strTemp = strTemp & "	</form>" & vbNewLine
        strTemp = strTemp & "</table>" & vbNewLine
        showlistpages = strTemp
End Function
Public Function CurrentNum(ByVal num)
	If Len(num) = 1 Then
		CurrentNum = CStr("00")
		Exit Function
	ElseIf Len(num) = 2 Then
		CurrentNum = CStr("0")
		Exit Function
	Else
		CurrentNum = ""
	End If
End Function
Public Function AdsReplace(ByVal strHTML,ByVal strCode,ByVal istop)
	Dim ArrayAdsCode
	If istop = 0 Then
		ArrayAdsCode = Split(strCode & "|||||||||", "|||")
		strHTML = Replace(strHTML, "{$AdsCode1}", ArrayAdsCode(0))
		strHTML = Replace(strHTML, "{$AdsCode2}", ArrayAdsCode(1))
		strHTML = Replace(strHTML, "{$AdsCode3}", ArrayAdsCode(2))
		strHTML = Replace(strHTML, "{$AdsCode4}", ArrayAdsCode(3))
		strHTML = Replace(strHTML, "{$AdsCode5}", ArrayAdsCode(4))
	Else
		strHTML = Replace(strHTML, "{$AdsCode1}", "")
		strHTML = Replace(strHTML, "{$AdsCode2}", "")
		strHTML = Replace(strHTML, "{$AdsCode3}", "")
		strHTML = Replace(strHTML, "{$AdsCode4}", "")
		strHTML = Replace(strHTML, "{$AdsCode5}", "")
	End If
	strHTML = Replace(strHTML, "{$AdsCode}", vbNullString)
	AdsReplace = strHTML
End Function
%>
