cl_clstemplate.asp

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

<%
'===================================================
' CreateLive CMS Version 4.0
'							Powered by Aspoo.CoM
'===================================================
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2007 Aspoo.CoM All Rights Reserved.
'===================================================

Set Template = New Cls_Template

Class Cls_Template
	Private regEx
	Private pNum, pNum2
	Rem 定义模版变量
	Public Html,HTMLStr
	Public Css
	Public ProjectID,TemplateID,CssID
	Public ApplicationName, TemplateStr

	Private Sub Class_Initialize()
		Set regEx	= New RegExp
		regEx.IgnoreCase= True
		regEx.Global	= True
		pNum		= 1
		pNum2		= 0
		ProjectID	= 0
		TemplateID	= 0
		CssID		= 0
	End Sub

	Private Sub class_terminate()
		Html		= Null
		Css			= Null
		ApplicationName = Null
		TemplateStr = Null
		Set regEx	= Nothing
	End Sub

	'装载模板
	Public Sub Load(sModuleID,sTypeID)
		Dim Rs,SQL
		If ProjectID<1 Then
			ProjectID	= Cl.ProjectID
			CssID		= Cl.CssID
		End if
		If CssID<1 Then CssID = Cl.GetDefaultCssID(ProjectID)
		If TemplateID<1 Then TemplateID = Cl.GetDefaultTemplateID(sModuleID,sTypeID,ProjectID)
		Rem Css部分
		ApplicationName		= LCase(Cl.CacheName & "_Css_"&CssID)
		If Not IsArray(Application(ApplicationName)) Then
			Set Rs = Cl.Execute("Select CssID,CssName,CssPicUrl,CssContent,ProjectID,ProjectName from [Cl_Css] where CssID = " & Clng(CssID))
			If Rs.Eof Then
				Rs.Close : Set Rs = Nothing
				Response.write("No Find(CssID="&CssID&")")
				Response.End
			End If
			TemplateStr = Split(Rs.Getstring(,,"|||",""),"|||")
			Rs.Close : Set Rs = Nothing
			Application.Lock
			Application(ApplicationName) = TemplateStr
			Application.UnLock
		End If
		Cl.CssID		= CLng(Application(ApplicationName)(0))
		Cl.CssName		= Application(ApplicationName)(1)
		Cl.CssPicUrl	= Application(ApplicationName)(2)
		Css				= Application(ApplicationName)(3)
		Rem 模板部分
		ApplicationName = LCase(Cl.CacheName & "_Template_"&TemplateID)
		If Not IsArray(Application(ApplicationName)) Then
			Set Rs = Cl.Execute("Select TemplateID,TemplateName,TemplateContent,ProjectID,ProjectName from [Cl_Template] where TemplateID = " & Clng(TemplateID))
			If Rs.Eof Then
				Rs.Close : Set Rs = Nothing
				Response.write("No Find(TemplateID="&sTemplateID&")")
				Response.End
			End If
			TemplateStr = Split(Rs(0) & "$@$@$" & Rs(1) & "$@$@$" & CacheReplace(Rs(2)) & "$@$@$" & Rs(3) & "$@$@$" & Rs(4),"$@$@$")
			Rs.Close : Set Rs = Nothing
			Application.Lock
			Application(ApplicationName) = TemplateStr
			Application.UnLock
		End if
		Html = ReplaceCl_If(Application(ApplicationName)(2))
		TemplateID = 0
	End Sub
	'装载模板
	Public Sub LoadCss()
		Dim Rs,SQL
		If ProjectID<1 Then
			ProjectID	= Cl.ProjectID
			CssID		= Cl.CssID
		End if
		If CssID<1 Then CssID = Cl.GetDefaultCssID(ProjectID)
		Rem Css部分
		ApplicationName		= LCase(Cl.CacheName & "_Css_"&CssID)
		If Not IsArray(Application(ApplicationName)) Then
			Set Rs = Cl.Execute("Select CssID,CssName,CssPicUrl,CssContent,ProjectID,ProjectName from [Cl_Css] where CssID = " & Clng(CssID))
			If Rs.Eof Then
				Rs.Close : Set Rs = Nothing
				Response.write("No Find(CssID="&CssID&")")
				Response.End
			End If
			TemplateStr = Split(Rs.Getstring(,,"|||",""),"|||")
			Rs.Close : Set Rs = Nothing
			Application.Lock
			Application(ApplicationName) = TemplateStr
			Application.UnLock
		End If
		Cl.CssID		= CLng(Application(ApplicationName)(0))
		Cl.CssName		= Application(ApplicationName)(1)
		Cl.CssPicUrl	= Application(ApplicationName)(2)
		Css				= Application(ApplicationName)(3)
	End Sub
	Public Function Read(FilePath)
		Dim FsoObject,ReadObject
		Set FsoObject = Server.CreateObject(Cl.Web_Info(13))
		Set ReadObject = FsoObject.OpenTextFile(Server.MapPath(FilePath),1,False,False)
		Read = ReplaceCl_If(ReadObject.ReadAll)
		ReadObject.Close : Set ReadObject = Nothing
		Set FsoObject = Nothing
	End Function

	Public Function Head()
		Head = GetTemplate(Cl.GetDefaultTemplateID(-1,1,ProjectID))'Html
	End Function

	Public Function Bottom()
		Bottom	= GetTemplate(Cl.GetDefaultTemplateID(-1,2,ProjectID))
		if Cl.Web_Setting(44)="Yes" Then
		Bottom = Bottom & vbNewLine & _
		"<noscript><iframe src='*' width='0' height='0'></iframe></noscript>"
		End if
	End Function

	Public Function GetTemplate(sTemplateID)
		Dim Rs,SQL
		ApplicationName = LCase(Cl.CacheName & "_Template_"&sTemplateID)
		If Not IsArray(Application(ApplicationName)) Then
			Set Rs = Cl.Execute("Select TemplateID,TemplateName,TemplateContent,ProjectID,ProjectName from [Cl_Template] where TemplateID = " & Clng(sTemplateID))
			If Rs.Eof Then
				Rs.Close : Set Rs = Nothing
				Response.write("No Find(TemplateID="&sTemplateID&")")
				Response.End
			End If
			TemplateStr = Split(Rs(0) & "$@$@$" & Rs(1) & "$@$@$" & CacheReplace(Rs(2)) & "$@$@$" & Rs(3) & "$@$@$" & Rs(4),"$@$@$")
			Rs.Close : Set Rs = Nothing
			Application.Lock
			Application(ApplicationName) = TemplateStr
			Application.UnLock
		End if
		GetTemplate = ReplaceCl_If(Application(ApplicationName)(2))
	End Function

	Public Function GetCss(sCssID)
		Dim Rs,SQL
		Rem Css部分
		ApplicationName		= LCase(Cl.CacheName & "_Css_"&sCssID)
		If Not IsArray(Application(ApplicationName)) Then
			Set Rs = Cl.Execute("Select CssID,CssName,CssPicUrl,CssContent,ProjectID,ProjectName from [Cl_Css] where CssID = " & Clng(sCssID))
			If Rs.Eof Then
				Rs.Close : Set Rs = Nothing
				Response.write("No Find(CssID="&sCssID&")")
				Response.End
			End If
			TemplateStr = Split(Rs.Getstring(,,"|||",""),"|||")
			Rs.Close : Set Rs = Nothing
			Application.Lock
			Application(ApplicationName) = TemplateStr
			Application.UnLock
		End If
		GetCss = Application(ApplicationName)(3)
	End Function

	Rem 缓存前处理的标签
	Public Function CacheReplace(Byval sContent)
		sContent = Replace(Replace(sContent,"{%","{$"),"%}","}")
		sContent = Replace(Replace(sContent,"<!--{$","{$"),"}-->","}")
		sContent = ReplaceLabel(sContent)
		sContent = Replace(sContent,"{$projectid}",Cl.ProjectID)
		sContent = Replace(sContent,"{$projectname}",Cl.ProjectName)
		sContent = Replace(sContent,"{$webname}",Cl.Web_info(0))
		sContent = Replace(sContent,"{$generator}","Aspoo")
		'sContent = Replace(sContent,"{$keywords}",Replace(Cl.Keywords,"|",","))
		'sContent = Replace(sContent,"{$description}",Cl.DeScriptIon)
		sContent = Replace(sContent,"{$weburl}",Cl.Web_info(4))
		sContent = Replace(sContent,"{$webmaster}",Cl.Web_info(7))
		sContent = Replace(sContent,"{$webmastemail}",Cl.Web_info(8))
		sContent = Replace(sContent,"{$copyright}",Cl.Web_info(9))
		sContent = Replace(sContent,"{$showdate}","<script src="""&InstallDir&"inc/js/date.js"" type=""text/javascript""></script>")
		sContent = Cl.ReplaceDir(sContent)
		sContent = Cl.ReplaceItem(sContent)
		CacheReplace = sContent
		'Response.write sContent
	End Function

	Public Function ReplaceAllFlag(Byval sContent)
		If InStr(sContent,"{$showhead}")>0		Then sContent = Replace(sContent,"{$showhead}",Head)
		If InStr(sContent,"{$showfooter}")>0	Then sContent = Replace(sContent,"{$showfooter}",Bottom)
		'sContent = ReplaceCl_If(sContent)
		sContent = ReplaceSuperLoop(sContent)
		sContent = ReplaceSuperClassLoop(sContent)
		sContent = ReplaceParameter(sContent)
		If InStr(sContent,"{$channelid}")>0		Then sContent = Replace(sContent,"{$channelid}",ChannelID)
		If InStr(sContent,"{$channelname}")>0	Then sContent = Replace(sContent,"{$channelname}",Cl.ChannelName)
		ReplaceAllFlag	= Cl.ReplaceDir(sContent)
		ProjectID = 0 : CssID = 0
	End Function

	Public Function ReplaceSuperLoop(Byval sContent)
		On Error Resume next
		Dim Matches,Match,TempValue
						  '【Cl_Loop\((.[^\)]*)\)】(.[^\【]*)
		regEx.Pattern	= "【Cl_Loop\((.[^\)]*)\)】(.[^\【]*)【\/Cl_Loop】"
		Set Matches		= regEx.Execute(sContent)
		For Each Match in Matches
			Rem 定义变量
			Dim sModule,sTopNum,sChannelID,sClassID,sSpecialID
			Dim sIsHot,sIsElite,sWhere,sOrder,sUserName
			Dim Rows,Cols,ColTemplate,LoopTemplate
			Dim Rs,SQL,XMLData,i
			Rem 设置初始值
			sModule		= "article"
			sTopNum		= 5
			sChannelID	= ChannelID
			sClassID	= 0
			sSpecialID	= 0
			sIsHot		= 0
			sIsElite	= 0
			sWhere		= ""
			sOrder		= "InfoID Desc"
			Rows		= "5"
			Cols		= 1
			ColTemplate = ""
			sUserName	= ""
			Rem End
			TempValue	= regEx.Replace(Match.Value,"$1")
			LoopTemplate= regEx.Replace(Match.Value,"$2")
			LoopTemplate= Trim(LoopTemplate)
			TempValue	= Split(TempValue,";")
			For i=0 To UBound(TempValue)
				TempValue(i)=Split(TempValue(i),":")
				Select Case LCase(TempValue(i)(0))
				Case "module"		: sModule	= TempValue(i)(1)
				Case "topnum"		: sTopNum	= Cl.GetCLng(TempValue(i)(1))
				Case "channelid"	: sChannelID= Cl.GetEval(TempValue(i)(1))
				Case "classid"		: sClassID	= Cl.GetEval(TempValue(i)(1))
				Case "specialid"	: sSpecialID= Cl.GetEval(TempValue(i)(1))
				Case "ishot"		: sIsHot	= Cl.GetCLng(TempValue(i)(1))
				Case "iselite"		: sIsElite	= Cl.GetCLng(TempValue(i)(1))
				Case "where"		: sWhere	= Trim(TempValue(i)(1))
				Case "order"		: sOrder	= Trim(TempValue(i)(1)) & ",InfoID Desc"
				Case "rows"			: Rows		= Trim(TempValue(i)(1))
				Case "cols"			: Cols		= Cl.GetCLng(TempValue(i)(1))
				Case "coltemplate"	: ColTemplate = Trim(TempValue(i)(1))
				Case "name"			: sUserName = Trim(TempValue(i)(1))
				End Select
			Next
			TempValue = Empty
			If sTopNum < 1 Or sTopNum > 100 Then sTopNum = 5
			SQL = "Select Top "&sTopNum&" InfoID, ChannelID, ChannelDir, ClassID, Prefixion, "
			Select Case LCase(sModule)
			Case "article"
			SQL = SQL & "Title, FontColor, FontType, TitleIntact, 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 "
			Case "soft"
			SQL = SQL & "SoftName, FontColor, FontType, SoftVersion, Author, AuthorEmail, AuthorHomepage, 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 "
			Case "photo"
			SQL = SQL & "PhotoName, FontColor, FontType, 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 "
			Case "movie"
			SQL = SQL & "MovieName, FontColor, FontType, 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 "
			Case "product"
			SQL = SQL & "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 "
			Case Else
			SQL = SQL & "Title, FontColor, FontType, TitleIntact, Author, CopyFrom, Editor, UpdateTime, Censor, CensorTime, Stars, OnTop, Hot, Elite, Hits, DayHits, WeekHits, MonthHits, InfoGroup, InfoPoint, InfoMoney, PicUrl, Intro, Content, Receive, ReceiveType, IsLink, IsHtml, HtmlFileUrl, LastHitTime, CommentCount from Cl_Article "
			End Select
			SQL = SQL & " where Deleted="&FalseType&" and Status=1"
			If sChannelID>0 Then SQL = SQL & " and ChannelID="&sChannelID&""
			If sClassID>0 Then 
				Dim tClass
				Set tClass = Cl.Execute("select ClassID, Child, arrChildID From Cl_Class where ClassID=" & sClassID)
				If Not tClass.eof Then
					If tClass(1) > 0 Then 
					SQL = SQL & " and ClassID in (" & tClass(2) & ")"
					Else
					SQL = SQL & " and ClassID = " & sClassID & ""
					End If 
				End If 
				Set tClass = Nothing
			End If 
			If sSpecialID>0 Then SQL = SQL & " and SpecialID like '%," & SpecialID & ",%'"
			If sIsHot=1 Then SQL = SQL & " and Hot="&TrueType&""
			If sIsElite=1 Then SQL = SQL & " and Elite="&TrueType&""
			If sWhere<>"" Then SQL = SQL & " and " & sWhere & " "
			SQL = SQL & " Order By " & sOrder
			Set Rs = Cl.Execute(SQL)
			If Not Rs.Eof then
				Set XMLData = Cl.RecordsetToxml(Rs,"info","infolist")
				sContent = Replace(sContent,Match.Value,ReplaceSuperLoopInfoList(sModule,Rows,Cols,LoopTemplate,ColTemplate,XMLData))
				Set XMLData = Nothing
			Else
				sContent = Replace(sContent,Match.Value,"当前无记录！")
			End If
			Set Rs = Nothing
		Next
		Set Matches	= Nothing
		ReplaceSuperLoop = sContent
	End Function