代码:

---

<%
''===============================================
''@Date           2006-6-7
''@Author         NetFog
''@ModifyTime     2006-6-7
''@Desc           模版处理类
''===============================================
Class Cls_Tpl
	Private Version               '版本号
	Private ModelType             '模版类型
	Private OpType                '操作类型
	Private ModelContent          '模版内容
	Private StartTag              '模版标识头
	Private EndTag                '模版标识尾
	Private TplFilePath           '模版路径
	Private ReplaceTimes          '模版被替换体被替换次数
	Private PreReplaceTimes       '预计模版被替换体替换次数
	Private IsError               '是否出错

	''===========================================
	''@name       Class_Initialize
	''@desc       初始化
	''===========================================
	Private Sub Class_Initialize()
		Version         = "0.01"
		ModelType       = "F"
		OpType          = "Parse"
		ModelContent    = ""
		StartTag        = "{"
		EndTag          = "}"
		TplFilePath     = ""
		ReplaceTimes    = 0
		PreReplaceTimes = 0
		IsError         = False
	End Sub

	''===========================================
	''@name       M_Type
	''@desc       设置模版类型,为"File"和"DB"两种
	''===========================================
	Public Property Let M_Type(ByVal vModelType)
		ModelType = Ucase(Cstr(vModelType))
	End Property

	''===========================================
	''@name       Op_Type
	''@desc       设置模版操作类型,分为Parse和ReSet两种
	''===========================================
	Public Property Let Op_Type(ByVal vOpType)
		OpType = Cstr(vOpType)
	End Property

	''===========================================
	''@name       M_Content
	''@desc       设置模版内容,在M_Type为"DB"时可用
	''===========================================
	Public Property Let M_Content(ByVal vModelContent)
		ModelContent = vModelContent
	End Property

	''===========================================
	''@name       S_Tag
	''@desc       设置开始标识
	''===========================================
	Public Property Let S_Tag(ByVal vStartTag)
		StartTag = vStartTag
	End Property

	''===========================================
	''@name       E_Tag
	''@desc       设置结束标识
	''===========================================
	Public Property Let E_Tag(ByVal vEndTag)
		EndTag = vEndTag
	End Property

	''===========================================
	''@name       Tf_Path
	''@desc       设置模版文件路径,在M_Type为"File"时可用
	''===========================================
	Public Property Let Tf_Path(ByVal vFilePath)
		TplFilePath = vFilePath
	End Property

	''===========================================
	''@name       Errs
	''@desc       是否出错
	''===========================================
	Public Property Get Errs()
		Errs = IsError
	End Property

	''===========================================
	''@name       Parse
	''@desc       解译模版，并将标识替换
	''===========================================
	Public Function Parse(ByVal vTag,ByVal vVar)
	Dim tmpStr,i
	tmpStr = GetModelContent()
	If VarType(tmpStr) = 11 Then tmpStr = False : IsError = True : Exit Function
		If OpType = "Parse" Then
			If IsArray(vTag) And IsArray(vVar) Then
				If Ubound(vTag) = Ubound(vVar) Then
					For i = 0 to Ubound(vTag)
						tmpStr = M_Replace(StartTag,EndTag,tmpStr,vTag(i),vVar(i))
					Next
					If Err.Number <> 0 Then
						Err.Clear
						IsError = True
					End if
				Else
					Response.Write "两个数组上界不相等"
					IsError = True
					Response.End
				End if
			Else
				tmpStr = M_Replace(StartTag,EndTag,tmpStr,vTag,vVar)
				If Err.Number <> 0 Then
					Err.Clear
					IsError = True
				End if
			End If
		Else
			Response.Write "只有当操作类型为解译(Parse)时才能执行"
			IsError = True
			Response.End
		End If
		If VarType(tmpStr) = 11 Then
			Parse = False
			IsError = True
		Else
			Parse = tmpStr
		End if
	End Function

	''===========================================
	''@name       ReSet
	''@desc       重置模版,成功则返回重置后的内容，否则为False
	''===========================================
	Public Function ReSet(ByVal vTag,ByVal vVar)
	Dim tmpStr,i,tmpBool
	tmpStr = GetModelContent()
	If VarType(tmpStr) = 11 Then tmpStr = False : IsError = True : Exit Function
		If OpType = "ReSet" Then
			If IsArray(vTag) And IsArray(vVar) Then
				If Ubound(vTag) = Ubound(vVar) Then
					For i = 0 to Ubound(vTag)
						tmpStr = M_Replace(StartTag,EndTag,tmpStr,vTag(i),StartTag & vVar(i) & EndTag)
					Next
					If Err.Number <> 0 Then
						Err.Clear
						IsError = True
					End if
				Else
					Response.Write "两个数组上界不相等"
					IsError = True
					Response.End
				End if
			Else
				tmpStr = M_Replace(StartTag,EndTag,tmpStr,vTag,StartTag & vVar & EndTag)
				If Err.Number <> 0 Then
					Err.Clear
					IsError = True
				End if
			End If
		Else
			Response.Write "只有当操作类型为重置(ReSet)时才能执行"
			IsError = True
			Response.End
		End If
		If VarType(tmpStr) = 11 Then
			ReSet = False
			IsError = True
			Exit Function
		End If
		If ModelType = "V" Then
			ReSet = tmpStr
		ElseIf ModelType = "F" Then
			tmpBool = ReWriteFile(TplFilePath,tmpStr)
			If tmpBool = True Then
				ReSet = tmpStr
			Else
				IsError = True
				ReSet = False
			End If
		Else
			ReSet = False
		End if
	End Function

	''===========================================
	''@name       M_Replace
	''@desc       将模版中的标识替换
	''===========================================
	Private Function M_Replace(ByVal vStartTag,ByVal vEndTag,ByVal vContent,ByVal vTag,ByVal vVar)
		If VarType(vContent) = 11 Then M_Replace = False : Exit Function
		Dim RegEx,tmpStr
		Set RegEx = New RegExp
		RegEx.Pattern = vStartTag & vTag & vEndTag
		RegEx.IgnoreCase = True
		RegEx.Global = True
		tmpStr = RegEx.Replace(vContent,vVar)
		Set RegEx = Nothing
		If Err.Number <> 0 Then
			M_Replace = False
		Else
			M_Replace = tmpStr
		End if
		Set RegEx = Nothing
	End Function

	''===========================================
	''@name       GetModelContent
	''@desc       取得模版内容
	''===========================================
	Private Function GetModelContent()
		Select Case ModelType
				Case "V"
					GetModelContent = ModelContent
				Case "F"
					GetModelContent = LoadFile(TplFilePath)
				Case Else
					GetModelContent = False
		End Select
	End Function

	''===========================================
	''@name       LoadFile
	''@desc       载入文件
	''===========================================
	Private Function LoadFile(ByVal vTplFilePath)
		On Error Resume Next
		Dim FSO,ObjFile,tmpStr
		Set FSO = Server.CreateObject("Scripting.FileSystemObject")
		If FSO.FileExists(Server.MapPath(vTplFilePath)) = False Then tmpStr = False : Exit Function
		Set ObjFile = FSO.OpenTextFile(Server.MapPath(vTplFilePath),1,False)
		tmpStr = ObjFile.ReadAll
		ObjFile.Close
		Set ObjFile = Nothing
		Set FSO = Nothing
		If Err.Number <> 0 Then
			tmpStr = False
		End if
		LoadFile = tmpStr
	End Function

	''===========================================
	''@name       ReWriteFile
	''@desc       重写文件模版
	''===========================================
	Private Function ReWriteFile(ByVal vTplFilePath,ByVal vNewContent)
		Dim FSO,WriteFile
		On Error Resume Next
		Set FSO = Server.CreateObject("Scripting.FileSystemObject")
		If FSO.FileExists(Server.MapPath(vTplFilePath)) Then
			FSO.DeleteFile(Server.MapPath(vTplFilePath))
		End If
		Set WriteFile = FSO.CreateTextFile(Server.MapPath(vTplFilePath),True)
		WriteFile.Write vNewContent
		WriteFile.Close
		Set WriteFile = Nothing
		Set FSO = Nothing
		If Err.Number <> 0 Then
			ReWriteFile = False
		Else
			ReWriteFile = True
		End if
	End Function
End Class
%>

---