TSYS2.0标签说明
最近好多人对tsys很感兴趣,其实大家不知道的是tsys的asp版本早就已经停止开发了,为了不想让如此优秀的东西被埋没所以我在tsys的asp版本的基础上使用PHP重新开发了一个功能更强的cms,名字是blackhand,这个版本保留了tsys所有的优点,另外屏蔽了tsys的缺点,还增加了诸多很棒的功能,大家如果感兴趣可以看一下.
'方法:资源字段读取标签处理 TSYS:data(字段名)
'参数:Tsys标签
'返回:资源字段数据
Private Function TSYSTAG_Data_Field(myFlag)
TSYSTAG_Data_Field = ""
If Trim(myFlag.Value) <> "" Or Not IsNull(myFlag.Value) Then
TSYSTAG_Data_Field = RsInfo(Trim(myFlag.Value))
End If
End Function
'方法:相关资源列表 TSYS:relate_list(数目, "相关列表样式模板")
'参数:Tsys标签
'返回:分页列表Html字符串
'说明:
' 相关列表样式模板:便用用户定义个性化的相关列表效果
'样式模板内部可用的动态变量有:
' $id$ 资源id
' $title$ 资源标题
' $url$ & nbsp; 资源访问地址
' $author$ 作者
' $addtime$ 添加时间
' $class_title$ 频道名称
' $class_id$ 频道id
' $class_url$ 频道地址
Private Function TSYSTAG_Relate_List(myFlag)
Dim Relate_IdList
Relate_IdList = RsInfo("relate_list")
If IsNull(Relate_IdList) Or Relate_IdList = "" Then
TSYSTAG_Relate_List = ""
Exit Function
End If
Dim regEx, Matches
Set regEx = New RegExp
regEx.IgnoreCase = False
regEx.Global = False
regEx.MultiLine = False
regEx.Pattern = "[\s]{0,}([\d]+)[\s]{0,},[\s]{0,}'([^']{0,})'"
Set Matches = regEx.Execute(myFlag.value)
TSYSTAG_Relate_List = ""
Dim strTemplate, strTemplate2, TopNum
strTemplate2 = ""
If Matches.Count = 0 Then
strTemplate = ""
TopNum = 10
Else
strTemplate = Trim(Matches(0).SubMatches(1))
TopNum = FLib.SafeSql(Matches(0).SubMatches(0))
End If
If strTemplate = "" Then
strTemplate = "·<a href=""$url$"" target=""_blank"">$title$</a> <font color=""#808080"">[$addtime$]</font>$br$"
End If
Dim Sql, Rs, strHtml
strHtml = ""
Sql = "select TOP " & TopNum & " id, title, author, visit_url, addtime, class_title, class_id, home_url FROM view_resource where id IN (" & Relate_IdList & ")"
Set Rs = Db.ExeCute(Sql)
While Not Rs.Eof
strTemplate2 = Replace(strTemplate, "$id$", Rs("id"))
strTemplate2 = Replace(strTemplate2, "$title$", Rs("title"))
strTemplate2 = Replace(strTemplate2, "$url$", Rs("visit_url"))
strTemplate2 = Replace(strTemplate2, "$author$", Rs("author"))
strTemplate2 = Replace(strTemplate2, "$addtime$", FLib.FormatMyDate(Rs("addtime"), "{y}-{m}-{d}"))
strTemplate2 = Replace(strTemplate2, "$class_title$", Rs("class_title"))
strTemplate2 = Replace(strTemplate2, "$class_id$", Rs("class_id"))
strTemplate2 = Replace(strTemplate2, "$class_url$", Rs("home_url"))
strTemplate2 = Replace(strTemplate2, "$br$", "<br>")
strHtml = strHtml & strTemplate2 & vbCrLf
Rs.MoveNext()
Wend
Rs.Close()
Set Rs = Nothing
Set regEx = Nothing
Set Matches = Nothing
TSYSTAG_Relate_List = strHtml
Set strHtml = Nothing
End Function
'方法:分页列表 TSYS:pages_list(分页类型,'分页样式模板','当前页时的分页样式模板')
'参数:Tsys标签
'返回:分页列表Html字符串
'说明:
' 分页列表样式模板:便用用户定义个性化的分页列表效果
'样式模板内部可用的动态变量有:
' $id$ 资源id
' $title$ 资源标题
' $title2$ 资源标题2, 经过Html标签清除处理
' $title3$ 资源标题3, 经过url编码、Html标签清除处理
' $url$ 资源访问地址
' $page$ 当前页号
' $addtime$ 添加时间, {y}-{m}-{d}
' $addtime2$ 添加时间2, {d}/{m}
Private Function TSYSTAG_Pages_List(myFlag)
Dim regEx, Matches
Set regEx = New RegExp
regEx.IgnoreCase = False
regEx.Global = False
regEx.MultiLine = False
regEx.Pattern = "([\d]+)[\s]{0,},[\s]{0,}'([^']{0,})'[\s]{0,},[\s]{0,}'([^']{0,})'"
Set Matches = regEx.Execute(myFlag.value)
TSYSTAG_Pages_List = ""
Dim strTemplate, strTemplate_CurrPage, ListType
If Matches.Count = 0 Then
strTemplate = ""
strTemplate_CurrPage = ""
Else
strTemplate = Trim(Matches(0).SubMatches(1))
strTemplate_CurrPage = Trim(Matches(0).SubMatches(2))
ListType = Matches(0).SubMatches(0)
End If
If strTemplate = "" Then
strTemplate = "<a href=""$url$"" title=""$title2$"">[$page$]</a> "
End If
If strTemplate_CurrPage = "" Then
strTemplate_CurrPage = "<a href=""$url$"" title=""$title2$""><b>[$page$]</b></a> "
End If
If RsInfo("pages_count") = 0 Then
Set regEx = Nothing
Set Matches = Nothing
Exit Function
End If
Dim Sql, Rs, I, strHtml, tmpTitle, tmpTemplate, VisitUrl
I = 1
If RsInfo("pages_head") = -1 Then
Sql = "select TOP " & RsInfo("pages_count") & " id, title, visit_url, addtime FROM resource_list where id=" & RsInfo("id") & " Or pages_head=" & RsInfo("id") & " ORDER BY pages_position"
Else
Sql = "select TOP " & RsInfo("pages_count") & " id, title, visit_url, addtime FROM resource_list where id=" & RsInfo("pages_head") & " Or pages_head=" & RsInfo("pages_head") & " ORDER BY pages_position"
End If
Set Rs = Db.ExeCute(Sql)
While Not Rs.Eof
'If IsNull(Rs("visit_url")) Or Rs("visit_url") = "" Then
' VisitUrl = ""
'Else
VisitUrl = Rs("visit_url")
' End If
If Rs("id") = RsInfo("id") Then
tmpTemplate = strTemplate_CurrPage
Else
tmpTemplate = strTemplate
End If
tmpTemplate = Replace(tmpTemplate, "$id$", Rs("id"))
tmpTitle = Rs("title")
tmpTemplate = Replace(tmpTemplate, "$title$", tmpTitle)
tmpTitle = RegReplace("<.*?>", tmpTitle, "")
tmpTemplate = Replace(tmpTemplate, "$title2$", tmpTitle)
tmpTemplate = Replace(tmpTemplate, "$title3$", Server.UrlEncode(tmpTitle))
tmpTemplate = Replace(tmpTemplate, "$url$", VisitUrl)
tmpTemplate = Replace(tmpTemplate, "$page$", I)
tmpTemplate = Replace(tmpTemplate, "$addtime$", FLib.FormatMyDate(Rs("addtime"), "{y}-{m}-{d}"))
tmpTemplate = Replace(tmpTemplate, "$br$", "<br>")
strHtml = strHtml & tmpTemplate
I = I + 1
Rs.MoveNext()
Wend
Rs.Close()
Set Rs = Nothing
If strHtml <> "" Then
If ListType = "1" Then
TSYSTAG_Pages_List = "<select onchange=""location=this.options[this.options.selectedIndex].value"">" & strHtml & "</option>"
Else
TSYSTAG_Pages_List = strHtml
End If
Else
TSYSTAG_Pages_List = strHtml
End If
Set regEx = Nothing
Set Matches = Nothing
Set strHtml = Nothing
End Function
'方法:字符url编码 TSYS:urlencode(字符串)
'参数:Tsys标签
'返回:url编码后数据
Private Function TSYSTAG_UrlEncode(myFlag)
TSYSTAG_UrlEncode = ""
If myFlag.Value = "" Or IsNull(myFlag.Value) Then
Exit Function
End If
TSYSTAG_UrlEncode = Server.UrlEncode(myFlag.Value)
End Function
'方法:字符串截取函数 TSYS:left(字符串, 截取长度, '补给串')
'参数:Tsys标签
'返回:截取后字符串
Private Function TSYSTAG_Left(myFlag)
Dim regEx, Matches
Set regEx = New RegExp
regEx.IgnoreCase = False
regEx.Global = False
regEx.MultiLine = False
regEx.Pattern = "([^\,]{0,}),[\s]{0,}([\d]+)[\s]{0,},[\s]{0,}'([^']{0,})'"
Set Matches = regEx.Execute(myFlag.Value)
TSYSTAG_Left = ""
If Matches.Count > 0 Then
' If Len(Matches(0).SubMatches(0))<=CInt(Matches(0).SubMatches (1)) Then
'TSYSTAG_Left = Matches(0).SubMatches(0)
' Else
'TSYSTAG_Left = Left(Matches(0).SubMatches(0), Matches(0).SubMatches(1)) & Matches(0).SubMatches(2)
'End If
l=len(Matches(0).SubMatches(0))
t=0
For m_i = 1 To l
c = Abs(Asc(Mid(Matches(0).SubMatches(0),m_i,1)))
If c > 255 Then
t = t+2
Else
t = t+1
End If
If t>= 2*CInt(Matches(0).SubMatches(1)) Then
TSYSTAG_Left = left(Matches(0).SubMatches(0),m_i)& Matches(0).SubMatches(2)
exit for
Else
TSYSTAG_Left = Matches(0).SubMatches(0)
End if
Next
End If
Set regEx = Nothing
Set Matches = Nothing
End Function
'方法:格式化时间格式 TSYS:format_date(时间, '时间格式串')
'参数:Tsys标签
'返回:截取后字符串
Private Function TSYSTAG_Format_Date(myFlag)
Dim regEx, Matches
Set regEx = New RegExp
regEx.IgnoreCase = true
regEx.Global = True
regEx.MultiLine = True
regEx.Pattern = "([^\,]{0,})[\s]{0,},[\s]{0,}'([^']{0,})'"
Set Matches = regEx.Execute(myFlag.value)
Dim DateTemplate
DateTemplate = "{Y}-{m}-{d}"
TSYSTAG_Format_Date = ""
If Matches.Count > 0 Then
If Matches(0).SubMatches(1) <> "" Then
DateTemplate = Matches(0).SubMatches(1)
End If
TSYSTAG_Format_Date = FLib.FormatMyDate(Matches(0).SubMatches(0), DateTemplate)
Else
TSYSTAG_Format_Date = myFlag.Value
End If
Set regEx = Nothing
Set Matches = Nothing
End Function
'方法:清除html标签 TSYS:filter_html(字符串)
'参数:Tsys标签
'返回:清除后字符串
Private Function TSYSTAG_FilterHtml(myFlag)
TSYSTAG_FilterHtml = ""
If myFlag.Value <> "" Or Not IsNull(myFlag.Value) Then
TSYSTAG_FilterHtml = RegReplace("<.*?>", myFlag.Value, "")
End If
End Function
'####### 系统预设标签库－结束 ############################################################ #################
'####### 用户扩展标签库－开始 ############################################################ #################
'方法:清除所有空格 TSYS:trim(字符串)
'参数:Tsys标签
'返回:清除后字符串
Private Function USERTAG_TRIM(myFlag)
USERTAG_TRIM = Trim(myFlag.Value)
End Function
'####### 用户扩展标签库－结束 ############################################################ #################
另外,因为tsys的asp版本就要求站长会编写asp脚本,同样的,为了灵活性所以呢这个PHP版本就要求站长会写PHP脚本,只有如此才能更灵活,才能用它去做别的cms不敢涉及或永远做不到的功能.这才是tsys的真谛!
PHP版本的tsys浏览页面:http://hi.baidu.com/see7di/blog/item/4daf1955bd555bc8b745ae93.html
PHP版本的tsys下载地址:http://download.csdn.net/source/3248406
'方法:资源字段读取标签处理 TSYS:data(字段名)
'参数:Tsys标签
'返回:资源字段数据
Private Function TSYSTAG_Data_Field(myFlag)
TSYSTAG_Data_Field = ""
If Trim(myFlag.Value) <> "" Or Not IsNull(myFlag.Value) Then
TSYSTAG_Data_Field = RsInfo(Trim(myFlag.Value))
End If
End Function
'方法:相关资源列表 TSYS:relate_list(数目, "相关列表样式模板")
'参数:Tsys标签
'返回:分页列表Html字符串
'说明:
' 相关列表样式模板:便用用户定义个性化的相关列表效果
'样式模板内部可用的动态变量有:
' $id$ 资源id
' $title$ 资源标题
' $url$ & nbsp; 资源访问地址
' $author$ 作者
' $addtime$ 添加时间
' $class_title$ 频道名称
' $class_id$ 频道id
' $class_url$ 频道地址
Private Function TSYSTAG_Relate_List(myFlag)
Dim Relate_IdList
Relate_IdList = RsInfo("relate_list")
If IsNull(Relate_IdList) Or Relate_IdList = "" Then
TSYSTAG_Relate_List = ""
Exit Function
End If
Dim regEx, Matches
Set regEx = New RegExp
regEx.IgnoreCase = False
regEx.Global = False
regEx.MultiLine = False
regEx.Pattern = "[\s]{0,}([\d]+)[\s]{0,},[\s]{0,}'([^']{0,})'"
Set Matches = regEx.Execute(myFlag.value)
TSYSTAG_Relate_List = ""
Dim strTemplate, strTemplate2, TopNum
strTemplate2 = ""
If Matches.Count = 0 Then
strTemplate = ""
TopNum = 10
Else
strTemplate = Trim(Matches(0).SubMatches(1))
TopNum = FLib.SafeSql(Matches(0).SubMatches(0))
End If
If strTemplate = "" Then
strTemplate = "·<a href=""$url$"" target=""_blank"">$title$</a> <font color=""#808080"">[$addtime$]</font>$br$"
End If
Dim Sql, Rs, strHtml
strHtml = ""
Sql = "select TOP " & TopNum & " id, title, author, visit_url, addtime, class_title, class_id, home_url FROM view_resource where id IN (" & Relate_IdList & ")"
Set Rs = Db.ExeCute(Sql)
While Not Rs.Eof
strTemplate2 = Replace(strTemplate, "$id$", Rs("id"))
strTemplate2 = Replace(strTemplate2, "$title$", Rs("title"))
strTemplate2 = Replace(strTemplate2, "$url$", Rs("visit_url"))
strTemplate2 = Replace(strTemplate2, "$author$", Rs("author"))
strTemplate2 = Replace(strTemplate2, "$addtime$", FLib.FormatMyDate(Rs("addtime"), "{y}-{m}-{d}"))
strTemplate2 = Replace(strTemplate2, "$class_title$", Rs("class_title"))
strTemplate2 = Replace(strTemplate2, "$class_id$", Rs("class_id"))
strTemplate2 = Replace(strTemplate2, "$class_url$", Rs("home_url"))
strTemplate2 = Replace(strTemplate2, "$br$", "<br>")
strHtml = strHtml & strTemplate2 & vbCrLf
Rs.MoveNext()
Wend
Rs.Close()
Set Rs = Nothing
Set regEx = Nothing
Set Matches = Nothing
TSYSTAG_Relate_List = strHtml
Set strHtml = Nothing
End Function
'方法:分页列表 TSYS:pages_list(分页类型,'分页样式模板','当前页时的分页样式模板')
'参数:Tsys标签
'返回:分页列表Html字符串
'说明:
' 分页列表样式模板:便用用户定义个性化的分页列表效果
'样式模板内部可用的动态变量有:
' $id$ 资源id
' $title$ 资源标题
' $title2$ 资源标题2, 经过Html标签清除处理
' $title3$ 资源标题3, 经过url编码、Html标签清除处理
' $url$ 资源访问地址
' $page$ 当前页号
' $addtime$ 添加时间, {y}-{m}-{d}
' $addtime2$ 添加时间2, {d}/{m}
Private Function TSYSTAG_Pages_List(myFlag)
Dim regEx, Matches
Set regEx = New RegExp
regEx.IgnoreCase = False
regEx.Global = False
regEx.MultiLine = False
regEx.Pattern = "([\d]+)[\s]{0,},[\s]{0,}'([^']{0,})'[\s]{0,},[\s]{0,}'([^']{0,})'"
Set Matches = regEx.Execute(myFlag.value)
TSYSTAG_Pages_List = ""
Dim strTemplate, strTemplate_CurrPage, ListType
If Matches.Count = 0 Then
strTemplate = ""
strTemplate_CurrPage = ""
Else
strTemplate = Trim(Matches(0).SubMatches(1))
strTemplate_CurrPage = Trim(Matches(0).SubMatches(2))
ListType = Matches(0).SubMatches(0)
End If
If strTemplate = "" Then
strTemplate = "<a href=""$url$"" title=""$title2$"">[$page$]</a> "
End If
If strTemplate_CurrPage = "" Then
strTemplate_CurrPage = "<a href=""$url$"" title=""$title2$""><b>[$page$]</b></a> "
End If
If RsInfo("pages_count") = 0 Then
Set regEx = Nothing
Set Matches = Nothing
Exit Function
End If
Dim Sql, Rs, I, strHtml, tmpTitle, tmpTemplate, VisitUrl
I = 1
If RsInfo("pages_head") = -1 Then
Sql = "select TOP " & RsInfo("pages_count") & " id, title, visit_url, addtime FROM resource_list where id=" & RsInfo("id") & " Or pages_head=" & RsInfo("id") & " ORDER BY pages_position"
Else
Sql = "select TOP " & RsInfo("pages_count") & " id, title, visit_url, addtime FROM resource_list where id=" & RsInfo("pages_head") & " Or pages_head=" & RsInfo("pages_head") & " ORDER BY pages_position"
End If
Set Rs = Db.ExeCute(Sql)
While Not Rs.Eof
'If IsNull(Rs("visit_url")) Or Rs("visit_url") = "" Then
' VisitUrl = ""
'Else
VisitUrl = Rs("visit_url")
' End If
If Rs("id") = RsInfo("id") Then
tmpTemplate = strTemplate_CurrPage
Else
tmpTemplate = strTemplate
End If
tmpTemplate = Replace(tmpTemplate, "$id$", Rs("id"))
tmpTitle = Rs("title")
tmpTemplate = Replace(tmpTemplate, "$title$", tmpTitle)
tmpTitle = RegReplace("<.*?>", tmpTitle, "")
tmpTemplate = Replace(tmpTemplate, "$title2$", tmpTitle)
tmpTemplate = Replace(tmpTemplate, "$title3$", Server.UrlEncode(tmpTitle))
tmpTemplate = Replace(tmpTemplate, "$url$", VisitUrl)
tmpTemplate = Replace(tmpTemplate, "$page$", I)
tmpTemplate = Replace(tmpTemplate, "$addtime$", FLib.FormatMyDate(Rs("addtime"), "{y}-{m}-{d}"))
tmpTemplate = Replace(tmpTemplate, "$br$", "<br>")
strHtml = strHtml & tmpTemplate
I = I + 1
Rs.MoveNext()
Wend
Rs.Close()
Set Rs = Nothing
If strHtml <> "" Then
If ListType = "1" Then
TSYSTAG_Pages_List = "<select onchange=""location=this.options[this.options.selectedIndex].value"">" & strHtml & "</option>"
Else
TSYSTAG_Pages_List = strHtml
End If
Else
TSYSTAG_Pages_List = strHtml
End If
Set regEx = Nothing
Set Matches = Nothing
Set strHtml = Nothing
End Function
'方法:字符url编码 TSYS:urlencode(字符串)
'参数:Tsys标签
'返回:url编码后数据
Private Function TSYSTAG_UrlEncode(myFlag)
TSYSTAG_UrlEncode = ""
If myFlag.Value = "" Or IsNull(myFlag.Value) Then
Exit Function
End If
TSYSTAG_UrlEncode = Server.UrlEncode(myFlag.Value)
End Function
'方法:字符串截取函数 TSYS:left(字符串, 截取长度, '补给串')
'参数:Tsys标签
'返回:截取后字符串
Private Function TSYSTAG_Left(myFlag)
Dim regEx, Matches
Set regEx = New RegExp
regEx.IgnoreCase = False
regEx.Global = False
regEx.MultiLine = False
regEx.Pattern = "([^\,]{0,}),[\s]{0,}([\d]+)[\s]{0,},[\s]{0,}'([^']{0,})'"
Set Matches = regEx.Execute(myFlag.Value)
TSYSTAG_Left = ""
If Matches.Count > 0 Then
' If Len(Matches(0).SubMatches(0))<=CInt(Matches(0).SubMatches (1)) Then
'TSYSTAG_Left = Matches(0).SubMatches(0)
' Else
'TSYSTAG_Left = Left(Matches(0).SubMatches(0), Matches(0).SubMatches(1)) & Matches(0).SubMatches(2)
'End If
l=len(Matches(0).SubMatches(0))
t=0
For m_i = 1 To l
c = Abs(Asc(Mid(Matches(0).SubMatches(0),m_i,1)))
If c > 255 Then
t = t+2
Else
t = t+1
End If
If t>= 2*CInt(Matches(0).SubMatches(1)) Then
TSYSTAG_Left = left(Matches(0).SubMatches(0),m_i)& Matches(0).SubMatches(2)
exit for
Else
TSYSTAG_Left = Matches(0).SubMatches(0)
End if
Next
End If
Set regEx = Nothing
Set Matches = Nothing
End Function
'方法:格式化时间格式 TSYS:format_date(时间, '时间格式串')
'参数:Tsys标签
'返回:截取后字符串
Private Function TSYSTAG_Format_Date(myFlag)
Dim regEx, Matches
Set regEx = New RegExp
regEx.IgnoreCase = true
regEx.Global = True
regEx.MultiLine = True
regEx.Pattern = "([^\,]{0,})[\s]{0,},[\s]{0,}'([^']{0,})'"
Set Matches = regEx.Execute(myFlag.value)
Dim DateTemplate
DateTemplate = "{Y}-{m}-{d}"
TSYSTAG_Format_Date = ""
If Matches.Count > 0 Then
If Matches(0).SubMatches(1) <> "" Then
DateTemplate = Matches(0).SubMatches(1)
End If
TSYSTAG_Format_Date = FLib.FormatMyDate(Matches(0).SubMatches(0), DateTemplate)
Else
TSYSTAG_Format_Date = myFlag.Value
End If
Set regEx = Nothing
Set Matches = Nothing
End Function
'方法:清除html标签 TSYS:filter_html(字符串)
'参数:Tsys标签
'返回:清除后字符串
Private Function TSYSTAG_FilterHtml(myFlag)
TSYSTAG_FilterHtml = ""
If myFlag.Value <> "" Or Not IsNull(myFlag.Value) Then
TSYSTAG_FilterHtml = RegReplace("<.*?>", myFlag.Value, "")
End If
End Function
'####### 系统预设标签库－结束 ############################################################ #################
'####### 用户扩展标签库－开始 ############################################################ #################
'方法:清除所有空格 TSYS:trim(字符串)
'参数:Tsys标签
'返回:清除后字符串
Private Function USERTAG_TRIM(myFlag)
USERTAG_TRIM = Trim(myFlag.Value)
End Function
'####### 用户扩展标签库－结束 ############################################################ #################
