源代码
By  wanghfyangy 发表于 2007/7/30 21:17:00 

'【功能】自定义模板标签
Function ProcessCustomTags(ByVal sContent)
         Dim objRegEx, Match, Matches
      '建立正则表达式
         Set objRegEx = New RegExp
      '查找内容
         objRegEx.Pattern = "<tag:.*/>"
      '忽略大小写
         objRegEx.IgnoreCase = True
      '全局查找
         objRegEx.Global = True
      'Run the search against the content string we've been passed
         Set Matches = objRegEx.Execute(sContent)
      '循环已发现的匹配
         For Each Match in Matches
         'Replace each match with the appropriate HTML from our ParseTag function
         sContent = Replace(sContent, Match.Value, ParseTag(Match.Value))
         Next
      '消毁对象
         set Matches = nothing
         set objRegEx = nothing
      '返回值
         ProcessCustomTags = sContent
End Function

 

'【功能】取得模板标签的参数名
'如:<tag:loop channelid="1" pagesize="10" title="20" type="NEW" column="1">
function GetAttribute(ByVal strAttribute, ByVal strTag)
      Dim objRegEx, Matches
      '建立正则表达式
         Set objRegEx = New RegExp
      '查找内容 (the attribute name followed by double quotes etc) 
         objRegEx.Pattern = lCase(strAttribute) & "=""[0-9a-zA-Z]*"""
      '忽略大小写
         objRegEx.IgnoreCase = True
      '全局查找
         objRegEx.Global = True
      '执行搜索
         Set Matches = objRegEx.Execute(strTag)
      '如有匹配的则返回值, 不然返回空值
         if Matches.Count > 0 then
              GetAttribute = Split(Matches(0).Value,"""")(1)
         else
              GetAttribute = ""
         end if
      '消毁对象
         set Matches = nothing
         set objRegEx = nothing
end function

 

 

'【功能】解析并替换相应的模板标签内容
function ParseTag(ByVal strTag)
      dim arrResult, ClassName, arrAttributes, sTemp, i, objClass
      '如果标签是空的则退出函数
         if len(strTag) = 0 then exit function
      'Split the match on the colon character (:)
         arrResult = Split(strTag, ":")
      'Split the second item of the resulting array on the space character, to
         'retrieve the name of the class
         ClassName = Split(arrResult(1), " ")(0)
         'Use a select case statement to work out which class we're dealing with
         'and therefore which properties to populate etc
         select case uCase(ClassName)
         'It's a loop class, so instantiate one and get it's properties
         case "LOOP"
                     set objClass = new LOOP_Class
                     LOOP.Channelid= GetAttribute("channelid", strTag")
                     LOOP.Pagesize= GetAttribute("pagesize", strTag")
                     LOOP.title = GetAttribute("title", strTag")
                     LOOP.type = GetAttribute("Type", strTag")
                     ParseTag = LOOP.column (GetAttribute("column", strTag"), true)
                     'Destroy our class object
                     set objClass = nothing
         end select
end function

 
阅读全文 | 回复(0) | 引用通告 | 编辑 | 收藏该日志

发表评论:

    昵称:
    密码:
    主页:
    标题:

 
站点公告
站点日历
最新日志
最新评论
最新留言
友情链接
站点统计
日志搜索
用户登陆