论坛: 编程破解 标题: 发个模版处理类 复制本贴地址    
作者: NetFog [q70213526]    版主   登录
文件名: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分 编辑过]

地主 发表时间: 06-06-16 15:44

回复: NetFog [q70213526]   版主   登录
调用示例就懒得发了。

有需要的同志再找我。

高手帮我PP。看有什么要改进的不。

B1层 发表时间: 06-06-16 15:49

回复: jhkdiy [jhkdiy]   版主   登录
VB.net我没学啊,不过楼主写的代码很好。

B2层 发表时间: 06-06-17 12:42

回复: NetFog [q70213526]   版主   登录
同志。俺的这是ASP类了咯。哈哈。。

B3层 发表时间: 06-06-17 16:17

回复: jhkdiy [jhkdiy]   版主   登录
晕,怪不得和VB这么像了・・・・・

B4层 发表时间: 06-06-17 16:44

论坛: 编程破解

20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写:NetDemon

粤ICP备05087286号