cls_public.asp

网络上经典的图片程序

			Case 9
				If IsSqlDataBase = 1 Then
					foundstr = "ORDER BY newid()"
				Else
					foundstr = "ORDER BY  rnd(A.ArticleID)"
				End If
		Case Else
			foundstr = "Order By A.Writetime Desc ,A.Articleid Desc"
		End Select
		If CInt(stype) >= 4 And CLng(ClassID) = 0 Then
			foundstr = "Order By A.Writetime Desc ,A.Articleid Desc"
		End If
		If CLng(SpecialID) <> 0 Then
			foundstr = "And A.SpecialID =" & CLng(SpecialID) & " " & foundstr
		End If
		SQL = " A.ArticleID,A.ClassID,A.title,A.AllHits,A.WriteTime,A.HtmlFileDate,A.isBest,A.ImageUrl,"
		SQL = "select Top " & CInt(TopNum) & SQL & " C.ClassName,C.HtmlFileDir,C.UseHtml from [NC_Article] A inner join [NC_Classify] C On A.ClassID=C.ClassID where A.isAccept > 0 And A.ImageUrl<>'' And A.ChannelID=" & ChannelID & " " & foundstr & ""
		Set Rs = Newasp.Execute(SQL)
		If Rs.BOF And Rs.EOF Then
			strContent = "<img src='" & Newasp.InstallDir & "images/no_pic.gif' width=" & width & " height=" & height & " border=0>"
		Else
			strContent = "<table width=""100%"" border=""0"" cellpadding=""1"" cellspacing=""5"">" & vbCrLf
			n = 0
			'-- 是否启用幻灯片效果
			If slide>0 Then
				Set XMLDom=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
				XMLDom.appendChild(XMLDom.createElement("xml"))
				'-- 幻灯片效果基本设置
				Set Node=XMLDom.createNode(1,"setting","")
				Node.attributes.setNamedItem(XMLDom.createNode(2,"ChannelID","")).text = ChannelID
				Node.attributes.setNamedItem(XMLDom.createNode(2,"width","")).text = width
				Node.attributes.setNamedItem(XMLDom.createNode(2,"height","")).text = height
				If showtopic=1 Then
					Node.attributes.setNamedItem(XMLDom.createNode(2,"text_height","")).text = 20
				Else
					Node.attributes.setNamedItem(XMLDom.createNode(2,"text_height","")).text = 0
				End If
				Node.attributes.setNamedItem(XMLDom.createNode(2,"maxpic","")).text = TopNum
				Node.attributes.setNamedItem(XMLDom.createNode(2,"maxlen","")).text = strLen
				Node.attributes.setNamedItem(XMLDom.createNode(2,"path","")).text = Newasp.InstallDir
				Node.attributes.setNamedItem(XMLDom.createNode(2,"slidetype","")).text = slide
				XMLDom.documentElement.appendChild(Node)
			End If
			Do While Not Rs.EOF
				n = n + 1
				If slide>0 Then
					sTitle = Newasp.GotTopic(Rs("title"), CInt(strLen))
					ImageUrl = Newasp.GetImageUrl(Rs("ImageUrl"), Newasp.ChannelData(1))
					If CInt(Newasp.ChannelUseHtml) <> 0 Then
						HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
						HtmlFileUrl = ShowChannelPath(Newasp.ChannelPath, Rs("HtmlFileDir")) & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
					Else
						HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("ArticleID")
					End If
					'-- 装幻灯片信息传递给XML节点
					Set Node=XMLDom.createNode(1,"slide","")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"slideid","")).text = n
					Node.attributes.setNamedItem(XMLDom.createNode(2,"classid","")).text = classid
					Node.attributes.setNamedItem(XMLDom.createNode(2,"title","")).text = Replace(sTitle, "|", "")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"picurl","")).text = Replace(ImageUrl, "|", "")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"url","")).text = Replace(HtmlFileUrl, "|", "")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"addtime","")).text = Rs("WriteTime")
					XMLDom.documentElement.appendChild(Node)
				Else
					strContent = strContent & "<tr>" & vbCrLf
					For i = 1 To CInt(PerRowNum)
						strContent = strContent & "<td align=""center"" class=""imagelist"">"
						If Not Rs.EOF Then
							sTitle = Newasp.GotTopic(Rs("title"), CInt(strLen))
							ImageUrl = Newasp.GetImageUrl(Rs("ImageUrl"), Newasp.ChannelData(1))
							ImageUrl = Newasp.GetFlashAndPic(ImageUrl, height, width)
							
							HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
							If CInt(Newasp.ChannelUseHtml) <> 0 Then
								HtmlFileUrl = ShowChannelPath(Newasp.ChannelPath, Rs("HtmlFileDir")) & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
							Else
								HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("ArticleID")
							End If
							
							If CInt(newindow) <> 0 Then
								LinkTarget = " target=""_blank"""
							Else
								LinkTarget = ""
							End If
							strContent = strContent & Newasp.MainSetting(18)
							strContent = Replace(strContent, "{$ArticlePicture}", "<a href='" & HtmlFileUrl & "' title='" & Rs("title") & "'" & LinkTarget & ">" & ImageUrl & "</a>")
							If CInt(showtopic) = 1 Then
								strContent = Replace(strContent, "{$ArticleTopic}", "<a href='" & HtmlFileUrl & "' title='" & Rs("title") & "'" & LinkTarget & ">" & sTitle & "</a>")
							Else
								strContent = Replace(strContent, "{$ArticleTopic}", 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
		LoadArticlePic = strContent
	End Function
	'================================================
	'函数名：ReadArticlePic
	'作  用：读取文章图片列表
	'参  数：str ----原字符串
	'================================================
	Public Function ReadArticlePic(ByVal str)
		Dim strTemp, i
		Dim sTempContent, nTempContent, ArrayList
		Dim arrTempContent, arrTempContents
		On Error Resume Next
		strTemp = str
		If InStr(strTemp, "{$ReadArticlePic(") > 0 Then
			sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadArticlePic(", ")}", 1)
			nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadArticlePic(", ")}", 0)
			arrTempContents = Split(sTempContent, "|||")
			arrTempContent = Split(nTempContent, "|||")
			For i = 0 To UBound(arrTempContents)
				ArrayList = Split(arrTempContent(i) & ",0", ",")
				strTemp = Replace(strTemp, arrTempContents(i), LoadArticlePic(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
		ReadArticlePic = strTemp
	End Function
	'================================================
	'函数名：LoadSoftPic
	'作  用：装载软件图片列表
	'参  数：ClassID   ----分类ID
	'        ChannelID   ----频道ID
	'        sType   ----调用软件类型,0=所有最新软件，1=推荐软件，2=热门软件
	'        TopNum   ----显示软件列表数
	'        strlen   ----显示标题长度
	'        newindow   ----新窗口打开
	'================================================
	Public Function LoadSoftPic(ChannelID, ClassID, SpecialID, stype, TopNum, PerRowNum, strLen, newindow, width, height, showtopic, slide)
		Dim Rs, SQL, i, strContent, foundstr, n
		Dim strSoftName, ChildStr, SoftImage, HtmlFileName
		Dim HtmlFileUrl, SoftTime, LinkTarget
		Dim XMLDom,xmlNode,Node,XSLT,XMLStyle,proc
		
		ChannelID = Newasp.ChkNumeric(ChannelID)
		ClassID = Newasp.ChkNumeric(ClassID)
		SpecialID = Newasp.ChkNumeric(SpecialID)
		stype = Newasp.ChkNumeric(stype)
		height = Newasp.ChkNumeric(height)
		width = Newasp.ChkNumeric(width)
		slide = Newasp.ChkNumeric(slide)
		
		On Error Resume Next
		Newasp.LoadChannel(ChannelID)
		
		If CInt(stype) >= 3 And CLng(ClassID) <> 0 Then
			SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID=" & ChannelID & " And ClassID=" & ClassID
			Set Rs = Newasp.Execute(SQL)
			If Rs.BOF And Rs.EOF Then
				Set Rs = Nothing
				LoadSoftPic = ""
				Exit Function
			Else
				ChildStr = Rs("ChildStr")
			End If
			Rs.Close
		Else
			ChildStr = 0
		End If
		Select Case CInt(stype)
			Case 0: foundstr = "Order By A.SoftTime Desc ,A.SoftID Desc"
			Case 1: foundstr = "And A.isBest > 0 Order By A.SoftTime Desc ,A.SoftID Desc"
			Case 2: foundstr = "Order By A.AllHits Desc ,A.SoftID Desc"
			Case 3: foundstr = "And A.ClassID in (" & ChildStr & ") Order By A.SoftTime Desc ,A.SoftID Desc"
			Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 Order By A.SoftTime Desc ,A.SoftID Desc"
			Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") Order By A.AllHits Desc ,A.SoftID Desc"
			Case 9
				If IsSqlDataBase = 1 Then
					foundstr = "ORDER BY newid()"
				Else
					foundstr = "ORDER BY  rnd(A.SoftID)"
				End If
		Case Else
			foundstr = "Order By A.SoftTime Desc ,A.SoftID Desc"
		End Select
		If CInt(stype) >= 3 And CLng(ClassID) = 0 Then
			foundstr = "Order By A.SoftTime Desc ,A.SoftID Desc"
		End If
		If CLng(SpecialID) <> 0 Then
			foundstr = "And A.SpecialID =" & CLng(SpecialID) & " " & foundstr
		End If
		SQL = " A.SoftID,A.ClassID,A.SoftName,A.SoftVer,A.AllHits,A.SoftTime,A.HtmlFileDate,A.isBest,A.SoftImage,"
		SQL = "select Top " & CInt(TopNum) & SQL & " C.ClassName,C.HtmlFileDir,C.UseHtml from [NC_SoftList] A inner join [NC_Classify] C On A.ClassID=C.ClassID where A.isAccept>0 And A.SoftImage<>'' And A.ChannelID=" & ChannelID & " " & foundstr & ""
		Set Rs = Newasp.Execute(SQL)
		If Rs.BOF And Rs.EOF Then
			strContent = "<img src='" & Newasp.InstallDir & "images/no_pic.gif' width=" & width & " height=" & height & " border=0>"
		Else
			strContent = "<table width=""100%"" border=""0"" cellpadding=""1"" cellspacing=""3"">" & vbCrLf
			n = 0
			'-- 是否启用幻灯片效果
			If slide>0 Then
				Set XMLDom=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
				XMLDom.appendChild(XMLDom.createElement("xml"))
				'-- 幻灯片效果基本设置
				Set Node=XMLDom.createNode(1,"setting","")
				Node.attributes.setNamedItem(XMLDom.createNode(2,"ChannelID","")).text = ChannelID
				Node.attributes.setNamedItem(XMLDom.createNode(2,"width","")).text = width
				Node.attributes.setNamedItem(XMLDom.createNode(2,"height","")).text = height
				If showtopic=1 Then
					Node.attributes.setNamedItem(XMLDom.createNode(2,"text_height","")).text = 20
				Else
					Node.attributes.setNamedItem(XMLDom.createNode(2,"text_height","")).text = 0
				End If
				Node.attributes.setNamedItem(XMLDom.createNode(2,"maxpic","")).text = TopNum
				Node.attributes.setNamedItem(XMLDom.createNode(2,"maxlen","")).text = strLen
				Node.attributes.setNamedItem(XMLDom.createNode(2,"path","")).text = Newasp.InstallDir
				Node.attributes.setNamedItem(XMLDom.createNode(2,"slidetype","")).text = slide
				XMLDom.documentElement.appendChild(Node)
			End If
			Do While Not Rs.EOF
				n = n + 1
				If slide>0 Then
					strSoftName = Newasp.GotTopic(Rs("SoftName") & " " & Rs("SoftVer"), CInt(strLen))
					SoftImage = Newasp.GetImageUrl(Rs("SoftImage"), Newasp.ChannelData(1))
					If CInt(Newasp.ChannelUseHtml) <> 0 Then
						HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("SoftID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
						HtmlFileUrl = ShowChannelPath(Newasp.ChannelPath, Rs("HtmlFileDir")) & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
					Else
						HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("SoftID")
					End If
					'-- 装幻灯片信息传递给XML节点
					Set Node=XMLDom.createNode(1,"slide","")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"slideid","")).text = n
					Node.attributes.setNamedItem(XMLDom.createNode(2,"classid","")).text = classid
					Node.attributes.setNamedItem(XMLDom.createNode(2,"title","")).text = Replace(strSoftName, "|", "")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"picurl","")).text = Replace(SoftImage, "|", "")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"url","")).text = Replace(HtmlFileUrl, "|", "")
					Node.attributes.setNamedItem(XMLDom.createNode(2,"addtime","")).text = Rs("SoftImage")
					XMLDom.documentElement.appendChild(Node)
				Else
					strContent = strContent & "<tr>" & vbCrLf
					For i = 1 To CInt(PerRowNum)
						strContent = strContent & "<td align=""center"" class=""imagelist"">"
						If Not Rs.EOF Then
							strSoftName = Newasp.GotTopic(Rs("SoftName") & " " & Rs("SoftVer"), CInt(strLen))
							SoftImage = Newasp.GetImageUrl(Rs("SoftImage"), Newasp.ChannelData(1))
							SoftImage = Newasp.GetFlashAndPic(SoftImage, height, width)
							HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("SoftID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
							If CInt(Newasp.ChannelUseHtml) <> 0 Then
								HtmlFileUrl = ShowChannelPath(Newasp.ChannelPath, Rs("HtmlFileDir")) & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
							Else
								HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("SoftID")
							End If
							If CInt(newindow) <> 0 Then
								LinkTarget = " target=""_blank"""
							Else
								LinkTarget = ""
							End If
							strContent = strContent & Newasp.MainSetting(19)
							strContent = Replace(strContent, "{$SoftPicture}", "<a href='" & HtmlFileUrl & "' title='" & Rs("SoftName") & " " & Rs("SoftVer") & "'" & LinkTarget & ">" & SoftImage & "</a>")
							If CInt(showtopic) = 1 Then
								strContent = Replace(strContent, "{$SoftTopic}", "<a href='" & HtmlFileUrl & "' title='" & Rs("SoftName") & " " & Rs("SoftVer") & "'" & LinkTarget & ">" & strSoftName & "</a>")
							Else
								strContent = Replace(strContent, "{$SoftTopic}", vbNullString)
							End If
							strContent = strContent & "</td>" & vbCrLf
						Rs.MoveNext