cls_public.asp

网络上经典的图片程序

			If IsSqlDataBase = 1 Then
				foundstr = "ORDER BY newid()"
			Else
				foundstr = "ORDER BY  rnd(A.flashid)"
			End If
		Case Else
			foundstr = "Order By A.addTime Desc ,A.flashid Desc"
		End Select
		If CInt(stype) >= 3 And CLng(ClassID) = 0 Then
			foundstr = "Order By A.addTime Desc ,A.flashid Desc"
		End If
		If CLng(SpecialID) <> 0 Then
			foundstr = "And A.SpecialID =" & CLng(SpecialID) & " " & foundstr
		End If
		SQL = " A.flashid,A.ClassID,A.ColorMode,A.FontMode,A.title,A.Author,A.AllHits,A.addTime,A.HtmlFileDate,A.isBest,"
		SQL = "SELECT TOP " & CInt(TopNum) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir,C.UseHtml FROM [NC_FlashList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & ChannelID & " " & foundstr & ""
		
		Set Rs = Server.CreateObject("ADODB.Recordset")
		Rs.Open SQL,Conn,1,1
		j = 0
		
		If Rs.BOF And Rs.EOF Then
			strContent = "没有添加任何软件！"
		Else
			SQL=Rs.GetRows(-1)
			strContent = "<table width=""100%"" border=0 cellpadding=2 cellspacing=0>"
			For i=0 To Ubound(SQL,2)
				If (j Mod 2) = 0 Then
					ListStyle = Trim(styles) & 1
				Else
					ListStyle = Trim(styles) & 2
				End If
				If CInt(SQL(9,i)) <> 0 Then
					BestCode = 2
					BestString = "<font color='" & Newasp.MainSetting(3) & "'>推荐</font>"
				Else
					BestCode = 1
					BestString = ""
				End If
				If showclass > 0 Then
					ClassLength = Newasp.strLength(SQL(10,i))
				Else
					ClassLength = 0
				End If
				strContent = strContent & Newasp.MainSetting(22)
				strTitle = Newasp.GotTopic(SQL(4,i), CInt(strLen) - ClassLength)
				strTitle = Newasp.ReadFontMode(strTitle, SQL(2,i), SQL(3,i))
				ClassName = Newasp.ReadFontMode(SQL(10,i), SQL(11,i), SQL(12,i))
				HtmlFileName = Newasp.ReadFileName(SQL(8,i), SQL(0,i), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
				If CInt(Newasp.ChannelUseHtml) <> 0 Then
					HtmlFileUrl = Newasp.ChannelPath & SQL(13,i) & Newasp.ShowDatePath(SQL(8,i), Newasp.ChannelHtmlPath) & HtmlFileName
					ClassName = "<a href='" & Newasp.ChannelPath & SQL(13,i) & "index" & Newasp.ChannelHtmlExt & "'>" & ClassName & "</a>"
				Else
					HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & SQL(0,i)
					ClassName = "<a href='" & Newasp.ChannelPath & "list.asp?classid=" & SQL(1,i) & "'>" & ClassName & "</a>"
				End If
				If CInt(showclass) = 0 Then ClassName = ""
				If CInt(showdate) <> 0 Then
					addTime = Newasp.ShowDateTime(SQL(7,i), CInt(DateMode))
				Else
					addTime = ""
				End If
				If CInt(newindow) <> 0 Then
					LinkTarget = " target=""_blank"""
				Else
					LinkTarget = ""
				End If
				FlashTopic = "<a href='" & HtmlFileUrl & "'" & LinkTarget & " class=""showlist"""& LoadRemark(SQL(4,i)) &">" & strTitle & "</a>"
				strContent = Replace(strContent, "{$FlashTopic}", FlashTopic)
				strContent = Replace(strContent, "{$FlashID}", Rs("flashid"))
				strContent = Replace(strContent, "{$InstallDir}", Newasp.InstallDir)
				strContent = Replace(strContent, "{$FlashTopic}", strTitle)
				strContent = Replace(strContent, "{$Title}", SQL(4,i))
				strContent = Replace(strContent, "{$DateAndTime}", SQL(7,i))
				strContent = Replace(strContent, "{$HtmlFileUrl}", HtmlFileUrl)
				strContent = Replace(strContent, "{$ClassName}", ClassName)
				strContent = Replace(strContent, "[]", "")
				strContent = Replace(strContent, "{$Target}", LinkTarget)
				strContent = Replace(strContent, "{$addTime}", addTime)
				strContent = Replace(strContent, "{$FlashHits}", SQL(6,i))
				strContent = Replace(strContent, "{$ListStyle}", ListStyle)
				strContent = Replace(strContent, "{$BestCode}", BestCode)
				strContent = Replace(strContent, "{$BestString}", BestString)
			j = j + 1
			Next
			SQL=Null
			strContent = strContent & "</table>"
		End If
		Rs.Close: Set Rs = Nothing
		LoadFlashList = strContent
	End Function
	'================================================
	'函数名：ReadFlashList
	'作  用：读取动画列表
	'参  数：str ----原字符串
	'================================================
	Public Function ReadFlashList(ByVal str)
		Dim strTemp, i
		Dim sTempContent, nTempContent
		Dim arrTempContent, arrTempContents, ArrayList
		On Error Resume Next
		strTemp = str
		If InStr(strTemp, "{$ReadFlashList(") > 0 Then
			sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadFlashList(", ")}", 1)
			nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadFlashList(", ")}", 0)
			arrTempContents = Split(sTempContent, "|||")
			arrTempContent = Split(nTempContent, "|||")
			For i = 0 To UBound(arrTempContents)
				ArrayList = Split(arrTempContent(i), ",")
				strTemp = Replace(strTemp, arrTempContents(i), LoadFlashList(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10)))
			Next
		End If
		ReadFlashList = strTemp
	End Function
	'================================================
	'函数名：LoadAnnounceContent
	'作  用：装载内容公告
	'参  数：str ----原字符串
	'================================================
	Public Function LoadAnnounceContent(ByVal sTopic, ByVal ChannelID)
		Dim SQL, Rs, strTemp
		strTemp = ""
		sTopic = Newasp.CheckStr(sTopic)
		If sTopic <> "" And sTopic <> "0" Then
			SQL = "Select AnnounceID,Content,PostTime,writer From NC_Announce where AnnounceType=1 And title = '" & sTopic & "' Order By PostTime Desc,AnnounceID Desc"
		Else
			SQL = "Select AnnounceID,Content From NC_Announce where AnnounceType=1 And ChannelID in (" & ChannelID & ",999) Order By PostTime Desc,AnnounceID Desc"
		End If
		Set Rs = Newasp.Execute(SQL)
		If Not (Rs.BOF And Rs.EOF) Then
			strTemp = Rs("Content")
		End If
		Rs.Close: Set Rs = Nothing
		LoadAnnounceContent = strTemp
	End Function
	'================================================
	'函数名：ReadAnnounceContent
	'作  用：读取内容公告
	'参  数：str ----原字符串
	'================================================
	Public Function ReadAnnounceContent(ByVal str, ByVal ChannelID)
		Dim strTemp, i, sTempContent, nTempContent, strValue
		Dim arrTempContent, arrTempContents
		On Error Resume Next
		strTemp = str
		If InStr(strTemp, "{$AnnounceContent(") > 0 Then
			sTempContent = Newasp.CutMatchContent(strTemp, "{$AnnounceContent(", ")}", 1)
			nTempContent = Newasp.CutMatchContent(strTemp, "{$AnnounceContent(", ")}", 0)
			If nTempContent = "" Then nTempContent = "0"
			arrTempContents = Split(sTempContent, "|||")
			arrTempContent = Split(nTempContent, "|||")
			For i = 0 To UBound(arrTempContents)
				strValue = arrTempContent(i)
				strTemp = Replace(strTemp, arrTempContents(i), LoadAnnounceContent(strValue, ChannelID))
			Next
		End If
		ReadAnnounceContent = strTemp
	End Function
	'================================================
	'函数名：LoadAnnounceList
	'作  用：装载公告列表
	'参  数：maxnum ----最多公告数
	'        maxlen ----字符长度
	'        newindow ----是否新窗口打开 1=是，0=否
	'        showdate ----是否显示时间 1=是，0=否
	'        DateMode ----时间模式
	'        showtree ----树型显示
	'================================================
	Public Function LoadAnnounceList(ByVal ChannelID, ByVal maxnum, ByVal maxlen, _
		ByVal newindow, ByVal showdate, ByVal DateMode, ByVal showtree)
		
		Dim Rs, SQL, strContent
		Dim AnnounceTopic, LinkTarget
		Dim PostTime
		
		ChannelID = Newasp.ChkNumeric(ChannelID)
		maxnum = Newasp.ChkNumeric(maxnum)
		If maxnum = 0 Then maxnum = 10
		
		On Error Resume Next
		Set Rs = Newasp.Execute("SELECT TOP " & CInt(maxnum) & " AnnounceID,title,Content,PostTime,writer,hits FROM NC_Announce WHERE (ChannelID=" & ChannelID & " Or ChannelID=999) And AnnounceType<>1 ORDER BY PostTime DESC,AnnounceID DESC")
		If Rs.BOF And Rs.EOF Then
			LoadAnnounceList = ""
			Set Rs = Nothing
			Exit Function
		Else
			Do While Not Rs.EOF
				If CInt(newindow) <> 0 Then
					LinkTarget = " target=""_blank"""
				Else
					LinkTarget = ""
				End If
				If CInt(showdate) <> 0 Then
					PostTime = Newasp.ShowDateTime(Rs("PostTime"), CInt(DateMode))
				Else
					PostTime = ""
				End If
				AnnounceTopic = Newasp.GotTopic(Rs("title"), CInt(maxlen))
				AnnounceTopic = "<a href=""" & Newasp.InstallDir & "Announce.Asp?AnnounceID=" & Rs("AnnounceID") & """ title=""" & Rs("title") & """" & LinkTarget & ">" & AnnounceTopic & "</a>"
				If CInt(showtree) = 1 Then
					strContent = strContent & "<div>· " & AnnounceTopic & "</div><div align=""right"" class=""dottedline"">" & PostTime & "</div>" & vbNewLine
				Else
					strContent = strContent & "· " & AnnounceTopic & "&nbsp;&nbsp;" & PostTime & vbNewLine
				End If
				Rs.MoveNext
			Loop
		End If
		LoadAnnounceList = strContent
	End Function
	'================================================
	'函数名：ReadAnnounceList
	'作  用：读取公告列表
	'参  数：str ----原字符串
	'================================================
	Public Function ReadAnnounceList(ByVal str)
		Dim strTemp, i
		Dim sTempContent, nTempContent, ArrayList
		Dim arrTempContent, arrTempContents
		On Error Resume Next
		strTemp = str
		If InStr(strTemp, "{$ReadAnnounceList(") > 0 Then
			sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadAnnounceList(", ")}", 1)
			nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadAnnounceList(", ")}", 0)
			arrTempContents = Split(sTempContent, "|||")
			arrTempContent = Split(nTempContent, "|||")
			For i = 0 To UBound(arrTempContents)
				ArrayList = Split(arrTempContent(i), ",")
				strTemp = Replace(strTemp, arrTempContents(i), LoadAnnounceList(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6)))
			Next
		End If
		ReadAnnounceList = strTemp
	End Function
	'================================================
	'函数名：LoadArticlePic
	'作  用：装载文章图片列表
	'参  数：ClassID   ----分类ID
	'        ChannelID   ----频道ID
	'        sType   ----调用文章类型,0=所有最新文章，1=推荐文章，2=热门文章，3=图文文章，4=分类最新文章
	'        TopNum   ----显示文章列表数
	'        strlen   ----显示标题长度
	'        ShowClass   ----是否显示分类
	'        ShowPic   ----是否显示图文标题
	'        ShowDate   ----是否显示日期
	'        DateMode   ----显示日期模式
	'        newindow   ----新窗口打开
	'================================================
	Public Function LoadArticlePic(ChannelID, ClassID, SpecialID, stype, TopNum, PerRowNum, strLen, newindow, width, height, showtopic, slide)
		Dim Rs, SQL, i, strContent, foundstr, n
		Dim sTitle, ChildStr, ImageUrl, HtmlFileName
		Dim HtmlFileUrl, WriteTime, 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
				LoadArticlePic = ""
				Exit Function
			Else
				ChildStr = Rs("ChildStr")
			End If
			Set Rs = Nothing
		Else
			ChildStr = 0
		End If
		Select Case CInt(stype)
			Case 0: foundstr = "Order By A.Writetime Desc ,A.Articleid Desc"
			Case 1: foundstr = "And A.isBest > 0 Order By A.Writetime Desc ,A.Articleid Desc"
			Case 2: foundstr = "Order By A.AllHits Desc ,A.Articleid Desc"
			Case 3: foundstr = "And A.ClassID in (" & ChildStr & ") Order By A.Writetime Desc ,A.Articleid Desc"
			Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 Order By A.Writetime Desc ,A.Articleid Desc"
			Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") Order By A.AllHits Desc ,A.Articleid Desc"