cl_clstemplate.asp

正版创力4.1SQL商业版!!!ASP版。

			Case "showuserlogin"
				if Ubound(ArrayStr) < 1 then
				DataStr = "<div id=""ShowUserLogin"">" & ShowUserLogin(0) & "</div>"
				Else
				DataStr = "<div id=""ShowUserLogin"">" & ShowUserLogin(ArrayStr(1)) & "</div>"
				end if
			Case "showjs"
				Dim Tn,TempsTr
				Randomize
				Tn=Int(9999*Rnd)+10000
				DataStr = "<div id=""T"&Tn&""">" & ArrayStr(1) & "</div>"
				TempsTr = "<div id=""Text"&Tn&""" style=""display:none"">"&ArrayStr(2)&"</div>"
				TempsTr = TempsTr & Vbcrlf & "<script type=""text/javascript"">" & Vbcrlf & "document.getElementById('T"&Tn&"').innerHTML=document.getElementById('Text"&Tn&"').innerHTML;" & Vbcrlf & "</script>"
				sContent = Replace(sContent,"</body>",TempsTr & Vbcrlf & "</body>")
				TempsTr = Empty
			Case "powered"
				if SysTemVersion>1 then
				DataStr = ""
				else
				DataStr = Cl.Language.selectSingleNode("//Powered").text & "<a href=""http://www.aspoo.cn/"" target=""_blank"">"&ClCMS_Version&"</a>"
				end if
			Case "runtime"
				if Trim(Cl.Web_Setting(0))="Yes" then
					DataStr = Replace(Cl.Language.selectSingleNode("//RunTime").text,"{$runtime}",Right(0&FormatNumber(Timer-PageBeginTime,3),5))' & "&nbsp&nbsp" & Replace(Cl.Language.selectSingleNode("//QueryNum").text,"{$querynum}",Cl.SqlQueryNum))
				else
					DataStr = ""
				end If
			Case "description"	: DataStr = Cl.DeScriptIon
			Case "keywords"		: DataStr = Replace(Cl.Keywords,"|",",")
			Case "web_info"		: DataStr = Cl.Web_Info(ArrayStr(1))
			Case "web_setting"	: DataStr = Cl.Web_Setting(ArrayStr(1))
			Case "copyright"	: DataStr = Cl.Web_info(9)
			Case "title"		: DataStr = Cl.Title
			Case "currentpath"	: DataStr = Cl.Path
			Case "webdir","installdir" : DataStr = InstallDir
			Case "channeldir"	: DataStr = Cl.ChannelDir
			Case "showarticlecontent" : DataStr = ShowArticleContent()
			Case "cssid"		: DataStr = Cl.CssID
			Case "webcss"
				DataStr = "<style type=""text/css"">"&vbCrlf& Css & vbCrlf &"</style>"
			Case "csspicurl"
				DataStr = Cl.WebDir & Cl.CssPicUrl
			Case "channelid","classid","classname","specialid","specialname","infoid"
				DataStr = Eval(ArrayStr(0))
			Case "showlinkclassmenu"
				DataStr = ShowLinkClassMenu(Cl.GetEval(ArrayStr(1)),ArrayStr(2),ArrayStr(3))
			Case "getclasslinkurl"
				DataStr = Cl.GetClassLinkUrl(Cl.GetEval(ArrayStr(1)))
			Case Else : DataStr = Match.Value
			End Select
			sContent	= Replace(sContent,Match.Value,DataStr)
			ArrayStr	= Empty
			DataStr		= Empty
			TempValue	= Empty
		Next
		Set Matches = Nothing
		ReplaceParameter = sContent
	End Function

	Public Function ReplaceFlag(Byval sContent,Byval FlagStr,Byval DataStr)
		'On Error Resume next
		Dim Matches,Match,TempValue
		regEx.Pattern	= "{\$("&FlagStr&")\((.[^{\$}]*)\)}"
		If DataStr="" Or IsNull(DataStr) Then
			Set Matches		= regEx.Execute(sContent)
			For Each Match in Matches
				DataStr = regEx.Replace(Match.Value,"$1") & "(" & regEx.Replace(Match.Value,"$2") & ")"
				DataStr = Replace(DataStr,",)",",0)")
				'Response.write DataStr
				'Response.end
				DataStr = Eval(DataStr)
				sContent = Replace(sContent,Match.Value,DataStr)
				DataStr = Empty
			Next
			Set Matches	= Nothing
		Else
			sContent=regEx.Replace(sContent,DataStr)
		End if
		ReplaceFlag	= sContent
	End Function

	Rem 处理创力[Cl_If]标签
	Public Function ReplaceCl_If(Byval sContent)
		'If InStr(sContent,"[Cl_If:")=0 Then
		'	ReplaceCl_If = sContent : Exit Function
		'End If
		'On Error Resume next
		Dim Matches,Match,ValueContent,ValueIf,ContentStr
		regEx.Pattern	= "\[Cl_If:(.[^\[\]]*)\](.[^\\]*)\[\/Cl_If\]"
		Set Matches		= regEx.Execute(sContent)
		For Each Match in Matches
			ValueIf			= regEx.Replace(Match.Value,"$1")
			ValueIf			= Replace(ValueIf,"'","")
			ValueContent	= regEx.Replace(Match.Value,"$2")
			'Response.write ValueContent
			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_If = sContent
	End Function

	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 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"