asp模板解析类模块(支持if,function,loop及解析缓存)
发布时间:2008-08-11 13:06:00
<%
Class Cls_Template
Dim Reg
Dim Page
Dim CID
Dim SID
Dim Rule
Dim Content
Dim Template
Dim Cachetimei
Private Sub Class_Initialize()
Set Reg = New RegExp
Reg.Ignorecase = True
Reg.Global = True
Page = 0
CID = 0
SID = 0
Rule = ""
Content = ""
Template = "" ' 模板路径
Cachetimei = -1 ' 标签缓存时间
End Sub
Private Sub Class_Terminate()
'Set Reg = Nothing
End Sub
' 载入模板
Public Function Load(ByVal Templatefile)
Template = Templatefile
If Templatecache = 1 Then
If ChkCache("LoadTemplate_" & Server.Mappath(Template)) Then
Content = GetCache("LoadTemplate_" & Server.Mappath(Template))
Else
Call Loadfile
Call SetCache("LoadTemplate_" & Server.Mappath(Template), Content)
End If
Else
Call Loadfile
End If
End Function
' 检测SQL缓存
Function ChkCacheSQL(ByVal CacheName)
If Cachetimei <= 0 Then ChkCacheSQL = False: Exit Function
Dim CacheData
ChkCacheSQL = False
CacheName = LCase(Filterstr(CacheName))
CacheData = Application(Cacheflag & CacheName)
If Not IsArray(CacheData) Then Exit Function
If Not IsDate(CacheData(1)) Then Exit Function
If DateDiff("s", CDate(CacheData(1)), Now()) < 60 * Cachetime Then ChkCacheSQL = True
End Function
' 标签分析,有缓存有效期判断
Public Function Parser()
If Not IsNumeric(Page) Then Page = 0 Else Page = Int(Page)
Parser_My ' 自定义标签
Parser_Sys ' 系统标签
Parser_Com ' 列表标签
Parser_IF ' IF ELSE END
End Function
' 自定义标签
Public Function Parser_My()
On Error Resume Next
If GetCache("MyLableState") = "No" Then Content = RegReplace(Content, "{My:([\s\S]*?)}", ""): Exit Function
If Not ChkCache("MyLable") Then
Dim Rs
Set Rs = DB("Select [Name],[Code] From [{pre}Label]", 1)
If Not Rs.Eof Then
Call SetCache("MyLable", Rs.Getrows())
Call SetCache("MyLableState", "Yes")
Rs.Close: Set Rs = Nothing
Else
Rs.Close: Set Rs = Nothing
Call SetCache("MyLableState", "No")
Content = RegReplace(Content, "{My:([\s\S]*?)}", ""): Exit Function
End If
End If
Dim Ns, i, j
Ns = GetCache("MyLable")
Dim Matches, Match, MyValue
Reg.Pattern = "{My:([\s\S]*?)}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
If Len(Replace(Match.SubMatches(0), " ", "")) > 0 Then
MyValue = Lang_Parser_My_1 & " <font color=red>" & Replace(Match.SubMatches(0), " ", "") & "</font> " & Lang_Parser_My_2
For i = 0 To UBound(Ns, 2)
If LCase(Ns(0, i)) = LCase(Replace(Match.SubMatches(0), " ", "")) Then
MyValue = Ns(1, i)
If InStr(MyValue, "$$$") > 0 Then
Randomize
j = Round(UBound(Split(MyValue, "$$$")) * Rnd) '随机值第一个到最后一个
MyValue = Split(MyValue, "$$$")(j)
End If
Exit For
End If
Next
End If
Content = Replace(Content, Match.Value, MyValue) ' 替换
If Err Then Err.Clear: Response.Write "<font color=red>" & Lang_Parser_My_Error & "[" & AspArr(i) & "]</font>": Response.End
Next
End Function
' 分析系统标签
Public Function Parser_Sys()
On Error Resume Next
Dim Matches, Match, SysValue
Reg.Pattern = "{Sys:([\s\S]*?)}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
If InStr(LCase(Match.SubMatches(0)), "database") = 0 Then
If Len(Replace(Match.SubMatches(0), " ", "")) > 0 Then Execute ("SysValue = " & Replace(Match.SubMatches(0), " ", "")) Else SysValue = ""
Else
SysValue = ""
End If
Content = Replace(Content, Match.Value, SysValue) ' 替换
If Err Then Err.Clear: Response.Write "<font color=red>" & Lang_Parser_Sys_Error & "[" & AspArr(i) & "]</font>": Response.End
Next
reg.pattern = "<(.*?)(src=|href=|value=)""(images/|css/|js/)(.*?)""(.*?)>"
content = reg.replace(content, "<$1$2""" & httpurl & installdir & templatedir & "/$3$4""$5>")
reg.pattern = "{tag:goto}"
content = reg.replace(content, httpurl & installdir & "redirect.asp?")
End Function
' 列表标签
'<!--commend:{ $row=10 $cid={field:cid} $mode=commend }-->..............................<!--commend-->
Public Function Parser_Com()
On Error Resume Next
Dim Matches, Match
Dim Rs, i, j
Dim Matche, BackValue
Dim TagLabs, Tagsstr, Loopstr
Dim Tag_Cache, Tag_Row, Tag_Col, Tag_Width, Tag_Class
Dim Tag_Aid, Tag_Cid, Tag_Type, Tag_Mode, Tag_Keys, Tag_Order
Dim Tag_SQL, Tag_Table, Tag_Where, Tag_Field
Reg.Pattern = "<!--(.+?):\{(.+?)\}-->([\s\S]*?)<!--\1-->"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
TagLabs = Match.SubMatches(0) ' 标签
Tagsstr = Match.SubMatches(1) ' 属性
Loopstr = Match.SubMatches(2) ' innerText
If LCase(TagLabs) <> "page" Then ' 分页标签
' 共用属性
Tag_Cache = GetAttr(Tagsstr, "cache", True) ' 缓存时间 def:defcachetime
Tag_Row = GetAttr(Tagsstr, "row", True) ' 列数量 def:10
Tag_Col = GetAttr(Tagsstr, "col", True) ' 行数量 def:1
Tag_Width = GetAttr(Tagsstr, "width", True) '#表格宽度
Tag_Class = GetAttr(Tagsstr, "class", False) '#表格样式
Tag_Field = GetAttr(Tagsstr, "field", True) ' 所有字段
If Len(Tag_Cache) = 0 Or Not IsNumeric(Tag_Cache) Then Tag_Cache = -1 ' 标签不用缓存
If Len(Tag_Row) = 0 Or Not IsNumeric(Tag_Row) Then Tag_Row = 10
If Int(Tag_Row) < 1 Then Tag_Row = 1
If Len(Tag_Col) = 0 Or Not IsNumeric(Tag_Col) Then Tag_Col = 1
If Int(Tag_Col) < 1 Then Tag_Col = 1
If Len(Tag_Width) = 0 Then Tag_Width = "100%"
If Len(Tag_Class) > 0 Then Tag_Class = " Class=""" & Tag_Class & """ "
If Len(Tag_Field) = 0 Then Tag_Field = "*"
Tag_Cache = Int(Tag_Cache): Tag_Row = Int(Tag_Row): Tag_Col = Int(Tag_Col)
' 内容Content专用属性
Tag_Aid = GetAttr(Tagsstr, "aid", True) ' 这个文章不显示出来
Tag_Cid = GetAttr(Tagsstr, "cid", True) ' 栏目ID,多用个,号分隔
Tag_Type = GetAttr(Tagsstr, "type", True) ' 类型: text/images def:text
Tag_Mode = GetAttr(Tagsstr, "mode", True) ' 类型(推荐,热门,相关)
Tag_Keys = GetAttr(Tagsstr, "keys", True) ' 关键字
Tag_Order = GetAttr(Tagsstr, "order", False) ' 排序 def:[id] desc[组合查询可用]
Tag_SQL = GetAttr(Tagsstr, "sql", False) ' 单独SQL查询
Tag_Table = GetAttr(Tagsstr, "table", True) ' 组合查询,表
Tag_Where = GetAttr(Tagsstr, "where", False) ' 组合查询,条件
' 默认设置
If LCase(Tag_Table) = "channel" And Len(Tag_Where) = 0 Then Tag_Where = "[FatherID]=0 And [OutSideLink]=0 And [Order]>=0"
If LCase(Tag_Table) = "channel" And Len(Tag_Order) = 0 Then Tag_Order = "[Order] Desc,[ID] Desc"
' SQL查询组合
If Len(Tag_SQL) = 0 Then
If Len(Tag_Table) > 0 Then
If Len(Tag_Where) > 0 Then Tag_Where = " Where " & Tag_Where & " "
If Len(Tag_Order) = 0 Then
If LCase(Tag_Table) = "channel" Then
Tag_Order = "[Order] Desc,[ID] Desc"
Else
Tag_Order = "[ID] Desc"
End If
End If
Tag_SQL = "Select Top " & Tag_Row * Tag_Col & " " & Tag_Field & " From [{pre}" & Tag_Table & "] " & Tag_Where & " Order By " & Tag_Order ' 最终查询语句
Else
Tag_Where = ""
If Len(Tag_Aid) > 0 Then
If InStr(Tag_Aid, ",") > 0 Then
Tag_Where = " [ID] In (" & Tag_Aid & ") "
Else
Tag_Where = " [ID]<>" & Tag_Aid & " "
End If
End If
If Len(Tag_Cid) > 0 Then
If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Cid] In (" & Tag_Cid & ") " Else Tag_Where = " [Cid] In (" & Tag_Cid & ") "
'If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And ([Cid] In (" & Tag_Cid & ") or [Sid] in (" & tag_cid & ")) " Else Tag_Where = " ([Cid] In (" & Tag_Cid & ") or [Sid] in (" & tag_cid & ")) "
End If
If LCase(Tag_Type) = "images" Then
If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Indexpic]<>'' " Else Tag_Where = Tag_Where & " [Indexpic]<>'' "
End If
If LCase(Tag_Type) = "noimages" Then
If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Indexpic]='' " Else Tag_Where = Tag_Where & " [Indexpic]='' "
End If
Select Case LCase(Tag_Mode)
Case "commend"
If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Commend]=1 " Else Tag_Where = Tag_Where & " [Commend]=1 "
Case "uncommend"
If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Commend]=0 " Else Tag_Where = Tag_Where & " [Commend]=0 "
Case "about"
If Len(Tag_Keys) > 0 Then
Tag_Cache = -1 ' 不缓存
Dim Tag_KeysLink
Tag_Keys = Split(Replace(Tag_Keys, "'", ""), ",")
j = UBound(Tag_Keys): If j > 5 Then j = 5
For i = 0 To j
If Len(Tag_Keys(i)) > 0 Then
If Len(Tag_KeysLink) = 0 Then
Tag_KeysLink = " [Keywords] Like '%" & Tag_Keys(i) & "%'"
Else
Tag_KeysLink = Tag_KeysLink & " Or [Keywords] Like '%" & Tag_Keys(i) & "%'"
End If
End If
Next
If Len(Tag_KeysLink) > 0 Then
If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And (" & Tag_KeysLink & ") " Else Tag_Where = Tag_Where & " (" & Tag_KeysLink & ") "
End If
End If
End Select
If LCase(Tag_Mode) = "hot" Then
Tag_Order = "[Views] Desc"
Else
If Len(Tag_Order) = 0 Then Tag_Order = "[ID] Desc"
End If
If Len(Tag_Where) > 0 Then Tag_Where = Tag_Where & " And [Display]=1 " Else Tag_Where = " [Display]=1"
Tag_SQL = "Select Top " & Tag_Row * Tag_Col & " " & Tag_Field & " From [{pre}Content] Where " & Tag_Where & " Order By " & Tag_Order ' 最终查询语句
End If
End If
Cachetimei = Tag_Cache ' 标签缓存
If ChkCacheSQL(Template & Tag_SQL) Then
BackValue = GetCache(Template & Tag_SQL)
Else
BackValue = ""
Err.Clear
Set Rs = DB(Tag_SQL, 3)
If Err Then Response.Write "<font color=red>" & Lang_Parser_Com_Error & "[" & Tag_SQL & " => & " & Err.Description & "]</font>": Response.End
If Tag_Col > 1 Then BackValue = BackValue & "<table width=""" & Tag_Width & """ " & Tag_Class & " border=""0"" cellpadding=""0"" cellspacing=""0"">" & vbCrLf: j = 0 ' 表
Session(Cacheflag & "_Parser_i") = 0
For i = 1 To Tag_Row * Tag_Col
If Rs.Eof Then Exit For ' 不存在记录就退出
j = j + 1
If Tag_Col > 1 Then ' 表
If j = 1 Then BackValue = BackValue & " <tr>" & vbCrLf
BackValue = BackValue & " <td valign=""top"" width=""" & Round(100 / Tag_Col) & "%"">"
End If
If Len(TagLabs) = 0 Then TagLabs = "field"
Session(Cacheflag & "_Parser_i") = Session(Cacheflag & "_Parser_i") + 1 ' 记数
BackValue = BackValue & Parser_Tags("\[" & TagLabs & ":(.+?)\]", Loopstr, Rs) ' 替换
If Tag_Col > 1 Then ' 表
BackValue = BackValue & " </td>" & vbCrLf
If j = Tag_Col Then BackValue = BackValue & " </tr>" & vbCrLf: j = 0
End If
Rs.MoveNext
Next
If Tag_Col > 1 Then
If j < Tag_Col And j > 0 Then
For i = 1 To Tag_Col - j
BackValue = BackValue & " <td></td>" & vbCrLf
Next
BackValue = BackValue & " </tr>" & vbCrLf
End If
BackValue = BackValue & "</table>" & vbCrLf
End If
Rs.Close
Call SetCache(Template & Tag_SQL, BackValue)
End If
Content = Replace(Content, Match.Value, BackValue)
End If
Next
If RegExists("<!--(.+?):\{(.+?)\}-->([\s\S]*?)<!--\1-->", Content) Then Call Parser_Com ' 多次调用
End Function
' 分页标签
Public Function Parser_Page()
'On Error Resume Next
Dim Matches, Match
Dim Rs, i, j
Dim Matche, BackValue
Dim Tagsstr, Loopstr
Dim Tag_Size, Tag_Order, Tag_Field, Tag_Table, Tag_Style, Tag_SQL, Tag_Where
Dim Tag_RecordCount, Tag_PageCount
Reg.Pattern = "<!--Page:\{(.+?)\}-->([\s\S]*?)<!--Page-->"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
BackValue = ""
Tagsstr = Match.SubMatches(0) ' 属性
Loopstr = Match.SubMatches(1) ' innerText
Tag_Size = GetAttr(Tagsstr, "size", True)
Tag_Order = GetAttr(Tagsstr, "order", False)
Tag_Table = GetAttr(Tagsstr, "table", True)
Tag_Style = GetAttr(Tagsstr, "style", True)
Tag_Field = GetAttr(Tagsstr, "field", True) ' 所有字段
If Len(Tag_Size) = 0 Or Not IsNumeric(Tag_Size) Then Tag_Size = 10
If Len(Tag_Order) = 0 Then Tag_Order = "[ID] Desc"
If Len(Tag_Table) = 0 Then Tag_Table = "Content"
If Len(Tag_Style) = 0 Or Not IsNumeric(Tag_Style) Then Tag_Style = 1
If Len(Tag_Field) = 0 Then Tag_Field = "*"
Tag_Size = Int(Tag_Size): Tag_Table = " [{pre}" & Tag_Table & "] ": Tag_Style = Int(Tag_Style): Tag_Where = " [Display]=1 "
If Len(CID) > 0 And isnumeric(CID) Then Tag_Where = Tag_Where & " And [CID]=" & CID ' 存在CID则调用指定CID/SID的内容
'If Len(CID) > 0 And isnumeric(CID) Then Tag_Where = Tag_Where & " And ([CID]=" & CID & " Or [SID]=" & CID & ")" ' 存在CID则调用指定CID/SID的内容
If Len(CID) = 0 And Len(SID)>0 And isnumeric(SID) Then Tag_Where = Tag_Where & " And [SID]=" & SID ' 不存在CID,而存在SID则调用SID的内容
Set Rs = New DataList
Rs.Result = 1
Rs.Field = Tag_Field
Rs.Table = Tag_Table
Rs.Where = Tag_Where
Rs.Order = Tag_Order
Rs.PageSize = Tag_Size
Rs.AbsolutePage = Page
Rs.List()
Session(Cacheflag & "_Parser_i") = 0
For i = 1 To Tag_Size
If Rs.Data.Eof Then Exit For
Session(Cacheflag & "_Parser_i") = Session(Cacheflag & "_Parser_i") + 1 ' 记数
BackValue = BackValue & Parser_Tags("\[Page:(.+?)\]", Loopstr, Rs.Data) ' 替换
Rs.Data.MoveNext
Next
Content = RegReplace(Content, "{tag:page}", "{{tag:page_www.5u.hk}}")
Content = Replace(Content, Match.Value, BackValue)
Tag_RecordCount = Rs.RecordCount: Tag_PageCount = Rs.PageCount: Rs.Data.Close
If Tag_PageCount = 0 Then Tag_PageCount = 1
Next
Dim GetPageList
if matches.count >0 then
GetPageList = PageListX(Tag_PageCount, Tag_RecordCount, Page, Tag_Size, CID)
end if
Content = RegReplace(Content, "{{tag:page_www.5u.hk}}", GetPageList)
Set Rs = Nothing
End Function
' 字符替换
Public Function Parser_Tags(ByVal Pattern, ByVal Temp, ByVal Dat)
On Error Resume Next
Dim Matches, Match
Dim Tagsstr, Tagsval, Tagsvalt, TagTitle: TagTitle = False
Dim Tag_Len, Tag_Lenext, Tag_Format, Tag_Replace, Tag_Function,Tag_width,Tag_Height
Dim Re, Re1, Re2
Dim i, c, l, t
Reg.Pattern = Pattern
Set Matches = Reg.Execute(Temp)
For Each Match In Matches
Tagsstr = Match.SubMatches(0)
Tag_Len = GetAttr(Tagsstr, "len", True)
Tag_Lenext = GetAttr(Tagsstr, "lenext", True)
Tag_Format = GetAttr(Tagsstr, "format", False)
Tag_Replace = GetAttr(Tagsstr, "replace", False)
Tag_Function = GetAttr(Tagsstr, "function", True)
Tag_Width=GetAttr(Tagsstr, "width", True)
Tag_Height=GetAttr(Tagsstr, "height", True)
Tagsval = Split(Tagsstr, " ")(0)
Select Case LCase(Tagsval)
Case "aid"
Tagsval = Dat("AID")
If Err Then Err.Clear: Tagsval = Dat("ID") ' Content
Case "aurl"
Tagsval = Dat("ID") ' Content
Tagsval = BuildViewPath(Dat("ID"), Dat("Cid"), Dat("Diyname"), Dat("Createtime"), Dat("ViewPath"))
Case "curl"
Tagsval = Dat("Cid") ' Content
If Err Then Err.Clear: Tagsval = Dat("ID") ' Channel
If Createhtml = 1 Then ' 栏目只在1时才会生成,其他均不生成
If Len(GetChannel(Tagsval, "Domain")) > 0 Then Tagsval = GetChannel(Tagsval, "Domain") Else Tagsval = Httpurl & GetChannel(Tagsval, "Ruleindex")
Else ' ASP
If Len(GetChannel(Tagsval, "Domain")) > 0 Then Tagsval = GetChannel(Tagsval, "Domain") Else Tagsval = Httpurl & Installdir & "channel.asp?id=" & Tagsval
End If
Case "surl" ' sid -> name
Tagsval = ""
Case "cname"
Tagsval = GetChannel(Dat("cid"), "name")
Case "sname" ' sid -> name
Tagsval = ""
Case "ctable"
Tagsval = GetChannel(Dat("cid"), "table")
Case "titlex"
Tagsval = Dat("Title") ' Content
TagTitle = True
Case "modeindex"
Tagsval = ""
Case "i"
Tagsval = Session(Cacheflag & "_Parser_i")
Case Else
If LCase(Left(Tagsval, 5)) = "mode_" Then
Dim Modetag: Modetag = Right(Tagsval, Len(Tagsval) - 5)
Tagsval = Dat("ModeIndex")
If Len(Tagsval) > 0 And InStr(Tagsval, "<" & Modetag & ">") > 0 And InStr(Tagsval, "</" & Modetag & ">") > 0 Then
' Get Mode Tag Value
Else
Tagsval = ""
End If
Else
Tagsval = Dat(Tagsval)
End If
End Select
Tagsval = Replace(Replace(Replace(Replace(Tagsval, " ", " "), """, Chr(34)), ">", ">"), "<", "<")
If Len(Replace(Tag_Replace, " ", "")) > 0 Then
Re = Split(Tag_Replace, "##")
If UBound(Re) >= 0 Then Re1 = Re(0): Re2 = Re(1) Else Re1 = Re(0): Re2 = Re(0)
Tagsval = Replace(Tagsval, Re1, Re2)
End If
If Len(Replace(Tag_Format, " ", "")) > 0 Then ' 格式化时间
If IsDate(Tagsval) Then
Tagsvalt = Tagsval: Tagsvalt = LCase(Tag_Format): Tagsvalt = Replace(Tagsvalt, "weeka", "WEEKA"): Tagsvalt = Replace(Tagsvalt, "montha", "MONTHA"): Tagsvalt = Replace(Tagsvalt, "week", "WEEK"): Tagsvalt = Replace(Tagsvalt, "month", "MONTH")
If InStr(Tagsvalt, "WEEKA") Then Tagsvalt = Replace(Tagsvalt, "WEEKA", Lang_Week_Abbr(Weekday(Tagsval)))
If InStr(Tagsvalt, "WEEK") Then Tagsvalt = Replace(Tagsvalt, "WEEK", Lang_Week(Weekday(Tagsval)))
If InStr(Tagsvalt, "MONTHA") Then Tagsvalt = Replace(Tagsvalt, "MONTHA", Lang_Month_Abbr(Month(Tagsval)))
If InStr(Tagsvalt, "MONTH") Then Tagsvalt = Replace(Tagsvalt, "MONTH", Lang_Month(Month(Tagsval)))
If InStr(Tagsvalt, "yyyy") > 0 Then Tagsvalt = Replace(Tagsvalt, "yyyy", Year(Tagsval))
If InStr(Tagsvalt, "yy") > 0 Then Tagsvalt = Replace(Tagsvalt, "yy", Right(Year(Tagsval), 2))
If InStr(Tagsvalt, "mm") > 0 Then Tagsvalt = Replace(Tagsvalt, "mm", Right("0" & Month(Tagsval), 2))
If InStr(Tagsvalt, "m") > 0 Then Tagsvalt = Replace(Tagsvalt, "m", Month(Tagsval))
If InStr(Tagsvalt, "dd") > 0 Then Tagsvalt = Replace(Tagsvalt, "dd", Right("0" & Day(Tagsval), 2))
If InStr(Tagsvalt, "d") > 0 Then Tagsvalt = Replace(Tagsvalt, "d", Day(Tagsval))
If InStr(Tagsvalt, "hh") > 0 Then Tagsvalt = Replace(Tagsvalt, "hh", Right("0" & Hour(Tagsval), 2))
If InStr(Tagsvalt, "h") > 0 Then Tagsvalt = Replace(Tagsvalt, "h", Hour(Tagsval))
If InStr(Tagsvalt, "nn") > 0 Then Tagsvalt = Replace(Tagsvalt, "nn", Right("0" & Minute(Tagsval), 2))
If InStr(Tagsvalt, "n") > 0 Then Tagsvalt = Replace(Tagsvalt, "n", Minute(Tagsval))
If InStr(Tagsvalt, "ss") > 0 Then Tagsvalt = Replace(Tagsvalt, "ss", Right("0" & Second(Tagsval), 2))
If InStr(Tagsvalt, "s") > 0 Then Tagsvalt = Replace(Tagsvalt, "s", Second(Tagsval))
Tagsval = Tagsvalt
End If
End If
If Len(Tag_Len) > 0 Then
If IsNumeric(Tag_Len) Then
Tag_Len = Int(Tag_Len)
For i = 1 To Len(Tagsval)
c = Abs(Asc(Mid(Tagsval, i, 1)))
If c > 255 Or c < 2 Then t = t + 2 Else t = t + 1
If t >= Tag_Len Then Tagsval = Left(Tagsval, i) & Tag_Lenext: Exit For
Next
End If
End If
If Len(Tag_Function) > 0 Then
Tag_Function = Split(Tag_Function, ",")
For i = 0 To UBound(Tag_Function)
Select Case LCase(Tag_Function(i))
Case "urlencode": Tagsval = Server.UrlEnCode(Tagsval)
Case "htmlencode": Tagsval = Server.HtmlEnCode(Tagsval)
Case "abs": Tagsval = Abs(Tagsval)
Case "trim": Tagsval = Trim(Tagsval)
Case "ucase": Tagsval = UCase(Tagsval)
Case "lcase": Tagsval = LCase(Tagsval)
Case "clearhtml": Tagsval = RegReplace(Tagsval, "(\<.+?\>)", ""): Tagsval = Replace(Trim(Tagsval), vbCrLf, " ")
Case "tags"
t = Split(Tagsval, ","): Tagsval = ""
For c = 0 To UBound(t)
If Len(Tagsval) > 0 Then Tagsval = Tagsval & ","
Tagsval = Tagsval & " <a href='" & Httpurl & Installdir & "plus/search/index.asp?keyword=" & Server.UrlEnCode(t(c)) & "'>" & t(c) & "</a>"
Next
End Select
Next
End If
If len(Tag_Width) > 0 or len(Tag_Height) > 0 then
If instr(tag_width,",") > 0 or len(tag_width)=0 then tag_width = 100 else tag_width = int(tag_width)
If instr(tag_height,",") > 0 or len(tag_height)=0 then tag_height = 100 else tag_height = int(tag_height)
Tagsval = Cutjpeg(Tagsval,Tag_Width , tag_height)
end if
If IsNull(Tagsval) Then Tagsval = ""
If TagTitle Then
TagTitle = False
Dim TitleStyle: TitleStyle = Split(Dat("Style") & ",", ",")
If Len(TitleStyle(0)) > 0 Then Tagsval = "<" & TitleStyle(0) & ">" & Tagsval & "</" & TitleStyle(0) & ">"
If Len(TitleStyle(1)) > 0 Then Tagsval = "<font color=""" & TitleStyle(1) & """>" & Tagsval & "</font>"
End If
Temp = Replace(Temp, Match.Value, Tagsval)
Next
Parser_Tags = Temp
End Function
' 判断标签
Public Function Parser_IF()
On Error Resume Next
Dim Matches, Match
Dim TestIF
Reg.Pattern = "{If:(.+?)}([\s\S]*?){Else}([\s\S]*?){End If}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
Execute ("If " & Match.SubMatches(0) & " Then TestIf = True Else TestIf = False")
If TestIF Then Content = Replace(Content, Match.Value, Match.SubMatches(1)) Else Content = Replace(Content, Match.Value, Match.SubMatches(2)) ' 替换
If Err Then Response.Write "<font color=red>" & Lang_Parser_IF_Error & "[" & Match.SubMatches(0) & "]" & Err.Description & "</font>": Err.Clear: Response.End
Next
Reg.Pattern = "{If:(.+?)}([\s\S]*?){End If}"
Set Matches = Reg.Execute(Content)
For Each Match In Matches
Execute ("If " & Match.SubMatches(0) & " Then TestIf = True Else TestIf = False")
If TestIF Then Content = Replace(Content, Match.Value, Match.SubMatches(1)) Else Content = Replace(Content, Match.Value, "") ' 替换
If Err Then Response.Write "<font color=red>" & Lang_Parser_IF_Error & "[" & Match.SubMatches(0) & "]" & Err.Description & "</font>": Err.Clear: Response.End
Next
End Function
' 正表达式替换
Public Function RegReplace(ByVal ReplaceContent, ByVal Pattern, ByVal ReplaceVal)
Reg.Pattern = Pattern
RegReplace = Reg.Replace(ReplaceContent, ReplaceVal)
End Function
' 是否存在此类标签
Public Function RegExists(ByVal Pattern, ByVal TestContent)
Reg.Pattern = Pattern
RegExists = Reg.Test(TestContent)
End Function
' 获取指定标签属性的值
'Tag_Cache = GetAttr(" $row=10 $cid={field:cid} $mode=commend ", "cache", True)
Public Function GetAttr(ByVal Tagsstr, ByVal AttrName, ByVal ReplaceSpace)
If Len(Tagsstr) <= 3 Or InStr(LCase(Tagsstr), "$" & LCase(AttrName) & "=") = 0 Then GetAttr = "": Exit Function
Dim Matches, Match
Reg.Pattern = "\$" & AttrName & "=(.+?) \$"
Set Matches = Reg.Execute(Tagsstr & " $")
For Each Match In Matches
GetAttr = Match.SubMatches(0)
Next
If ReplaceSpace Then
GetAttr = Replace(GetAttr, " ", "")
If Len(GetAttr) > 0 And IsNumeric(GetAttr) And InStr(GetAttr, ",") = 0 Then GetAttr = Int(GetAttr)
End If
End Function
' 载入模板
Public Function Loadfile()
Dim Obj
On Error Resume Next
Set Obj = Server.CreateObject("adodb.stream")
With Obj
.Type = 2: .Mode = 3: .Open: .Charset = Response.charset : .Position = Obj.Size: .Loadfromfile Server.Mappath(Template): Content = .ReadText: .Close
End With
Set Obj = Nothing
If Err Then Response.Write "<font color=red>" & Lang_Parser_LoadFile_Error & "[" & Template & "]</font>": Response.End
End Function
public function rep(s,d)
content = replace(content,s,d)
end function
End Class
%>
猜你喜欢
- 问:我想问一下我在重新装完系统以后装SQL Server2000时提示:以前某个程序安装已在计算机上创建挂起的文件操作,运行安装
- 最近在用fso,读取txt文本文件的内容时碰到了“输入超出了文件尾 ”的运行错误,当txt中的内容为空的时候就出现这个问题了,查了
- 作用: 构建一些简单的SQL语句,结合在提交表单时使用,可以较方便<%@LANGUAGE="VBSCRIPT&
- 在网页制作中,表单中的对象总是给人一种单调与沉闷的感觉,比如说按钮、文本框等,它们一成不变的模样与颜色
- 需求:用SQL语句随机从数据库中随机取N条数据。以前不太清楚SQL语句可以直接随机取数据今天查了一下,发现有两个随机函数: newid()
- 1、前言 MySQL 是完全网络化的跨平台关系型数据库系统,同时是具有客户机/服务器体系结构的分布式数据库管理系统。它具有功能强、使用简便、
- ASP获取远程文件的通过header头信息,并返回远程文件大小信息,远程文件可以是网页或RAR,EXE任何格式的文件。以下是具体代码:<
- 前言 一直用ASP+ACCESS来编写网页和公司的内部应用系统,内部应用系统也就是大家说的OA吧,这个我也不知道,公司又叫它ERP,反正不管
- Oracle SQL语句中的Update可以和SEQUENCE联合使用,以达到更新某字段的值连续编号,而不需要使用游标去逐条遍历更新数据库记
- 数据库镜像是将数据库事务处理从一个数据库移动到不同环境中的另一个数据库中。镜像的拷贝是一个备用的拷贝,不能直接访问,它只用在错误恢复的情况下
- 有朋友问,在数据库中如何查询数据所在的行,一般我们建议一个自增字段就可以了.但是有时却会删除数据,那么那个自增字段也不正确了先不管朋友们为什
- 今年4月,我在宿舍憋出一个拖拽翻页效果原本是为自己的博客网站设计的,周二产生的灵感,周三周四逃课两天算坐标,周五回家,到傍晚才算写出了第一版
- 如何利用Image Data Type从数据库中读取图片,并在主页中显示图形?然后,写如下代码:< % @&nbs
- 发现一个非常强的CSS在线排版:CSS Text Wrapper只要你拖拽线条,你就可以得到你想要的文字版式CSS代码。可以让想让文本块呈现
- 《色彩解答》系列之一 色彩层次《色彩解答》系列之二 色彩比例我们知道在设计中有很多对比,大小的对比,形状的对比,长短的对比,多少的对比,这些
- 人们对于那些抄袭模仿的网站有诸多抱怨,但在这篇文章中,却没有冷嘲热讽的意思。但正如他们所说,“模仿是最为忠诚的奉承形式”。“如果你确实需要借
- 这段时间,关于asp的前途,关于asp的好坏的讨论贴,都有好些了。当然,大家的心都是好的,但是一些朋友说的话,真是让人郁闷。个人觉得,在现在
- 在Https页面中,如果iframe所引入页面是非https协议的页面,或者src属性不存在都可能导致浏览器弹出安全警告。本人在网上查找相关
- (5)SELECT (5-2) DISTINCT(5-3)TOP(<top_specification>)(5-1) <s
- 内容摘要:本文介绍了对数据库的基本操作:数据记录筛选(select),更新数据库(update),删除记录(delete),添加数据记录(i