cl_clstemplate.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)
		On Error Resume Next 
		Dim FsoObject,ReadObject
		Set FsoObject = Server.CreateObject(Cl.Web_Info(13))
		Set ReadObject = FsoObject.OpenTextFile(Server.MapPath(FilePath),1,False,False)
		If Err Then
		Err.Clear : Read = "Template.Read Err : " & FilePath
		else
		Read = ReplaceCl_If(ReadObject.ReadAll)
		End if
		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 = Replace(sContent,"{$webdir}",InstallDir)
		sContent = Replace(sContent,"[InstallDir]",InstallDir)
		sContent = Replace(sContent,"{$installdir}",InstallDir)
		sContent = Replace(sContent,"{$admindir}",Cl.Web_Info(14))
		sContent = Replace(sContent,"{$bbsdir}",BbsDir)
		sContent = Replace(sContent,"{$uploaddir}",Cl.UploadDir)
		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)
		sContent = Cl.ReplaceItem(sContent)
		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,arrClassID
			Rem 设置初始值
			sModule		= "article"
			sTopNum		= 5
			sChannelID	= ChannelID
			sClassID	= 0
			arrClassID	= ""
			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))