📄 news_class.asp
字号:
Dim length,dataurl
Set matches=re.Execute(t)
For Each mat In matches
length=empty
'匹配datatag中的length属性
re_1.pattern=" (length=\"&""""&"(\w*)\"&""""&")"
Set matches_1=re_1.Execute(mat.value)
For Each mat_1 In matches_1
If mat_1.submatches(1)<>"" Then
length=mat_1.submatches(1)
End If
Next
dataurl=empty
'匹配data的url部分,主要针对title的,其他也可以强制连接到一个url
re_1.pattern=" (url=\"&""""&"(\w*)\"&""""&")"
Set matches_1=re_1.Execute(mat.value)
For Each mat_1 In matches_1
If mat_1.submatches(1)<>"" Then
dataurl=mat_1.submatches(1)
End If
Next
'匹配width(暂时只对pic有效)
twidth=empty
re_1.pattern=" (width=\"&""""&"(\w*)\"&""""&")"
Set matches_1=re_1.Execute(mat.value)
For Each mat_1 In matches_1
If mat_1.submatches(1)<>"" Then
twidth=mat_1.submatches(1)
End If
Next
'匹配height(暂时只对pic有效)
theight=empty
re_1.pattern=" (height=\"&""""&"(\w*)\"&""""&")"
Set matches_1=re_1.Execute(mat.value)
For Each mat_1 In matches_1
If mat_1.submatches(1)<>"" Then
theight=mat_1.submatches(1)
End If
Next
'匹配border(暂时只对pic有效)
tborder=empty
re_1.pattern=" (border=\"&""""&"(\w*)\"&""""&")"
Set matches_1=re_1.Execute(mat.value)
For Each mat_1 In matches_1
If mat_1.submatches(1)<>"" Then
tborder=mat_1.submatches(1)
End If
Next
subm=LCase(mat.submatches(1))
Select Case subm
Case "title"
t=Replace(t,mat.value,"{title}")
'判断是否需要显示标题
If dataurl<>"false" Then
'判断是否有连接到其他地址
If titleurl="" Or titleurl="http://" Then
t=Replace(t,"{title}",OpenUrl("{title}",url&"news_show.asp?id="&Id&"",cOpenWindow))
Else
t=Replace(t,"{title}",OpenUrl("{title}",TitleUrl,"_blank"))
End If
End If
'如果不是默认的黑色则显示指定颜色，否则颜色受css影响
If split(Titlestyle,",")(0)<>"#000000" Then
t=Replace(t,"{title}","<font color='"&split(Titlestyle,",")(0)&"'>{title}</font>")
End If
'判断标题是否需要加粗
If InStr(LCase(Titlestyle),"b")<>0 Then
t=Replace(t,"{title}","<b>{title}</b>")
End If
'判断标题是否需要倾斜
If InStr(LCase(Titlestyle),"i") Then
t=Replace(t,"{title}","<i>{title}</i>")
End If
t=Replace(t,"{title}",ReLenText(ReturnData("title"),length))
t=Replace(t,"{alltitle}",ReLenText(ReturnData("title"),9999))
Case "pic"
'默认url属性为false
If IsNull(dataurl) Or dataurl=empty Then
dataurl="false"
End If
'如果为true的话就产生连接
If dataurl="true" Then
If titleurl="" Or titleurl="http://" Then
dataurl=url&"news_show.asp?id="&Id&""
Else
dataurl=titleurl
End If
End If
Dim p
p="<img src='"&ReturnData(subm)&"'"
If twidth<>empty Then
p=p&" width='"&twidth&"'"
End If
If theight<>empty Then
p=p&" height='"&theight&"'"
End If
If tborder<>empty Then
p=p&" border='"&tborder&"'"
End If
p=p&">"
t=Replace(t,mat.value,OpenUrl(ReLenText(p,length),dataurl,cOpenWindow))
Case Else
'默认url属性为false
If IsNull(dataurl) Or dataurl=empty Then
dataurl="false"
End If
'如果为true的话就产生连接
If dataurl="true" Then
If titleurl="" Or titleurl="http://" Then
dataurl=url&"news_show.asp?id="&Id&""
Else
dataurl=titleurl
End If
End If
t=Replace(t,mat.value,OpenUrl(ReLenText(ReturnData(subm),length),dataurl,cOpenWindow))
End Select
Next
'showtag标签,用以表示什么条件下显示某些要素
re.Pattern="<lb:showtag[^<>]* (?:condition="&""""&"(\w+) (\+|\-|\*|\/|(?:instr)|(?:datediff)) (\w+) (=|>|<|(?:<>)) (\d)"&""""&"){1}[^<>]*></lb:showtag>"
Set matches=re.Execute(t)
Dim smat0,smat1,smat2
Dim rtype,value
For Each mat In matches
'匹配showtag中的type属性
rtype="text"
re_1.pattern=" (type="&""""&"((?:text)|(?:image))"&""""&")"
Set matches_1=re_1.Execute(mat.value)
For Each mat_1 In matches_1
If mat_1.submatches(1)<>"" Then
rtype=mat_1.submatches(1)
End If
Next
'匹配showtag中的value属性
value=""
re_1.pattern=" (value="&""""&"(.*)"&""""&")"
Set matches_1=re_1.Execute(mat.value)
For Each mat_1 In matches_1
If mat_1.submatches(1)<>"" Then
value=mat_1.submatches(1)
End If
Next
'sdata=绑定数据库中的字段名
'soperator=运算符,包括+,-,*,/,instr,datediff
'sobject=运算对象
'sor=运算结果符号,包括=,<,>,<>
'sresult=运算结果,只能是数字,真为1,假为0
'如果整个表达式condition为true则显示相关要素,否则不显示
sdata=mat.submatches(0)
soperator=mat.submatches(1)
sobject=mat.submatches(2)
sor=mat.submatches(3)
sresult=mat.submatches(4)
Select Case soperator
Case "instr"
If ReturnResult(CBool(InStr(ReturnData(sdata),sobject)),sor,CBool(CInt(sresult))) Then
t=replace(t,mat.value,ReturnType(rtype,value))
else
t=Replace(t,mat.value,"")
End If
Case "datediff"
If LCase(sobject)="now" Then
sobject=Now()
End If
'Response.Write ReturnType(rtype,value)
If ReturnResult(DateDiff("d",CDate(ReturnData(sdata)),CDate(sobject)),sor,CInt(sresult)) Then
t=replace(t,mat.value,ReturnType(rtype,value))
else
t=Replace(t,mat.value,"")
End If
Case "+"
' Response.Write CStr(ReturnResult(CLng(ReturnData(sdata))+CLng(sobject),sor,CLng(sresult)))
' Response.Write CLng(ReturnData(sdata))+CLng(sobject)
' Response.Write sor
' Response.Write CLng(sresult)
' Response.Write rtype
' Response.Write value
' Response.Write ReturnType(rtype,value)
If ReturnResult(CLng(ReturnData(sdata))+CLng(sobject),sor,CLng(sresult)) Then
t=replace(t,mat.value,ReturnType(rtype,value))
else
t=Replace(t,mat.value,"")
End If
Case "-"
If ReturnResult(CLng(ReturnData(sdata))-CLng(sobject),sor,CLng(sresult)) Then
t=replace(t,mat.value,ReturnType(rtype,value))
else
t=Replace(t,mat.value,"")
End If
Case "*"
If ReturnResult(CLng(ReturnData(sdata))*CLng(sobject),sor,CLng(sresult)) Then
t=replace(t,mat.value,ReturnType(rtype,value))
else
t=Replace(t,mat.value,"")
End If
Case "/"
If ReturnResult(CLng(ReturnData(sdata))/CLng(sobject),sor,CLng(sresult)) Then
t=replace(t,mat.value,ReturnType(rtype,value))
else
t=Replace(t,mat.value,"")
End If
Case Else
End Select
Next
Set mat=Nothing
Set mat_1=Nothing
Set matches=Nothing
Set matches_1=Nothing
Set re=Nothing
Set re_1=Nothing
TemplateCode=t
End Function
'# ----------------------------------------------------------------------------
'# 函数：ReturnResult
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
Private Function ReturnResult(r1,op,r2)
returnResult=false
r1=CLng(r1)
r2=CLng(r2)
Select Case op
Case "="
If r1=r2 Then
ReturnResult=true
Else
ReturnResult=false
End If
Case ">"
If r1>r2 Then
ReturnResult=true
Else
ReturnResult=false
End If
Case "<"
If r1<r2 Then
ReturnResult=true
Else
ReturnResult=false
End If
Case "<>"
If r1<>r2 Then
ReturnResult=true
Else
ReturnResult=false
End If
Case Else
End Select
End Function
'# ----------------------------------------------------------------------------
'# 函数：ReturnType
'# 描述：
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
Private Function ReturnType(rtype,rvalue)
Select Case rtype
Case "text"
ReturnType=rvalue
Case "image"
ReturnType="<img src='"&rvalue&"' border=0>"
Case Else
End Select
End Function
'# ----------------------------------------------------------------------------
'# 函数：ReturnData
'# 描述：返回数据库内容
'# 参数： -
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
Public Function ReturnData(text)
Select Case text
Case "title"
ReturnData=TiTle
Case "categoryid"
ReturnData=CategoryID
Case "categoryname"
ReturnData=CategoryName
Case "ctid"
ReturnData=CtID
Case "id"
ReturnData=ID
Case "titlestyle"
ReturnData=TitleStyle
Case "titleurl"
ReturnData=TitleUrl
Case "content"
ReturnData=Content
Case "writer"
ReturnData=Writer
Case "source"
ReturnData=Source
Case "keyword"
ReturnData=KeyWord
Case "attribute"
ReturnData=Attribute
Case "text"
ReturnData=Text
Case "username"
ReturnData=UserName
Case "dateandtime"
ReturnData=DateAndTime
Case "year"
ReturnData=CStr(Year(dateandtime))
Case "month"
ReturnData=CStr(month(dateandtime))
Case "day"
ReturnData=CStr(day(dateandtime))
Case "hour"
ReturnData=CStr(hour(dateandtime))
Case "minute"
ReturnData=CStr(minute(dateandtime))
Case "second"
ReturnData=CStr(second(dateandtime))
Case "template"
ReturnData=cstr(Template)
Case "pass"
ReturnData=cstr(pass)
Case "hits"
ReturnData=cstr(Hits)
Case "orderid"
ReturnData=cstr(orderid)
Case "pic"
ReturnData=Pic
Case "categorytype"
ReturnData=CategoryType
Case Else
End Select
End Function
'# ----------------------------------------------------------------------------
'# 函数：GetNextCategoryID
'# 描述：调用下级分类
'# 参数： ntype-类型(v,h),v为竖向调用,h为横向调用,cid-调用cid的下级分类
'# 返回：
'# 作者：雷の龙
'# 日期：2004
'#-----------------------------------------------------------------------------
Public Function GetNextCategoryID(cid,ntype,url)
Dim rs
Set rs=ActionConn.execute("select categoryid from category where id="&cid)
Dim ctid
Dim c
If Not rs.eof Then
ctid=rs(0)
End If
If cid="-1" Then
Set rs=ActionConn.execute("select * from category where categorytype='新闻' and len(categoryid)=5")
else
Set rs=ActionConn.execute("select * from category where categorytype='新闻' and len(categoryid)="&Len(ctid)+5&" and left(categoryid,"&Len(ctid)&")='"&ctid&"'")
End If
If ntype="h" Then
c=""
c=c&"<table width=100% border=0 cellpadding=0 cellspacing=0>"
c=c&"<tr>"
Do While not rs.eof
c=c&"<td align=center><a href='"&url&"?categoryid="&rs("id")&"'>"&rs("categoryname")&"</a></td>"
rs.MoveNext
loop
c=c&"</tr>"
c=c&"</table>"
ElseIf ntype="v" Then
c=""
c=c&"<table width=100% border=0 cellpadding=0 cellspacing=0>"
Do While not rs.eof
c=c&"<tr>"
c=c&"<td align=center><a href='"&url&"?categoryid="&rs("id")&"'>"&rs("categoryname")&"</a></td>"
c=c&"</tr>"
rs.MoveNext
loop
c=c&"</table>"
End If
GetNextCategoryID=c
End Function
End Class
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -