文件名:Class.Tpl.asp
''============================================================= ''@Date 2006-6-7 ''@Author NetFog ''@ModifyTime 2006-6-5 ''@Desc 模版处理类 ''============================================================= 类 名:Cls_Tpl 简 介:大体上分为种操作:1、解译模版。2、重置模版。两种操作均支持变量及文件模版 注意事项:1、M_Type只支持"F"和"V"两种属性,V表示模版类型为变量,F表示模版类型为一个文件 默认为F
2、Op_Type也只支持"Parse"及"ReSet"两种属性,即解译和重置的设定,默认为解译
3、通过Parse及ReSet方法返回的值,如果成功操作则返回内容,否则还布尔值False
4、M_Type设置为"F"时M_Content必须设置,Tf_Path的设置则无效.M_Type设置为"V"时 Tf_Path必须设置,M_Content的设置则无效
相关解释 M_Type 设置模版类型 Op_Type 设置操作类型 M_Content 设置模版内容 Tf_Path 设置模版文件路径 S_Tag 设置标识开始符 E_Tag 设置标识结束符
补充说明:1、本类由NetFog于2006年6月7日完成 2、由于是一天时间完成,难免有错。如发现Bug或有更好的建议请转告本人 3、本人QQ:77735870 Email/MSN:XiTour@163.com qiuqiongzhi@163.com 4、本人好交朋友,共同讨论技术 *^_^*
代码:
<% ''=============================================== ''@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 %>
[此贴被 NetFog(q70213526) 在 06月16日15时46分 编辑过]
|