复制代码 代码如下:Class template Private c_Char, c_Path, c_FileName, c_Content, c_PageUrl, c_CurrentPage, c_PageStr, ReplacePageStr Private TagName ' *************************************** ' 设置编码 ' *************************************** Public Property Let Char(ByVal Str) c_Char = Str End Property Public Property Get Char Char = c_Char End Property ' *************************************** ' 设置模板文件夹路径 ' *************************************** Public Property Let Path(ByVal Str) c_Path = Str End Property Public Property Get Path Path = c_Path End Property ' *************************************** ' 设置模板文件名 ' *************************************** Public Property Let FileName(ByVal Str) c_FileName = Str End Property Public Property Get FileName FileName = c_FileName End Property ' *************************************** ' 获得模板文件具体路径 ' *************************************** Public Property Get FilePath If Len(Path) > 0 Then Path = Replace(Path, "", "/") If Right(Path, 1) <> "/" Then Path = Path & "/" FilePath = Path & FileName End Property ' *************************************** ' 设置分页URL ' *************************************** Public Property Let PageUrl(ByVal Str) c_PageUrl = Str End Property Public Property Get PageUrl PageUrl = c_PageUrl End Property ' *************************************** ' 设置分页 当前页 ' *************************************** Public Property Let CurrentPage(ByVal Str) c_CurrentPage = Str End Property Public Property Get CurrentPage CurrentPage = c_CurrentPage End Property ' *************************************** ' 输出内容 ' *************************************** Public Property Get Flush Response.Write(c_Content) End Property ' *************************************** ' 类初始化 ' *************************************** Private Sub Class_Initialize TagName = "pjblog" c_Char = "UTF-8" ReplacePageStr = Array("", "") End Sub ' *************************************** ' 过滤冲突字符 ' *************************************** Private Function doQuote(ByVal Str) doQuote = Replace(Str, Chr(34), """) End Function ' *************************************** ' 类终结 ' *************************************** Private Sub Class_Terminate End Sub ' *************************************** ' 加载文件方法 ' *************************************** Private Function LoadFromFile(ByVal cPath) Dim obj Set obj = Server.CreateObject("ADODB.Stream") With obj .Type = 2 .Mode = 3 .Open .Charset = Char .Position = .Size .LoadFromFile Server.MapPath(cPath) LoadFromFile = .ReadText .close End With Set obj = Nothing End Function ' *********************************************** ' 获取正则匹配对象 ' *********************************************** Public Function GetMatch(ByVal Str, ByVal Rex) Dim Reg, Mag Set Reg = New RegExp With Reg .IgnoreCase = True .Global = True .Pattern = Rex Set Mag = .Execute(Str) If Mag.Count > 0 Then Set GetMatch = Mag Else Set GetMatch = Server.CreateObject("Scripting.Dictionary") End If End With Set Reg = nothing End Function ' *************************************** ' 打开文档 ' *************************************** Public Sub open c_Content = LoadFromFile(FilePath) End Sub ' *************************************** ' 缓冲执行 ' *************************************** Public Sub Buffer c_Content = GridView(c_Content) Call ExecuteFunction End Sub ' *************************************** ' GridView ' *************************************** Private Function GridView(ByVal o_Content) Dim Matches, SubMatches, SubText Dim Attribute, Content Set Matches = GetMatch(o_Content, "<" & TagName & ":(d+?)(.+?)>([sS]+?)</" & TagName & ":1>") If Matches.Count > 0 Then For Each SubMatches In Matches Attribute = SubMatches.SubMatches(1) ' kocms Content = SubMatches.SubMatches(2) ' <Columns>...</Columns> SubText = Process(Attribute, Content) ' 返回所有过程执行后的结果 o_Content = Replace(o_Content, SubMatches.value, "<" & SubText(2) & SubText(0) & ">" & SubText(1) & "</" & SubText(2) & ">", 1, -1, 1) ' 替换标签变量 Next End If Set Matches = Nothing If Len(ReplacePageStr(0)) > 0 Then ' 判断是否标签变量有值,如果有就替换掉. o_Content = Replace(o_Content, ReplacePageStr(0), ReplacePageStr(1), 1, -1, 1) ReplacePageStr = Array("", "") ' 替换后清空该数组变量 End If GridView = o_Content End Function ' *************************************** ' 确定属性 ' *************************************** Private Function Process(ByVal Attribute, ByVal Content) Dim Matches, SubMatches, Text Dim MatchTag, MatchContent Dim datasource, Name, Element, page, id datasource = "" : Name = "" : Element = "" : page = 0 : id = "" Set Matches = GetMatch(Attribute, "s(.+?)=""(.+?)""") If Matches.Count > 0 Then For Each SubMatches In Matches MatchTag = SubMatches.SubMatches(0) ' 取得属性名 MatchContent = SubMatches.SubMatches(1) ' 取得属性值 If Lcase(MatchTag) = "name" Then Name = MatchContent ' 取得name属性值 If Lcase(MatchTag) = "datasource" Then datasource = MatchContent' 取得datasource属性值 If Lcase(MatchTag) = "element" Then Element = MatchContent ' 取得element属性值 If Lcase(MatchTag) = "page" Then page = MatchContent ' 取得page属性值 If Lcase(MatchTag) = "id" Then id = MatchContent ' 取得id属性值 Next If Len(Name) > 0 And Len(MatchContent) > 0 Then Text = Analysis(datasource, Name, Content, page, id) ' 执行解析属性 If Len(datasource) > 0 Then Attribute = Replace(Attribute, "datasource=""" & datasource & """", "") If page > 0 Then Attribute = Replace(Attribute, "page=""" & page & """", "") Attribute = Replace(Attribute, "name=""" & Name & """", "", 1, -1, 1) Attribute = Replace(Attribute, "element=""" & Element & """", "", 1, -1, 1) Process = Array(Attribute, Text, Element) Else Process = Array(Attribute, "", "div") End If Else Process = Array(Attribute, "", "div") End If Set Matches = Nothing End Function ' *************************************** ' 解析 ' *************************************** Private Function Analysis(ByVal id, ByVal Name, ByVal Content, ByVal page, ByVal PageID) Dim Data Select Case Lcase(Name) ' 选择数据源 Case "loop" Data = DataBind(id, Content, page, PageID) Case "for" Data = DataFor(id, Content, page, PageID) End Select Analysis = Data End Function ' *************************************** ' 绑定数据源 ' *************************************** Private Function DataBind(ByVal id, ByVal Content, ByVal page, ByVal PageID) Dim Text, Matches, SubMatches, SubText Execute "Text = " & id & "(1)" ' 加载数据源 Set Matches = GetMatch(Content, "<Columns>([sS]+)</Columns>") If Matches.Count > 0 Then For Each SubMatches In Matches SubText = ItemTemplate(SubMatches.SubMatches(0), Text, page, PageID)' 执行模块替换 Content = Replace(Content, SubMatches.value, SubText, 1, -1, 1) Next DataBind = Content Else DataBind = "" End If Set Matches = Nothing End Function ' *************************************** ' 匹配模板实例 ' *************************************** Private Function ItemTemplate(ByVal TextTag, ByVal Text, ByVal page, ByVal PageID) Dim Matches, SubMatches, SubMatchText Dim SecMatch, SecSubMatch Dim i, TempText Dim TextLen, TextLeft, TextRight Set Matches = GetMatch(TextTag, "<ItemTemplate>([sS]+)</ItemTemplate>") If Matches.Count > 0 Then For Each SubMatches In Matches SubMatchText = SubMatches.SubMatches(0) ' --------------------------------------------- ' 循环嵌套开始 ' --------------------------------------------- SubMatchText = GridView(SubMatchText) ' --------------------------------------------- ' 循环嵌套结束 ' --------------------------------------------- If UBound(Text, 1) = 0 Then TempText = "" Else TempText = "" ' ----------------------------------------------- ' 开始分页 ' ----------------------------------------------- If Len(page) > 0 And page > 0 Then If Len(CurrentPage) = 0 Or CurrentPage = 0 Then CurrentPage = 1 TextLen = UBound(Text, 2) TextLeft = (CurrentPage - 1) * page TextRight = CurrentPage * page - 1 If TextLeft < 0 Then TextLeft = 0 If TextRight > TextLen Then TextRight = TextLen c_PageStr = MultiPage(TextLen + 1, page, CurrentPage, PageUrl, "float:right", "", False) If Int(Len(c_PageStr)) > 0 Then ReplacePageStr = Array("<page:" & Trim(PageID) & "/>", c_PageStr) Else ReplacePageStr = Array("<page:" & Trim(PageID) & "/>", "") End If Else TextLeft = 0 TextRight = UBound(Text, 2) End If For i = TextLeft To TextRight TempText = TempText & ItemReSec(i, SubMatchText, Text) ' 加载模板内容 Next End If Next ItemTemplate = TempText Else ItemTemplate = "" End If Set Matches = Nothing End Function ' *************************************** ' 替换模板字符串 ' *************************************** Private Function ItemReSec(ByVal i, ByVal Text, ByVal Arrays) Dim Matches, SubMatches Set Matches = GetMatch(Text, "$(d+?)") If Matches.Count > 0 Then For Each SubMatches In Matches Text = Replace(Text, SubMatches.value, doQuote(Arrays(SubMatches.SubMatches(0), i)), 1, -1, 1) '执行替换 Next ItemReSec = Text Else ItemReSec = "" End If Set Matches = Nothing End Function ' *************************************** ' 全局变量函数 ' *************************************** Private Sub ExecuteFunction Dim Matches, SubMatches, Text, ExeText Set Matches = GetMatch(c_Content, "<function:([0-9a-zA-Z_.]*?)((.*?)""(.+?)""(.*?))/>") If Matches.Count > 0 Then For Each SubMatches In Matches Text = SubMatches.SubMatches(0) & "(" & SubMatches.SubMatches(1) & """" & SubMatches.SubMatches(2) & """" & SubMatches.SubMatches(3) & ")" Execute "ExeText=" & Text c_Content = Replace(c_Content, SubMatches.value, ExeText, 1, -1, 1) Next End If Set Matches = Nothing End Sub ' *************************************** ' 普通替换全局标签 ' *************************************** Public Property Let Sets(ByVal t, ByVal s) Dim SetMatch, Bstr, SetSubMatch Set SetMatch = GetMatch(c_Content, "(<Set:([0-9a-zA-Z_.]*?)(((.*?)" & t & "(.*?))?)/>)") If SetMatch.Count > 0 Then For Each SetSubMatch In SetMatch Execute "Bstr = " & SetSubMatch.SubMatches(1) & "(" & SetSubMatch.SubMatches(3) & """" & s & """" & SetSubMatch.SubMatches(4) & ")" c_Content = Replace(c_Content, SetSubMatch.Value, Bstr, 1, -1, 1) Next End If Set SetMatch = Nothing Set SetMatch = GetMatch(c_Content, "(<Set:" & t & "/>)") If SetMatch.Count > 0 Then For Each SetSubMatch In SetMatch c_Content = Replace(c_Content, SetSubMatch.Value, s, 1, -1, 1) Next End If Set SetMatch = Nothing End Property End Class

　　推荐阅读

　　asp最简单的生成验证码代码

为了防止再次被攻击，做个验证码过滤程序是必要的。我在网上找了一些资料，觉得用别人做好的代码总是很不爽，自己做麻又不会写复杂的代码，特别是生成图片的那种。尝试了网上的很多种方法都不行，不知道为什么，可>>>详细阅读

本文标题：ASP 高级模板引擎实现类

地址：http://www.17bianji.com/kaifa2/ASP/32000.html

 1/2    1