📄 act.freelabel.asp
字号:
<%
Class ACTFreeLabel
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
End Sub
'替换自定义函数标签
Function ReplaceReeLabel(Content)
Dim regEx, Matches, SqlLabel,Match
Dim Matchn,n
Set regEx = New RegExp
regEx.Pattern = "{ACTSQL_[^{]*\)}"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Content)
ReplaceReeLabel=Content
For Each Match In Matches
SqlLabel=Match.value
ReplaceReeLabel=Replace(ReplaceReeLabel,SqlLabel,ReplaceDIYFunctionLabel(SqlLabel,"label"))
Next
End Function
'返回循环次数
Function GetLoopNum(Content)
Dim regEx, Matches, Match
Set regEx = New RegExp
regEx.Pattern="\[loop=\d*]"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Content)
If Matches.count > 0 Then
GetLoopNum=Replace(Replace(Matches.item(0),"[loop=",""),"]","")
Else
GetLoopNum=0
end if
End Function
Function ReplaceDIYFunctionLabel(SqlLabel,GetFrom)
Dim I,ARs,LabelName,UserParamArr,FunctionLabelParamArr,CirLabelContent,FunctionSQL,LabelContent
Dim FunctionLabelType,ItemName,PageStyle,PerPageNumber,TotalPut,PageNum,J,TempStr,Ajax
LabelName = Replace(Replace(Split(SqlLabel,"(")(0),"""",""),"'","")
'用户函数参数
UserParamArr = Split(Replace(Replace(Replace(Replace(SqlLabel,LabelName&"(",""),")}",""),"""",""),"'",""),",")
Set ARs=Server.CreateObject("ADODB.RECORDSET")
ARs.Open "Select top 1 LabelContent,Description From Label_Act Where LabelName='" & LabelName & "}'",Conn,1,1
IF ARs.Eof And ARs.Bof Then
ARs.Close:Set ARs=Nothing:ReplaceDIYFunctionLabel="":Exit Function
Else
FunctionLabelParamArr = Split(ARs(0),"§")
LabelContent = Replace(ARs(1),vbcrlf,"$ACT:Page$")
End If
ARs.Close
FunctionSQL=FunctionLabelParamArr(3)
FunctionSQL=Replace(FunctionSQL,"{$CurrClassID}","'"&Application(AcTCMSN & "ClassID")&"'")'当前栏目ID
FunctionSQL=Replace(FunctionSQL,"{$CurrInfoID}",Application(AcTCMSN & "ID"))'当前ID
For I=0 To Ubound(UserParamArr)
FunctionSQL = Replace(FunctionSQL,"{$Param("&I&")}",UserParamArr(I))
LabelContent = Replace(LabelContent,"{$Param("&I&")}",UserParamArr(I))
Next
FunctionLabelType=FunctionLabelParamArr(2)
If Not Isnumeric(FunctionLabelType) Then FunctionLabelType=0
FunctionLabelType=FunctionLabelParamArr(0)
PageStyle=FunctionLabelParamArr(2)
ItemName=FunctionLabelParamArr(1)
ARs.Open FunctionSQL,Conn,1,1
If Not ARs.Eof Then
Dim regEx, Matches, Match,LoopTimes
Set regEx = New RegExp
regEx.Pattern = "\[loop=\d*].+?\[/loop]"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(LabelContent)
If FunctionLabelType=1 Then '分页标签
PerPageNumber=0
For Each Match In Matches
PerPageNumber=PerPageNumber+GetLoopNum(Match.Value) '每页记录数
Next
If PerPageNumber=0 Then ReplaceDIYFunctionLabel="自由标签的循环次数必须大于0":Exit Function
TotalPut = ARs.recordcount
if (TotalPut mod PerPageNumber)=0 then
PageNum = TotalPut \ PerPageNumber
else
PageNum = TotalPut \ PerPageNumber + 1
end if
Application(AcTCMSN & "PageStyle") = PageStyle
If ACTCMS.S("ClassID")<>"" Then
Dim CurrPage:CurrPage=ACTCMS.ChkNumeric(ACTCMS.S("Page"))
If CurrPage<=0 Then CurrPage=1
Application("PageNum")=PageNum
TempCirContent = LabelContent
ARs.Move (CurrPage - 1) * PerPageNumber
For Each Match In Matches
LoopTimes=GetLoopNum(Match.Value) '循环次数
CirLabelContent = Replace(Replace(Match.value,"[loop=" & LoopTimes&"]",""),"[/loop]","")
TempCirContent = Replace(TempCirContent,"[loop="&LoopTimes&"]"&CirLabelContent&"[/loop]",GetCirLabelContent(CirLabelContent,ARs,LoopTimes),1,1)
If ARs.Eof Then Exit For
Next
TempStr = TempCirContent & ACTCMS.GetPageList(PageStyle,ItemName,PageNum,CurrPage,TotalPut,PerPageNumber)
TempStr=TempStr &"{$PageList}" '加上分页符
ReplaceDIYFunctionLabel=Replace(CleanLabel(TempStr),"$ACT:Page$",vbcrlf)
Else
dim TempCirContent
For I = 1 To Cint(PageNum)
TempCirContent = LabelContent
For Each Match In Matches
LoopTimes=GetLoopNum(Match.Value) '循环次数
CirLabelContent = Replace(Replace(Match.value,"[loop=" & LoopTimes&"]",""),"[/loop]","")
TempCirContent=Replace(TempCirContent,"[loop="&LoopTimes&"]"&CirLabelContent&"[/loop]",GetCirLabelContent(CirLabelContent,ARs,LoopTimes),1,1)
If ARs.Eof Then Exit For
Next
TempStr = TempStr & TempCirContent & actcms.GetPageList(PageStyle,ItemName,PageNum,I,TotalPut,PerPageNumber)
TempStr=TempStr & "{$PageList}" '加上分页符
Next
Application(Cstr(AcTCMSN & "PageList")) = Replace(CleanLabel(TempStr),"$ACT:Page$",vbcrlf)
ReplaceDIYFunctionLabel="{PageListStr}"
End If
Else
Do While Not ARs.Eof
For Each Match In Matches
LoopTimes=GetLoopNum(Match.Value) '循环次数
CirLabelContent = Replace(Replace(Match.value,"[loop=" & LoopTimes&"]",""),"[/loop]","")
LabelContent = Replace(LabelContent,"[loop="&LoopTimes&"]"&CirLabelContent&"[/loop]",GetCirLabelContent(CirLabelContent,ARs,LoopTimes),1,1)
If ARs.Eof Then Exit For
Next
If ARs.Eof Then Exit Do
Loop
'消除多余的循环体
ReplaceDIYFunctionLabel=Replace(CleanLabel(LabelContent),"$ACT:Page$",vbcrlf)
End If
Else
ReplaceDIYFunctionLabel="":Exit Function
End if
ARs.Close:Set ARs=Nothing
End Function
'消除多余的循环体
Function CleanLabel(Content)
Dim regEx, Matches, Match,LoopTimes
Set regEx = New RegExp
regEx.Pattern = "\[loop=\d*][^\[\]]*\[/loop]"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Content)
For Each Match In Matches
Content=Replace(Content,Match.value,"")
Next
CleanLabel=Content
End Function
'替换循环部分内容
Function GetCirLabelContent(CirLabelContent,ByRef ARs,LoopTimes)
Dim regEx, Matches, Match, TempStr
Dim FieldParam,FieldParamArr,FieldName,FieldType,ReturnFieldValue
Dim DB_FieldValue,FieldParamLength,I,FieldPosition,N
If Not IsNumeric(LoopTimes) Then LoopTimes=10
For N=1 To LoopTimes
If Not ARs.Eof Then
Set regEx = New RegExp
regEx.Pattern = "{\$Field\([^{\$}]*}"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(CirLabelContent)
TempStr=Replace(CirLabelContent,"{$AutoID}",N)
For Each Match In Matches
FieldParam = Replace(Replace(Match.Value,"{$Field(",""),")}","")
FieldParamArr = Split(FieldParam,",")
FieldParamLength=Ubound(FieldParamArr) '参数数组长度
FieldName = FieldParamArr(0) '根据参数得到字段名称
FieldType = FieldParamArr(1) '根据参数得到字段类型
FieldPosition=0
For I=0 To ARs.Fields.count-1
IF lcase(FieldName)=lcase(ARs.Fields(I).name) Then FieldPosition=I:Exit For
Next
DB_FieldValue=ARs(FieldPosition) '得到字段的值
If lcase(FieldName)="keywords" Then
ReturnFieldValue=ReplaceKeyTags(1,DB_FieldValue)
Else
Select Case Lcase(FieldType)
Case "text"
ReturnFieldValue=Get_Text_Field(DB_FieldValue,FieldParamArr(2),FieldParamArr(3),FieldParamArr(4),FieldParamArr(5))
Case "num"
ReturnFieldValue=Get_Num_Field(DB_FieldValue,FieldParamArr(2),FieldParamArr(3))
Case "date"
ReturnFieldValue=Get_Date_Field(DB_FieldValue,FieldParamArr(2))
Case "getinfourl"
ReturnFieldValue=Get_InfoUrl_Field(FieldName,DB_FieldValue,FieldParamArr(2),FieldParamArr(3))
Case "getclassurl"
ReturnFieldValue=Get_ClassUrl_Field(FieldName,DB_FieldValue,FieldParamArr(2),FieldParamArr(3))
End Select
End iF
on error resume next
TempStr=Replace(TempStr,"{$Field(" &FieldParam &")}",ReturnFieldValue)
Next
GetCirLabelContent=GetCirLabelContent &TempStr
Else
Exit For
End If
ARs.MoveNext
Next
End Function
'取文本字段的值
Function Get_Text_Field(FieldValue,CutNum,EndTag,HtmlTag,DefaultChar)
Dim TempStr:TempStr=FieldValue
If FieldValue="" Or IsNull(FieldValue) Then TempStr=DefaultChar
If Not IsNumeric(HtmlTag) Or Not IsNumeric(CutNum) Then Exit Function
If HtmlTag=1 Then
TempStr=Server.HtmlEncode(TempStr)
ElseIF HtmlTag=2 Then
TempStr=ACTCMS.CloseHtml(TempStr)
End If
If EndTag="0" Then EndTag=""
if actcms.strLength(TempStr)>cint(CutNum) and CutNum<>0 then TempStr = actcms.GetStrValue(TempStr, CutNum) & EndTag
Get_Text_Field=TempStr
End Function
'取数字字段的值
Function Get_Num_Field(FieldValue,OutType,XSWS)
If Not IsNumeric(FieldValue) Then Get_Num_Field=FieldValue:Exit Function
If Not IsNumeric(OutType) Then OutType=0
If Not IsNumeric(XSWS) Then XSWS=0
If OutType=1 Then
Get_Num_Field=FormatNumber(FieldValue,XSWS)
ElseIf OutType=2 Then
Get_Num_Field=FormatPercent(FieldValue)
Else
Get_Num_Field=FieldValue
End if
End Function
'取日期字段的值
Function Get_Date_Field(FieldValue,DateMB)
IF Not IsDate(FieldValue) Then Get_Date_Field=FieldValue:Exit Function
Get_Date_Field=Replace(DateMB,"YYYY",Year(FieldValue))
Get_Date_Field=Replace(Get_Date_Field,"YY",Right("0" & Year(FieldValue), 2))
Get_Date_Field=Replace(Get_Date_Field,"MM",Right("0" & Month(FieldValue), 2))
Get_Date_Field=Replace(Get_Date_Field,"DD",Right("0" & Day(FieldValue), 2))
Get_Date_Field=Replace(Get_Date_Field,"hh",Right("0" & hour(FieldValue), 2))
Get_Date_Field=Replace(Get_Date_Field,"mm",Right("0" & minute(FieldValue), 2))
Get_Date_Field=Replace(Get_Date_Field,"ss",Right("0" & second(FieldValue), 2))
End Function
'取对象的链接URL
Function Get_InfoUrl_Field(byval FieldName,byval FieldValue,ModeID,OutType)
If OutType=2 Then Get_InfoUrl_Field=FieldValue:Exit Function
Dim SqlStr
If Not Isnumeric(ModeID) Then Exit Function
SqlStr="Select ID,Classid,Title,UpdateTime,ChangesLink,FileName,GroupID_ACT,Score_ACT From " & ACTCMS.ACT_C(ModeID,2) & " Where " & FieldName &"=" &FieldValue
Dim ARs:Set ARs=Server.CreateObject("ADODB.RECORDSET")
ARs.Open SqlStr,Conn,1,1
IF ARs.Eof Then
ARs.Close:Set ARs=Nothing:Exit Function
Else
If OutType=0 Then
Get_InfoUrl_Field="<a href="""&AcTCMS.GetInfoUrl(ModeID,ARs(1),ARs(0),ARs(4),ARs(5),ARs(6),ARs(7))&""" target=""_blank"">" & FieldValue &"</a>"
ElseIF OutType=1 Then
Get_InfoUrl_Field=AcTCMS.GetInfoUrl(ModeID,ARs(1),ARs(0),ARs(4),ARs(5),ARs(6),ARs(7))
End If
End if
ARs.Close:Set ARs=Nothing
End Function
'得到栏目的链接URL
Function Get_ClassUrl_Field(FieldName,FieldValue,ModeID,OutType)
If OutType=2 Then Get_ClassUrl_Field=FieldValue:Exit Function
Dim ClassID:ClassID=FieldValue
If FieldName="id" Then
Dim SqlStr:SqlStr="Select Classid From Class_ACT Where Classid='" & Conn.Execute("Select Classid From " & ACTCMS.ACT_C(ModeID,2) & " Where " & FieldName &"=" &FieldValue)(0)&"'"
Dim ARs:Set ARs=Server.CreateObject("ADODB.RECORDSET")
ARs.Open SqlStr,Conn,1,1
IF ARs.Eof Then
ARs.Close:Set ARs=Nothing:Exit Function
Else
ClassID = ARs(0)
End if
ARs.Close:Set ARs=Nothing
End IF
If OutType=0 Then
Get_ClassUrl_Field="<a href="""&actcms.GetSubClasseName(ClassID)&""" target=""_blank"">" & ACTCMS.ACT_L(classID,2) &"</a>"
ElseIF OutType=1 Then
Get_ClassUrl_Field=actcms.GetSubClasseName(ClassID)
End If
End Function
Function ReplaceKeyTags(ModeID,KeyStr)
Dim I,AcTArr:AcTArr=Split(KeyStr,"|")
For I=0 To Ubound(AcTArr)
ReplaceKeyTags=ReplaceKeyTags & "<a href=""" &ACTCMS.ACTCMSDM & "plus/search/search.asp?searchtype=5&ModeID=" & ModeID & "&tags=" & AcTArr(i) & """ target=""_blank"">" & AcTArr(i) & "</a> "
Next
End Function
End Class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -