cl_getjscontent.asp

淘客网上商店网站程序 淘客网上商店网站程序 淘客网上商店网站程序

<%
'Rem 文章
Function GetJsContent(ByVal sModuleID,Byval sChannelID,Byval sClassID,Byval sSpecialID,Byval TopNum,Byval IncludeChild,Byval ShowType, _
Byval ColsNum,Byval IsHot,Byval IsElite,Byval DateNum,Byval OrderType,Byval Style1,Byval Style2,Byval Style3,Byval Style4)
	Dim Rs,SQL,i
	Dim CurrentSiteUrl
	Dim ContentStr,ItemStr
	Dim regEx,Matches,Match,ValueStr
	Dim DataStr,PicUrlStr,PicExt
	CurrentSiteUrl	= "http://"&Request.servervariables("Server_Name") & Cl.WebDir
	On Error Resume Next
	sModuleID		= CLng(sModuleID)
	sChannelID		= Clng(sChannelID)
	sClassID		= Clng(sClassID)
	sSpecialID		= Clng(sSpecialID)
	TopNum			= Clng(TopNum)
	IncludeChild	= CBool(IncludeChild)
	ShowType		= Clng(ShowType)
	ColsNum			= Clng(ColsNum)
	IsHot			= CBool(IsHot)
	IsElite			= CBool(IsElite)
	DateNum			= CLng(DateNum)
	OrderType		= CLng(OrderType)
	Style1			= Trim(Style1)
	Style2			= Trim(Style2)
	Style3			= Trim(Style3)
	Style4			= Trim(Style4)
	if Err then Err.Clear : GetJsContent="Js参数错误。":Exit Function
	On Error GoTo 0
	if TopNum > 0 then
		SQL="select top " & TopNum & " "
	else
		SQL="select top 100 "
	end If
	Select Case sModuleID
	Case 1 : SQL = SQL & " * from Cl_Article "
	Case 2 : SQL = SQL & " * from Cl_Soft "
	Case 3 : SQL = SQL & " * from Cl_Photo "
	Case 4 : SQL = SQL & " * from Cl_Movie "
	Case 5 : SQL = SQL & " * from Cl_Product "
	Case 6 : SQL = SQL & " * from Cl_Supply "
	Case Else : SQL = SQL & " * from Cl_Article "
	End Select
	SQL = SQL & " where Deleted="&FalseType&" and Status=1"
	if sClassID>0 then
		if IncludeChild=True then
			Dim Node
			set Node = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&sClassID&"]")
			if Node Is Nothing then
				SQL = SQL & " and ClassID=" & sClassID & ""
			else
				SQL = SQL & " and ClassID in (" & Node.selectSingleNode("@arrchildid").text & ")"
			end if
			Set Node = Nothing
		else
			SQL = SQL & " and ClassID=" & sClassID & ""
		end if
	ElseIf sChannelID>0 Then
		SQL = SQL & " and ChannelID="&sChannelID&""
	End if
	if sSpecialID>0 then SQL = SQL & " and SpecialID like '%," & SpecialID & ",%'"
	if ShowType >= 2 then SQL = SQL & " and PicUrl<>''"
	if IsHot=True then SQL = SQL & " and Hits>="&Clng(Cl.Web_Setting(14))&""
	if IsElite=True then SQL = SQL & " and Elite="&TrueType&""
	if DateNum>0 then
		if IsSqlDatabase=1 then
			SQL = SQL & " and datediff(d,UpdateTime,"&SQLNowString&")<=" & DateNum & " "
		else
			SQL = SQL & " and datediff('d',UpdateTime,"&SQLNowString&")<=" & DateNum & " "
		end if
	end if
	SQL = SQL & " order by OnTop asc"
	Select Case OrderType
	Case 1 : SQL = SQL & " ,InfoID desc"
	Case 2 : SQL = SQL & " ,InfoID asc"
	Case 3 : SQL = SQL & " ,UpDateTime desc, InfoID desc"
	Case 4 : SQL = SQL & " ,UpDateTime asc, InfoID desc"
	Case 5 : SQL = SQL & " ,Hits desc, InfoID desc"
	Case 6 : SQL = SQL & " ,Hits asc, InfoID desc"
	Case else : SQL = SQL & " ,InfoID desc"
	End Select
	Set Rs = Cl.Execute(SQL)
	if Rs.bof and Rs.eof then
		ContentStr = "<li>当前没有记录！</li>"
	else
		Set regEx	= New RegExp
		regEx.Pattern = "{\$.[^{\$}]*}"
		regEx.IgnoreCase = True
		regEx.Global = True
		Do While Not Rs.Eof
			ItemStr	= Style2
			Set Matches = regEx.Execute(ItemStr)
			For Each Match in Matches
				ValueStr = Replace(Match.Value,"{$","")
				ValueStr = Replace(ValueStr,"}","")
				ValueStr = Replace(ValueStr,"(",",")
				ValueStr = Replace(ValueStr,")","")
				ValueStr = Split(ValueStr,",")
				Select Case LCase(ValueStr(0))
				Case "linkurl"
					if Rs("IsHtml")=True then
						DataStr = CurrentSiteUrl & Rs("HtmlFileUrl")
					Else
						DataStr = CurrentSiteUrl & Rs("ChannelDir") & "/ShowInfo.asp?InfoID=" & Rs("InfoID")
						If sModuleID=1 Then
							if Rs("IsLink")=True Then DataStr = Rs("HtmlFileUrl")
						End if
					end if
				Case "propertyimg"
					If Rs("OnTop")=True Then
						DataStr = "<img src=""" & CurrentSiteUrl & "Images/Ontop.gif"" alt=""固顶"" />"
					ElseIf Rs("Elite")=True Then
						DataStr = "<img src=""" & CurrentSiteUrl & "Images/Elite.gif"" alt=""推荐"" />"
					Else 
						DataStr = "<img src=""" & CurrentSiteUrl & "Images/Common.gif"" alt=""普通"" />"
					End If 
				Case "classname" : DataStr = Cl.GetClassName(Rs("InfoID"))
				Case "classurl","classlinkurl" : DataStr = Cl.GetClassLinkUrl(Rs("InfoID"))
				Case "authorname"
					if InStr(Rs("authorname"),"|")>0 then
						DataStr	= Split(Rs("authorname"),"|")(0)
					else
						DataStr	= Rs("authorname") & ""
					end if
				Case "title","softname","photoname","moviename","productname"
					DataStr = Rs(ValueStr(0))
					If UBound(ValueStr)>0 Then DataStr = Cl.GotTopic(DataStr,ValueStr(1))
					DataStr = Cl.GetTitleFont(DataStr,Rs("FontType"))
					DataStr = Cl.FormatColor(DataStr,Rs("FontColor"))
				Case "showpic","imgurl"
					PicUrlStr = Cl.GetPicUrl(Rs("PicUrl") & "")
					PicExt = Right(LCase(PicUrlStr),3)
					Select Case PicExt
					Case "swf"
						DataStr = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0"" width=""{$ImgWidth}"" height=""{$ImgHeight}""><param name=""movie"" value=""" & PicUrlStr & """><param name=""quality"" value=""high""><embed src=""" & PicUrlStr & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""{$ImgWidth}"" height=""{$ImgHeight}""></embed></object>"
					Case "jpg", "bmp", "png", "gif"
						DataStr = "<img src=""" & PicUrlStr & """ width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=""0"" alt=""缩略图"" />"
					Case Else
						DataStr = "<img src=""" & CurrentSiteUrl & "Images/NoPic2.jpg"" width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=""0"" alt=""缩略图"" />"
					End Select
					DataStr	 = Replace(DataStr,"{$ImgWidth}",ValueStr(1))
					DataStr	 = Replace(DataStr,"{$ImgHeight}",ValueStr(2))
				Case "intro","showintro"
					DataStr = Rs("Intro") & ""
					If UBound(ValueStr)>0 Then DataStr = Left(DataStr,ValueStr(1))
				Case "updatetime"
					DataStr = Rs("updatetime") & ""
					If UBound(ValueStr)>0 Then DataStr = Cl.Format_Time(DataStr,ValueStr(1))
				Case Else
					DataStr = Rs(ValueStr(0)) & ""
				End Select
				ItemStr = Replace(ItemStr,Match.Value,DataStr)
			Next
			ContentStr = ContentStr & ItemStr
			if (i+1) mod ColsNum=0 then ContentStr = ContentStr & Style3
			Rs.MoveNext
		Loop
	End If
	Rs.close:set Rs=Nothing
	Set Matches = Nothing : Set regEx = Nothing
	GetJsContent = Style1 & ContentStr & Style4
End Function
%>