cls_public.asp

采用的是新云内核

								HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("flashid")
							End If
							If CInt(newindow) <> 0 Then
								LinkTarget = " target=""_blank"""
							Else
								LinkTarget = ""
							End If
							strContent = strContent & Newasp.MainSetting(21)
							strContent = Replace(strContent, "{$Miniature}", "<a href='" & HtmlFileUrl & "' title='" & Rs("title") & "'" & LinkTarget & ">" & miniature & "</a>")
							If CInt(showtopic) = 1 Then
								strContent = Replace(strContent, "{$FlashTopic}", "<a href='" & HtmlFileUrl & "' title='" & Rs("title") & "'" & LinkTarget & ">" & strtitle & "</a>")
							Else
								strContent = Replace(strContent, "{$FlashTopic}", vbNullString)
							End If
							strContent = strContent & "</td>" & vbCrLf
						Rs.MoveNext
						End If
					Next
				strContent = strContent & "</tr>" & vbCrLf
				End If
				If slide>0 Then Rs.MoveNext
			Loop
			strContent = strContent & "</table>" & vbCrLf
			If slide>0 Then
				Set xmlNode = XMLDom.cloneNode(True)
				Set XSLT = Server.CreateObject("Msxml2.XSLTemplate" & MsxmlVersion)
				Set XMLStyle = Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
				If XMLStyle.load(Server.MapPath(Newasp.InstallDir & "inc/xslt/NC_slide.xslt")) Then
					XSLT.stylesheet = XMLStyle
					Set proc = XSLT.createProcessor()
					proc.input = xmlNode
					proc.transform()
					strContent = proc.output
					Set proc = Nothing
				Else
					strContent = vbNullString
				End If
				Set XMLStyle = Nothing
				Set XSLT = Nothing:Set xmlNode = Nothing
				Set Node = Nothing:Set XMLDom = Nothing
			End If
		End If
		Rs.Close: Set Rs = Nothing
		LoadFlashPic = strContent
	End Function
	'================================================
	'函数名：ReadFlashPic
	'作  用：读取动画图片列表
	'参  数：str ----原字符串
	'================================================
	Public Function ReadFlashPic(ByVal str)
		Dim strTemp, i
		Dim sTempContent, nTempContent, ArrayList
		Dim arrTempContent, arrTempContents
		
		strTemp = str
		If InStr(strTemp, "{$ReadFlashPic(") > 0 Then
			sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadFlashPic(", ")}", 1)
			nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadFlashPic(", ")}", 0)
			arrTempContents = Split(sTempContent, "|||")
			arrTempContent = Split(nTempContent, "|||")
			For i = 0 To UBound(arrTempContents)
				ArrayList = Split(arrTempContent(i) & ",0", ",")
				strTemp = Replace(strTemp, arrTempContents(i), LoadFlashPic(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10), ArrayList(11)))
			Next
		End If
		ReadFlashPic = strTemp
	End Function
	'================================================
	'函数名：LoadFriendLink
	'作  用：装载友情连接
	'参  数：str ----原字符串
	'================================================
	Public Function LoadFriendLink(ByVal TopNum, ByVal PerRowNum, ByVal isLogo, ByVal orders)
		Dim Rs, SQL, i, strContent
		Dim strOrder, LinkAddress
		
		strContent = ""
		If Not IsNumeric(TopNum) Then Exit Function
		If Not IsNumeric(PerRowNum) Then Exit Function
		If Not IsNumeric(isLogo) Then Exit Function
		If Not IsNumeric(orders) Then Exit Function
		
		If CInt(orders) = 1 Then
			'-- 首页显示按时间升序排列
			strOrder = "And isIndex > 0 Order By LinkTime Desc,LinkID Desc"
		ElseIf CInt(orders) = 2 Then
			'-- 首页显示按点击数升序排列
			strOrder = "And isIndex > 0 Order By LinkHist Desc,LinkID Desc"
		ElseIf CInt(orders) = 3 Then
			'-- 首页显示按点击数降序排列
			strOrder = "And isIndex > 0 Order By LinkHist Desc,LinkID Asc"
		ElseIf CInt(orders) = 4 Then
			'-- 所有按升序排列
			strOrder = "Order By LinkID Desc"
		ElseIf CInt(orders) = 5 Then
			'-- 所有按降序排列
			strOrder = "Order By LinkID Asc"
		ElseIf CInt(orders) = 6 Then
			'-- 所有按点击数升序排列
			strOrder = "Order By LinkHist Desc,LinkID Desc"
		ElseIf CInt(orders) = 7 Then
			'-- 所有按点击数降序排列
			strOrder = "Order By LinkHist Desc,LinkID Asc"
		ElseIf CInt(orders) = 8 Then
			'-- 首页显示按名称排列
			strOrder = "And isIndex > 0 Order By LinkName Desc,LinkID Desc"
		ElseIf CInt(orders) = 9 Then
			'-- 所有按名称排列
			strOrder = "Order By LinkName Desc,LinkID Desc"
		Else
			'-- 首页显示按时间降序排列
			strOrder = "And isIndex > 0 Order By LinkTime Asc,LinkID Asc"
		End If
		If CInt(isLogo) = 1 Or CInt(isLogo) = 3 Then
			SQL = "Select Top " & CInt(TopNum) & " LinkID,LinkName,LinkUrl,LogoUrl,Readme,LinkHist,isLogo from [NC_Link] where isLock = 0 And isLogo > 0 " & strOrder & ""
		Else
			SQL = "Select Top " & CInt(TopNum) & " LinkID,LinkName,LinkUrl,LogoUrl,Readme,LinkHist,isLogo from [NC_Link] where isLock = 0 And isLogo = 0 " & strOrder & ""
		End If
		
		Set Rs = Server.CreateObject("ADODB.Recordset")
		Rs.Open SQL,Conn,1,1
		If Not (Rs.BOF And Rs.EOF) Then
			strContent = "<table width=""100%"" border=0 cellpadding=1 cellspacing=3 class=FriendLink1>" & vbCrLf
			Do While Not Rs.EOF
				strContent = strContent & "<tr>" & vbCrLf
				For i = 1 To CInt(PerRowNum)
					strContent = strContent & "<td align=center class=FriendLink2>"
					If Not Rs.EOF Then
						If CInt(isLogo) < 2 Then
							LinkAddress = Newasp.InstallDir & "link/link.asp?id=" & Rs("LinkID") & "&url=" & Trim(Rs("LinkUrl"))
						Else
							LinkAddress = Trim(Rs("LinkUrl"))
						End If
						If Rs("isLogo") = 1 Or CInt(isLogo) = 3 Then
							strContent = strContent & "<a href='" & LinkAddress & "' target=_blank title='主页名称：" & Rs("LinkName") & "&#13;&#10;点击次数：" & Rs("LinkHist") & "'><img src='" & Newasp.ReadFileUrl(Rs("LogoUrl")) & "' width=88 height=31 border=0></a>"
						Else
							strContent = strContent & "<a href='" & LinkAddress & "' target=_blank title='主页名称：" & Rs("LinkName") & "&#13;&#10;点击次数：" & Rs("LinkHist") & "'>" & Rs("LinkName") & "</a>"
						End If
						strContent = strContent & "</td>" & vbCrLf
						Rs.MoveNext
					Else
						If CInt(isLogo) = 1 Or CInt(isLogo) = 3 Then
							strContent = strContent & "<a href='" & Newasp.InstallDir & "link/addlink.asp' target=_blank><img src='" & Newasp.InstallDir & "images/link.gif' width=88 height=31 border=0></a>"
						Else
							strContent = strContent & "<a href='http://www.gzbl163.cn/' target=_blank>申请链接</a>"
						End If
						strContent = strContent & "</td>" & vbCrLf
					End If
				Next
				strContent = strContent & "</tr>" & vbCrLf
			Loop
			strContent = strContent & "</table>" & vbCrLf
		End If
		LoadFriendLink = strContent
	End Function
	'================================================
	'函数名：ReadFriendLink
	'作  用：读取友情连接
	'参  数：str ----原字符串
	'================================================
	Public Function ReadFriendLink(ByVal str)
		Dim strTemp, i
		Dim sTempContent, nTempContent, ArrayList
		Dim arrTempContent, arrTempContents
		
		strTemp = str
		If InStr(strTemp, "{$ReadFriendLink(") > 0 Then
			sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadFriendLink(", ")}", 1)
			nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadFriendLink(", ")}", 0)
			arrTempContents = Split(sTempContent, "|||")
			arrTempContent = Split(nTempContent, "|||")
			For i = 0 To UBound(arrTempContents)
				ArrayList = Split(arrTempContent(i), ",")
				strTemp = Replace(strTemp, arrTempContents(i), LoadFriendLink(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3)))
			Next
		End If
		ReadFriendLink = strTemp
	End Function
	'================================================
	'函数名：PageRunTime
	'作  用：页面执行时间
	'================================================
	Public Function ExecutionTime()
		Dim Endtime
		ExecutionTime = ""
		If CInt(Newasp.IsRunTime) = 1 Then
			Endtime = Timer()
			ExecutionTime = "页面执行时间：" & FormatNumber((((Endtime - startime) * 5000) + 0.5) / 10, 3, -1) & "毫秒"
		Else
			ExecutionTime = ""
		End If
	End Function
	
	'================================================
	'函数名：CurrentStation
	'作  用：当前位置
	'参  数：...
	'================================================
	Public Function CurrentStation(ByVal ChannelID, ByVal ClassID, ByVal ClassName, _
		ByVal ParentID, ByVal strParent, ByVal HtmlFileDir, ByVal Compart)
		
		Dim rsCurrent, SQL, strContent, ChannelDir
		
		CurrentStation = ""
		ChannelID = Newasp.ChkNumeric(ChannelID)
		ClassID = Newasp.ChkNumeric(ClassID)
		ParentID = Newasp.ChkNumeric(ParentID)
		
		
		Newasp.LoadChannel(ChannelID)
		
		ChannelDir = Newasp.ChannelPath
		CurrentClass = ""
		strContent = ""'"<a href='" & ChannelDir & "'>" & Newasp.ChannelName & "</a>" & Compart & ""
		If ParentID <> 0 And Len(strParent) <> 0 Then
			SQL = "SELECT ClassID,ClassName,HtmlFileDir,UseHtml FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID in(" & strParent & ")"
			Set rsCurrent = Newasp.Execute(SQL)
			If Not (rsCurrent.EOF And rsCurrent.BOF) Then
				Do While Not rsCurrent.EOF
					
					If CInt(Newasp.IsCreateHtml) <> 0 Then
						strContent = strContent & "<a href='" & ChannelDir & rsCurrent("HtmlFileDir") & "'>" & rsCurrent("ClassName") & "</a>" & Compart & ""
					Else
						strContent = strContent & "<a href='" & ChannelDir & "list.asp?classid=" & rsCurrent("ClassID") & "'>" & rsCurrent("ClassName") & "</a>" & Compart & ""
					End If
					CurrentClass = CurrentClass & rsCurrent("ClassName") & " - "
					rsCurrent.MoveNext
				Loop
			End If
			rsCurrent.Close
			Set rsCurrent = Nothing
		End If
		If CInt(Newasp.IsCreateHtml) <> 0 Then
			strContent = strContent & "<a href='" & ChannelDir & HtmlFileDir & "'>" & ClassName & "</a>"
		Else
			strContent = strContent & "<a href='" & ChannelDir & "list.asp?classid=" & ClassID & "'>" & ClassName & "</a>"
		End If
		CurrentClass = CurrentClass & ClassName
		CurrentStation = strContent
	End Function
	'================================================
	'函数名：ReadCurrentStation
	'作  用：读取当前位置
	'参  数：str ----原字符串
	'================================================
	Public Function ReadCurrentStation(ByVal str, ByVal ChannelID, ByVal ClassID, _
		ByVal ClassName, ByVal ParentID, ByVal strParent, ByVal HtmlFileDir)
		
		Dim strTemp, i
		Dim sTempContent, nTempContent
		Dim arrTempContent, arrTempContents
		
		strTemp = str
		If InStr(strTemp, "{$CurrentStation(") > 0 Then
			sTempContent = Newasp.CutMatchContent(strTemp, "{$CurrentStation(", ")}", 1)
			nTempContent = Newasp.CutMatchContent(strTemp, "{$CurrentStation(", ")}", 0)
			arrTempContents = Split(sTempContent, "|||")
			arrTempContent = Split(nTempContent, "|||")
			For i = 0 To UBound(arrTempContents)
				strTemp = Replace(strTemp, arrTempContents(i), CurrentStation(ChannelID, ClassID, ClassName, ParentID, strParent, HtmlFileDir, arrTempContent(i)))
			Next
		End If
		ReadCurrentStation = strTemp
	End Function
	'================================================
	'函数名：NewsPictureAndText
	'作  用：图文混排列表
	'================================================
	Public Function NewsPictureAndText(ByVal chanid, ByVal ClassID, ByVal specid, _
		ByVal stype, ByVal height, ByVal width, ByVal maxlen, _
		ByVal maxline, ByVal hspace, ByVal vspace, ByVal align, _
		ByVal divcss, ByVal target, ByVal start, ByVal showpic, _
		ByVal showclass, ByVal showdate, ByVal dateformat)
		
		Dim Rs, SQL, i, strContent, foundstr
		Dim ChildStr, HtmlFileUrl, HtmlFileName, strPicture
		Dim PicTopic, NewsTitle, ClassName, ArticleTitle, WriteTime
		
		chanid = Newasp.ChkNumeric(chanid)
		ClassID = Newasp.ChkNumeric(ClassID)
		specid = Newasp.ChkNumeric(specid)
		stype = Newasp.ChkNumeric(stype)
		
		
		Newasp.LoadChannel(chanid)
		
		If CInt(stype) >= 3 And CLng(ClassID) <> 0 Then
			SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID