cl_clstemplate.asp

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

	Public Function ReplaceCl_ElseIf(Byval sContent)
		'On Error Resume next
		Dim Matches,Match,ValueContent,ValueIf,ContentStr
		regEx.Pattern	= "(.[^\[\]]*)\[Cl_Else:(.[^\[\]]*)\](.[^\\]*)"
		Set Matches		= regEx.Execute(sContent)
		For Each Match in Matches
			ValueIf			= regEx.Replace(Match.Value,"$2")
			ValueIf			= Replace(ValueIf,"'","")
			ValueContent	= regEx.Replace(Match.Value,"$3")
			if Eval(ValueIf) Then
				If InStr(ValueContent,"[Cl_Else")>0 Then
					ValueContent = Split(ValueContent,"[Cl_Else")
					ContentStr = ValueContent(0)
				Else
					ContentStr = ValueContent
				End if
			ElseIf InStr(ValueContent,"[Cl_Else:")>0 Then
				ContentStr = ReplaceCl_ElseIf(ValueContent)
			ElseIf InStr(ValueContent,"[Cl_Else]")>0 Then
				ValueContent = Split(ValueContent,"[Cl_Else]")
				ContentStr = ValueContent(1)
			Else
				ContentStr = ""
			End If
			sContent = Replace(sContent,Match.Value,ContentStr)
			ValueContent= Empty
			ValueIf		= Empty
			ContentStr	= Empty
		Next
		Set Matches	= Nothing
		ReplaceCl_ElseIf = sContent
	End Function

	Rem 处理创力[Cl_Rs:]标签
	Public Function ReplaceCl_Rs(Byval sContent)
		On Error Resume next
		Dim Matches,Match,TempValue
		regEx.Pattern	= "\[Cl_Rs:(.[^\[\]]*)\]"
		Set Matches		= regEx.Execute(sContent)
		For Each Match in Matches
			TempValue = regEx.Replace(Match.Value,"$1")
			TempValue = Rs(""&TempValue&"")
			If Err Then
			Err.Clear
			else
			sContent = Replace(sContent,Match.Value,TempValue&"")
			End if
			TempValue= Empty
		Next
		Set Matches	= Nothing
		ReplaceCl_Rs = sContent
	End Function

	Rem 处理创力[Cl_Request:]标签
	Public Function ReplaceCl_Request(Byval sContent)
		'On Error Resume next
		Dim Matches,Match,TempValue
		regEx.Pattern	= "\[Cl_Request:(.[^\[\]]*)\]"
		Set Matches		= regEx.Execute(sContent)
		For Each Match in Matches
			TempValue= regEx.Replace(Match.Value,"$1")
			sContent = Replace(sContent,Match.Value,Request(""&TempValue&"")&"")
			TempValue= Empty
		Next
		Set Matches	= Nothing
		ReplaceCl_Request = sContent
	End Function

	Public Function ReplaceInfoLoop(ByVal sModuleID,ByVal sContent,ByVal TopNum,ByVal sWhere)
		Dim SQLInfo,WhereStr,TopStr,XMLData,Node
		Dim strTemp,ContentStr,ReplaceStr,LoopStr
		Dim Matches,Match,TempValue,DataStr,sModule
		'sContent = ReplaceCl_If(sContent)
		ReplaceInfoLoop = sContent
		If InStr(sContent,"[Cl_InfoLoop]")<0 Then Exit Function
		LoopStr = GetPartContent(sContent,"[Cl_InfoLoop]","[/Cl_InfoLoop]")
		ReplaceStr = "[Cl_InfoLoop]" & LoopStr & "[/Cl_InfoLoop]"
		If LoopStr = "" Then Exit Function
		LoopStr = Trim(LoopStr)
		WhereStr = " where ChannelID="&ChannelID&" and Deleted="&FalseType&" and Status=1 "
		if ClassID>0 then
			WhereStr=WhereStr & " and ClassID in (" & Replace(arrChildID,"|",",") & ") "
		end If
		WhereStr = WhereStr & sWhere
		If CLng(TopNum)>0 Then TopStr = "Top "&TopNum
		SQLInfo="select " & TopStr & " InfoID, ChannelID, ChannelDir, ClassID, Prefixion, "
		Select Case CLng(sModuleID)
		Case 1
		SQLInfo = SQLInfo & "Title, FontColor, FontType, TitleIntact, Keyword, Author, CopyFrom, Editor, UpdateTime, Censor, CensorTime, Stars, OnTop, Hot, Elite, Hits, DayHits, WeekHits, MonthHits, InfoGroup, InfoPoint, InfoMoney, PicUrl, Intro, Receive, ReceiveType, IsLink, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Article "
		sModule = "article"
		Case 2
		SQLInfo = SQLInfo & "SoftName, FontColor, FontType, SoftVersion, Keyword, Author, AuthorEmail, DemoUrl, RegUrl, Editor, UpdateTime, Censor, CensorTime, Stars, OnTop, Hot, Elite, Hits, DayHits, WeekHits, MonthHits, InfoGroup, InfoPoint, InfoMoney, Intro, PicUrl, SoftPassword, OperatingSystem, SoftSize, SoftType, SoftLanguage, CopyrightType, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Soft "
		sModule = "soft"
		Case 3
		SQLInfo = SQLInfo & "PhotoName, FontColor, FontType, Keyword, Author, AuthorEmail, AuthorHomepage, Editor, UpdateTime, Censor, CensorTime, Stars, OnTop, Hot, Elite, Hits, DayHits, WeekHits, MonthHits, InfoGroup, InfoPoint, InfoMoney, Intro, PicUrl, IsDownLoad, DownLoadNum, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Photo "
		sModule = "photo"
		Case 4
		SQLInfo = SQLInfo & "MovieName, FontColor, FontType, Keyword, Director, ActName, Editor, UpdateTime, Censor, CensorTime, Stars, OnTop, Hot, Elite, Hits, DayHits, WeekHits, MonthHits, DownNums, InfoGroup, InfoPoint, InfoMoney, IsOnLine, IsDownLoad, Intro, PicUrl, MovieFormat, MovieLong, MovieCorner, MovieLanguage, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Movie "
		sModule = "movie"
		Case 5
		SQLInfo = SQLInfo & "ProductName, FontColor, FontType, ProductSn, Keyword, Producer, Trademark, ProductModel, ProductUnit, Editor, UpdateTime, Censor, CensorTime, Stars, OnTop, Hot, Elite, Hits, DayHits, WeekHits, MonthHits, InfoGroup, InfoPoint, MarketPrice, MemberPrice, TruePrice, Discount, PresentExp, Intro, PicUrl, ProductType, CardPoint, StockNum, BuyTimes, BeginDate, EndDate, NoOver, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Product "
		sModule = "product"
		Case 6
		SQLInfo = SQLInfo & "Title, FontColor, FontType, Keyword, SupplyType, CompanyName, LinkMan, LinkAddress, LinkZipCode, LinkPhone, LinkFax, LinkMobile, LinkEmail, LinkQQ, ValidTime, Editor, UpdateTime, Censor, CensorTime, Stars, OnTop, Hot, Elite, Hits, DayHits, WeekHits, MonthHits, InfoGroup, InfoPoint, InfoMoney, PicUrl, Intro, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Supply "
		sModule = "supply"
		Case Else
			sContent = Replace(sContent,ReplaceStr,"")
			ReplaceInfoLoop = Replace(sContent,"{$showpage}","")
			Exit Function
		End Select
		if IsSqlDataBase=1 then
		SQLInfo = SQLInfo & WhereStr & " order by OnTop Desc,UpdateTime desc,InfoID desc"
		else
		SQLInfo = SQLInfo & WhereStr & " order by OnTop Asc,UpdateTime desc,InfoID desc"
		end If
		Set rsInfo = Server.CreateObject("Adodb.recordSet")
		OpenConn : rsInfo.Open SQLInfo,Conn,1,1
		if rsInfo.bof and rsInfo.eof then
			sContent = Replace(sContent,ReplaceStr,"")
			ReplaceInfoLoop = Replace(sContent,"{$showpage}","")
			rsInfo.Close : Set rsInfo=Nothing : Exit Function
		End if
		'Dim rsTotalPut
		'Set rsTotalPut= Cl.Execute("Select count(InfoID) from Cl_Soft " & WhereStr)
		'TotalPut = rsTotalPut(0)
		'rsTotalPut.Close : Set rsTotalPut=Nothing
		TotalPut = rsInfo.RecordCount
		if (TotalPut mod PageSize)=0 then
			TotalPages = TotalPut \ PageSize
		else
			TotalPages = TotalPut \ PageSize + 1
		end if
		if CurrentPage > TotalPages then CurrentPage=TotalPages
		if CurrentPage < 2 Then
			CurrentPage=1
		else
			rsInfo.move (CurrentPage-1)*PageSize
		End if
		Set XMLData = Cl.ArrayToXml(rsInfo.GetRows(PageSize),rsInfo,"info","infolist")
		rsInfo.Close : Set rsInfo=Nothing
		For Each Node In XMLData.DocumentElement.SelectNodes("info")
			ContentStr = ContentStr & ReplaceInfoContent(sModule,LoopStr,Node)
		Next
		Set Node = Nothing
		Set XMLData = Nothing
		ReplaceInfoLoop = Replace(sContent,ReplaceStr,ContentStr)
		ContentStr = Empty : ReplaceStr = Empty : LoopStr = Empty
	End Function

	Public Function ReplaceInfoContent(ByVal sModule,ByVal LoopTemplate,Byval Node)
		Dim Matches,Match
		Dim sTemp,ArrayStr,DataStr
		Dim IregEx
		sTemp = LoopTemplate
		Set IregEx	= New RegExp
		IregEx.IgnoreCase= True
		IregEx.Global	= True
		IregEx.Pattern	= "{\$.[^{\$}]*}"
		Set Matches		= IregEx.Execute(sTemp)
		On Error Resume Next
		For Each Match in Matches
			ArrayStr	= Match.Value
			ArrayStr	= Replace(ArrayStr,"{$","")
			ArrayStr	= Replace(ArrayStr,"}","")
			ArrayStr	= Replace(ArrayStr,"(",",")
			ArrayStr	= Replace(ArrayStr,")","")
			ArrayStr	= Replace(ArrayStr,Chr(34),"")
			ArrayStr	= Split(ArrayStr,",")
			ArrayStr(0) = LCase(ArrayStr(0))
			Select Case ArrayStr(0)
			Case "linkurl"
				if CBool(Node.SelectSingleNode("@ishtml").text) = True then
					DataStr = InstallDir & Node.SelectSingleNode("@htmlfileurl").text
				else
					DataStr = InstallDir & Node.SelectSingleNode("@channeldir").text & "/ShowInfo.asp?InfoID=" & Node.SelectSingleNode("@infoid").text
				end If
			Case "ontopicon"
				if CBool(Node.SelectSingleNode("@ontop").text) = True then
					DataStr = "<img src=""" & InstallDir & "Images/"&sModule&"Ontop.gif"" alt=""固顶"" />"
				end if
			Case "propertyimg","attribute","propertyicon"
				if CBool(Node.SelectSingleNode("@ontop").text) = True then
					DataStr = "<img src=""" & InstallDir & "Images/"&sModule&"Ontop.gif"" alt=""固顶"" /> "
				End if
				if CBool(Node.SelectSingleNode("@elite").text) = True then
					DataStr = DataStr & "<img src=""" & InstallDir & "Images/"&sModule&"Elite.gif"" alt=""推荐"" />"
				else
					DataStr =  DataStr & "<img src=""" & InstallDir & "Images/"&sModule&"Common.gif"" alt=""普通"" />"
				end if
			Case "classurl" : DataStr = Cl.GetClassLinkUrl(Node.SelectSingleNode("@classid").text)
			Case "classname" : DataStr = Cl.GetClassName(Node.SelectSingleNode("@classid").text)
			Case "authorname"
				if instr(Node.SelectSingleNode("@author").text,"|")>0 then
					DataStr	= Split(Node.SelectSingleNode("@author").text,"|")(0)
				else
					DataStr	= Node.SelectSingleNode("@author").text
				end if
			Case "authoremail"
				if instr(Node.SelectSingleNode("@author").text,"|")>0 then
					DataStr	= Split(Node.SelectSingleNode("@author").text,"|")(1)
				else
					DataStr	= ""
				end if
			Case "title","softname","photoname","moviename","productname"
				If UBound(ArrayStr)<1 Then
				DataStr = Node.SelectSingleNode("@" & ArrayStr(0)).text
				else
				DataStr = Cl.GotTopic(Node.SelectSingleNode("@" & ArrayStr(0)).text,ArrayStr(1))
				DataStr = Cl.GetTitleFont(DataStr,Node.SelectSingleNode("@fonttype").text)
				DataStr = Cl.FormatColor(DataStr,Node.SelectSingleNode("@fontcolor").text)
				End If
			Case "titlewithfont"
				If UBound(ArrayStr)<1 Then
				DataStr = Node.SelectSingleNode("@" & ArrayStr(0)).text
				else
				DataStr = Cl.GotTopic(Node.SelectSingleNode("@" & ArrayStr(0)).text,ArrayStr(1))
				End If
				DataStr = Cl.GetTitleFont(DataStr,Node.SelectSingleNode("@fonttype").text)
				DataStr = Cl.FormatColor(DataStr,Node.SelectSingleNode("@fontcolor").text)
			Case "showpic"
				Dim sImgUrl,sPicUrl
				sPicUrl  = Cl.GetPicUrl(Node.SelectSingleNode("@picurl").text)
				Select Case right(lcase(sPicUrl),3)
				Case "swf"
					sImgUrl = "<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=""" & sPicUrl & """><param name=""quality"" value=""high""><embed src=""" & sPicUrl & """ 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"
					sImgUrl = "<img src=""" & sPicUrl & """ width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=""0"" />"
				Case Else
					sImgUrl = "<img src=""" & InstallDir & "images/NoPic.jpg"" width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=""0"" alt="""" />"
				End Select
				sImgUrl	 = Replace(sImgUrl,"{$ImgWidth}",ArrayStr(1))
				DataStr	 = Replace(sImgUrl,"{$ImgHeight}",ArrayStr(2))
			Case "picurl"
				if Trim(Node.SelectSingleNode("@picurl").text)="" then
					DataStr = InstallDir & "images/nopic.gif"
				else
					DataStr = Node.SelectSingleNode("@picurl").text
				end If
			Case "intro"
				If UBound(ArrayStr)<1 Then
				DataStr = Node.SelectSingleNode("@intro").text
				Else
				DataStr = Left(Cl.NoHTML(Node.SelectSingleNode("@intro").text&""),ArrayStr(1))
				End if
			Case "updatetime"
				If UBound(ArrayStr)<1 Then
				DataStr = Node.SelectSingleNode("@updatetime").text
				else
				DataStr = Cl.Format_Time(Node.SelectSingleNode("@updatetime").text,ArrayStr(1))
				End If
				if CDate(FormatDateTime(Node.SelectSingleNode("@updatetime").text,2))=Date() Then
				DataStr = "<span style=""color:#ff0033;"">"&DataStr&"</span>"
				End if