📄 act.code.asp
字号:
Dim LabelRS
Set LabelRS =ACTCMS.ActExe("Select LabelType,LabelName,LabelContent from Label_Act")
Dim i,SQL:SQL=LabelRS.getrows(-1)
Set LabelRS = Nothing
For i=0 To UBound(SQL,2)
If SQL(0,i) = 2 Then
Content = Replace(Content, SQL(1,i), FreeLabel(SQL(2,i)))
Else
Content = Replace(Content, SQL(1,i), SQL(2,i))
End If
Next
AllLabel = Content
End Function
Function ReplaceAllLabel(Content)
Dim D:Set D=New ACTFreeLabel
Content=D.ReplaceReeLabel(Content) '替换自定义函数标签
Set D=nothing
ReplaceAllLabel =Content
End Function
'替换自由标签为内容
Function FreeLabel(Content)
Dim LabelRS
Set LabelRS =ACTCMS.ActExe("Select LabelName,LabelContent from Label_Act")
Dim i,SQL:SQL=LabelRS.getrows(-1)
Set LabelRS = Nothing
For i=0 To UBound(SQL,2)
Content = Replace(Content, SQL(0,i),SQL(1,i))
Next
FreeLabel = Content
End Function
Function LableFlag(Content)
Dim regEx, Matches, Match, TempStr
Set regEx = New RegExp
regEx.Pattern = "{\$[^{\$}]*}"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Content)
LableFlag = Content
For Each Match In Matches
on error resume next
TempStr = Match.Value
TempStr = Replace(TempStr, Chr(13) & Chr(10), "")
TempStr = Replace(TempStr, "{$", "")
TempStr = Replace(TempStr, "}", "")
TempStr = Left(TempStr, InStr(TempStr, "(") - 1) & "§" & MID(TempStr, InStr(TempStr, "(") + 1)
TempStr = Left(TempStr, InStrRev(TempStr, ")") - 1)
TempStr = Replace(TempStr, """", "")
If Err.Number = 0 Then
LableFlag = Replace(LableFlag, Match.Value, MakeLablelFunction(TempStr))'转换标签
End If
Next
End Function
Function MakeLablelFunction(LabelContent)
Dim LabelArr:LabelArr = Split(LabelContent, "§")
If LabelArr(0) = "" Then
MakeLablelFunction = ""
Exit Function
End If
Select Case UCase(LabelArr(0))
Case "GETARTICLELIST"
MakeLablelFunction = ACT_A_List(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5), LabelArr(6), LabelArr(7), LabelArr(8), LabelArr(9), LabelArr(10), LabelArr(11), LabelArr(12), LabelArr(13),LabelArr(14),LabelArr(15),LabelArr(16),LabelArr(17),LabelArr(18),LabelArr(19),LabelArr(20),LabelArr(21),LabelArr(22),LabelArr(23),LabelArr(24),LabelArr(25),LabelArr(26),LabelArr(27),LabelArr(28))'函数调用并执行SQL返回结果
Case "GETNAVIGATION"
MakeLablelFunction =GetNavigation(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5))
Case "GETLINKLIST"
MakeLablelFunction = GetLinkList(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5), LabelArr(6), LabelArr(7), LabelArr(8))
Case "GETARTICLEPIC"'图文混排
MakeLablelFunction =ACT_P(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5), LabelArr(6), LabelArr(7), LabelArr(8), LabelArr(9), LabelArr(10), LabelArr(11), LabelArr(12),LabelArr(13),LabelArr(14),LabelArr(15),LabelArr(16),LabelArr(17),LabelArr(18),LabelArr(19),LabelArr(20),LabelArr(21),LabelArr(22),LabelArr(23))
Case "GETSLIDE" '幻灯片
MakeLablelFunction = ACTCMS_GetSlIDe(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5), LabelArr(6), LabelArr(7), LabelArr(8), LabelArr(9), LabelArr(10), LabelArr(11))
Case "GETLASTARTICLELIST" '文章分页列表函数
If AcTCMS.ACT_C(Application(AcTCMSN & "ModeID"),3) = "0" Or Application(AcTCMSN & "Make")="No" Then
MakeLablelFunction=LabelContent
Application("PageParam")=LabelContent
Application(AcTCMSN & "Make")="Yes"
Else
MakeLablelFunction = GetLastArticleList(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5), LabelArr(6), LabelArr(7), LabelArr(8), LabelArr(9), LabelArr(10), LabelArr(11), LabelArr(12), LabelArr(13),LabelArr(14),LabelArr(15),LabelArr(16),LabelArr(17),LabelArr(18),LabelArr(19),LabelArr(20),LabelArr(21),LabelArr(22),LabelArr(23),LabelArr(24))
End If
Case "GETCLASSNAVIGATION"'总导航和栏目导航
MakeLablelFunction = GetClassNavigation(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5), LabelArr(6), LabelArr(7), LabelArr(8), LabelArr(9), LabelArr(10), LabelArr(11), LabelArr(12), LabelArr(13), LabelArr(14), LabelArr(15))
Case "CORRELATIONARTICLELIST"
MakeLablelFunction = ACT_Correlation_Article(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5), LabelArr(6), LabelArr(7), LabelArr(8), LabelArr(9), LabelArr(10), LabelArr(11), LabelArr(12), LabelArr(13),LabelArr(14),LabelArr(15),LabelArr(16),LabelArr(17),LabelArr(18),LabelArr(19),LabelArr(20),LabelArr(21),LabelArr(22))
Case "GETCLASSFORARTICLELIST"
MakeLablelFunction = GetClassForArticleList(LabelArr(1), LabelArr(2), LabelArr(3), LabelArr(4), LabelArr(5), LabelArr(6), LabelArr(7), LabelArr(8), LabelArr(9), LabelArr(10), LabelArr(11), LabelArr(12), LabelArr(13),LabelArr(14),LabelArr(15),LabelArr(16),LabelArr(17),LabelArr(18),LabelArr(19),LabelArr(20),LabelArr(21),LabelArr(22),LabelArr(23),LabelArr(24),LabelArr(25),LabelArr(26),LabelArr(27),LabelArr(28),LabelArr(29),LabelArr(30))'函数调用并执行SQL返回结果
Case Else
MakeLablelFunction = LabelArr(0)&"标签执行错误"
Exit Function
End Select
End Function
Function FSOSaveFile(Templetcontent,FileName)
on error resume next
Dim FileFSO,FileType
Set FileFSO = Server.CreateObject("ADODB.Stream")
With FileFSO
.Type = 2
.Mode = 3
.Open
.Charset = "gb2312"
.Position = FileFSO.Size
.WriteText Templetcontent&vbcrlf & "<!-- Created Page at " & Now() & " ,By ActCMS.Com ,ACT Content Management System(ActCMS) -->" & vbCrLf
.SaveToFile Server.MapPath(FileName),2
If Err.Number<>0 Then
Err.Clear
Call actcms.InsertLog(actcms.rsql(Request.Cookies(AcTCMSN)("AdminName")),0,2,"生成错误")
Exit Function
End If
.Close
End With
Set FileType = nothing
Set FileFSO = nothing
End Function
Function ReplaceArticleContent(ModeID,RefreshArticle,TempletContent,ArticleContents)
Dim TempStr
on error resume next
ArticleContents=ACTCMS.ReplaceSitelink(ArticleContents)
If InStr(TempletContent, "{$ArticleSize}") <> 0 Then
ArticleContents = "<span ID=""ContentArea"">" & ArticleContents & "</span>"
TempStr = "<script Language=Javascript>" & _
"function ContentSize(size)" & _
"{document.all.ContentArea.style.fontSize=size+""px"";}" & _
"</script>"
TempStr = TempStr & "【字体：<A href=""javascript:ContentSize(16)"">大</A> <A href=""javascript:ContentSize(14)"">中</A> <A href=""javascript:ContentSize(12)"">小</A>】"
TempletContent = Replace(TempletContent, "{$ArticleSize}", TempStr)
End If
TempletContent=ReplaceMX(ModeID,TempletContent,RefreshArticle)
'TempletContent = Replace(TempletContent,"{$ArticleContent}",FormatImg(ArticleContents))
TempletContent = Replace(TempletContent,"{$ArticleContent}",ArticleContents)
TempletContent = Replace(TempletContent,"{$ArticleTitle}",ACTCMS.CloseHtml(RefreshArticle("Title")))
If InStr(TempletContent, "{$KeyTags}") > 0 Then
TempletContent = Replace(TempletContent, "{$KeyTags}",ReplaceKeyTags(1,RefreshArticle("Keywords")))
End if
If Not IsNull(RefreshArticle("Author")) And Trim(RefreshArticle("Author")) <> "" Then
TempletContent = Replace(TempletContent, "{$ArticleAuthor}", ACTCMS.Author(RefreshArticle("Author")))
Else
TempletContent = Replace(TempletContent, "{$ArticleAuthor}", "佚名")
End If
If Not IsNull(RefreshArticle("CopyFrom")) And Trim(RefreshArticle("CopyFrom")) <> "" Then
TempletContent = Replace(TempletContent, "{$ArticleCopyFrom}", ACTCMS.CopyFrom(RefreshArticle("CopyFrom")))
Else
TempletContent = Replace(TempletContent, "{$ArticleCopyFrom}", "本站原创")
End If
If Not IsNull(RefreshArticle("ArticleInput")) And Trim(RefreshArticle("ArticleInput")) <> "" Then
TempletContent = Replace(TempletContent, "{$ArticleInput}", RefreshArticle("ArticleInput"))
Else
TempletContent = Replace(TempletContent, "{$ArticleInput}", "ActCMS.com")
End If
If InStr(TempletContent, "{$IntactTitle}") <> 0 And Trim(RefreshArticle("IntactTitle")) <> "" Then
TempletContent = Replace(TempletContent, "{$IntactTitle}", RefreshArticle("IntactTitle"))
Else
TempletContent = Replace(TempletContent, "{$IntactTitle}", RefreshArticle("Title"))
End If
If InStr(TempletContent, "{$ArticleKeyWord}") > 0 Then
TempletContent = Replace(TempletContent, "{$ArticleKeyWord}", RefreshArticle("KeyWords"))
End If
If InStr(TempletContent, "{$ID}") > 0 Then
TempletContent = Replace(TempletContent, "{$ID}", RefreshArticle("ID"))
End If
If InStr(TempletContent, "{$ClassID}") > 0 Then
TempletContent = Replace(TempletContent, "{$ClassID}", Application(AcTCMSN & "ClassID"))
End If
If InStr(TempletContent, "{$ModeID}") > 0 Then
TempletContent = Replace(TempletContent, "{$ModeID}", ModeID)
End If
If InStr(TempletContent, "{$ArticleHits}") <> 0 Then
TempletContent = Replace(TempletContent, "{$ArticleHits}", "<Script Language=""Javascript"" Src=""" & Domain & "act_inc/ACT.Hits.asp?ModeID="&ModeID&"&ID=" & RefreshArticle("ID") & """></Script>")
End If
If InStr(TempletContent, "{$ArticleDate}") <> 0 Then
TempletContent = Replace(TempletContent, "{$ArticleDate}", Year(RefreshArticle("UpdateTime")) & "年" & Right("0" & Month(RefreshArticle("UpdateTime")), 2) & "月" & Right("0" & Day(RefreshArticle("UpdateTime")), 2))
End If
If InStr(TempletContent, "{$ArticleIntro}") <> 0 And Trim(RefreshArticle("Intro")) <> "" Then
TempletContent = Replace(TempletContent, "{$ArticleIntro}", RefreshArticle("Intro"))
Else
TempletContent = Replace(TempletContent, "{$ArticleIntro}", "")
End If
If InStr(TempletContent, "{$TypeComment}") Then
TempletContent = Replace(TempletContent, "{$TypeComment}", "<Script Language=""Javascript"" Src=""" & Domain & "Comment.asp?Action=Get&ModeID="&ModeID&"&ClassID=" & RefreshArticle("ClassID") & "&ID=" & RefreshArticle("ID") & """></Script>")
Else
TempletContent = Replace(TempletContent, "{$TypeComment}", "")
End If
If InStr(TempletContent, "{$WriteComment}") <> 0 And RefreshArticle("rev") = 1 Then
TempletContent = Replace(TempletContent, "{$WriteComment}", "<Script Language=""Javascript"" Src=""" & Domain & "Comment.asp?Action=Write&ModeID="&ModeID&"&ClassID=" & RefreshArticle("ClassID") & "&ID=" & RefreshArticle("ID") & """></Script>")
Else
TempletContent = Replace(TempletContent, "{$WriteComment}", "")
End If
TempletContent = Replace(TempletContent, "{$PrevArticle}", NextArticle(RefreshArticle("ID"), RefreshArticle("ClassID"), "Prev",ModeID))
TempletContent = Replace(TempletContent, "{$NextArticle}", NextArticle(RefreshArticle("ID"), RefreshArticle("ClassID"), "Next",ModeID))
ReplaceArticleContent = TempletContent
End Function
Function ReplaceMX(ModeID,TempletContent,RefreshArticle)
Dim MX_Arr,K
MX_Arr=ACTCMS.Act_MX_Arr(ModeID)
If IsArray(MX_Arr) Then
For K=0 To Ubound(MX_Arr,2)
If Not IsNull(RefreshArticle("" &MX_Arr(0,K) & "")) Then
TempletContent = Replace(TempletContent,"{$" & MX_Arr(0,K) & "}",RefreshArticle("" &MX_Arr(0,K) & ""))
Else
TempletContent = Replace(TempletContent,"{$" & MX_Arr(0,K) & "}","")
End If
Next
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -