📄 act.code.asp
字号:
<!--#include file="ACT.Search.asp" -->
<!--#include file="ACT.FreeLabel.asp" -->
<%
Class ACT_Code
Private Domain,ASys
Private Sub Class_Initialize()
Domain = AcTCMS.ActCMSDM
ASys = Actcms.ActSys
End Sub
Private Sub Class_Terminate()
End Sub
Public Function LabelReplaceAll(TemplateContent)
TemplateContent = LableFlag(AllLabel(TemplateContent))
' TemplateContent =ReplaceIf(TemplateContent)'if 判断标签
TemplateContent =ReplaceAllLabel(TemplateContent)
TemplateContent = GeneralLabel(TemplateContent)
LabelReplaceAll = TemplateContent
End Function
Public Function ArticleContent(ModeID,RefreshArticle)
on error resume next
Dim TempletContent,ArticleContents,ArticleContentArr,TotalPage,I,CurrPage,ArticlePageStr,FileName
Dim fext,n,FilePathName,StrContent,ContentText,FilePath
Application(AcTCMSN & "ClassID")=RefreshArticle("ClassID")
Application(AcTCMSN & "ACTCMS_TCJ_Type")="ARTICLECONTENT"
Application(AcTCMSN & "ModeID")=ModeID
Application(AcTCMSN & "ID")=RefreshArticle("ID")
TempletContent = LoadTemplate(RefreshArticle("TemplateUrl"))'读取模板路径
TempletContent = AllLabel(TempletContent)'标签转换
StrContent = LableFlag(GeneralLabel(TempletContent))'通用标签转换
ArticleContents = RefreshArticle("Content")
If ArticleContents="" Then ArticleContents = " "
FilePath=ASys&ACTCMS.ACT_C(ModeID,6)&RefreshArticle("FileName")
If Right(ACTCMS.ACT_C(ModeID,10),1)<>"/" Then
FilePathName= FilePath&ACTCMS.ACT_C(ModeID,11)'文件路径加扩展名,下,截取/字符.以便生成相应文件夹
FilePath=Replace(FilePathName, MID(FilePathName, InStrRev(FilePathName, "/")), "")
Else
FilePathName= FilePath&"/Index"&ACTCMS.ACT_C(ModeID,11)
End If
If InStr(ArticleContents, "[NextPage]") > 0 Then
FExt = MID(Trim(FilePathName), InStrRev(Trim(FilePathName), "."))
FileName = Replace(Trim(FilePathName), FExt, "")
End If
Call Actcms.CreateFolder(FilePath)
ArticleContentArr = Split(ArticleContents, "[NextPage]")
TotalPage = UBound(ArticleContentArr) + 1
For I = 0 To UBound(ArticleContentArr)
CurrPage = I + 1
If TotalPage > 1 Then
If I = 0 Then
ArticlePageStr = "<p><div align=center><a href=" & FileName & "_" & (CurrPage + 1) & FExt & ">下一页</a><br>"
ElseIf I = 1 And I <> TotalPage - 1 Then
ArticlePageStr = "<p><div align=center><a href=" & FilePathName & ">上一页</a> <a href=" & FileName & "_" & (CurrPage + 1) & FExt & ">下一页</a><br>"
ElseIf I = 1 And I = TotalPage - 1 Then
ArticlePageStr = "<p><div align=center><a href=" & FilePathName & ">上一页</a><br>"
ElseIf I = TotalPage - 1 Then
ArticlePageStr = "<p><div align=center><a href=" & FileName & "_" & (CurrPage - 1) & FExt & ">上一页</a><br>"
Else
ArticlePageStr = "<p><div align=center><a href=" & FileName & "_" & (CurrPage - 1) & FExt & ">上一页</a> <a href=" & FileName & "_" & (CurrPage + 1) & FExt & ">下一页</a><br>"
End If
ArticlePageStr = ArticlePageStr & "本文共<font color=red> " & TotalPage & " </font>页,第 "
For N = 1 To TotalPage
If N = 1 Then
If CurrPage = N Then
ArticlePageStr = ArticlePageStr & "<font color=red>[" & N & "]</font> "
Else
ArticlePageStr = ArticlePageStr & "<a href=" & FileName&ACTCMS.ACT_C(ModeID,11) & ">[" & N & "]</a> "
End If
Else
If CurrPage = N Then
ArticlePageStr = ArticlePageStr & "<font color=red>[" & N & "]</font> "
Else
ArticlePageStr = ArticlePageStr & "<a href=" & FileName & "_" & N & FExt & ">[" & N & "]</a> "
End If
End If
If TotalPage > 10 Then
If N Mod 10 = 0 Then ArticlePageStr = ArticlePageStr & "<br>"
End If
Next
ArticlePageStr = ArticlePageStr & "页</div></p>"
Else
ArticlePageStr = ""
End If
If CurrPage <> 1 Then FilePathName = FileName & "_" & CurrPage & FExt
ContentText=StrContent
TempletContent = ReplaceArticleContent(ModeID,RefreshArticle,ContentText,ArticleContentArr(I) & ArticlePageStr)
Call FSOSaveFile(ContentText,FilePathName)
Next
End Function
Function LoadTemplate(TempString)
on error resume next
Dim Str,A_W
set A_W=server.CreateObject("adodb.Stream")
A_W.Type=2
A_W.mode=3
A_W.charset="gb2312"
A_W.open
A_W.loadfromfile server.MapPath(TempString)
If Err.Number<>0 Then Err.Clear:LoadTemplate="当前模板路径:<font color=red>"&TempString&"</font><br>模板没有找到 <br> by ACTCMS":Exit Function
Str=A_W.readtext
A_W.Close
Set A_W=nothing
LoadTemplate=Str
End function
Public Function GeneralLabel(FileContent)
on error resume next
FileContent = ReplaceChannel(FileContent)'栏目标签
FileContent = ReplaceMode(FileContent)'栏目标签
Dim HtmlLabel,HtmlLabelArr, Param,I,Act_S
Set Act_S = New ACT_Search
FileContent = Act_S.ACT_SearchCls(FileContent,Application(AcTCMSN & "ModeID"))
Set Act_S=Nothing
FileContent = Replace(FileContent, "{$SiteName}",AcTCMS.ActCMS_Sys(0))
FileContent = Replace(FileContent, "{$SiteTitle}", AcTCMS.ActCMS_Sys(1))
FileContent = Replace(FileContent, "{$Keywords}", AcTCMS.ActCMS_Other(1))
FileContent = Replace(FileContent, "{$Description}", AcTCMS.ActCMS_Other(2))
FileContent = Replace(FileContent, "{$CopyRight}", AcTCMS.ActCMS_Other(0))
FileContent = Replace(FileContent, "{$InstallDir}", AcTCMS.ActCMS_Sys(3))
FileContent = Replace(FileContent, "{$Logo}", AcTCMS.ActCMS_Sys(5))
FileContent = Replace(FileContent, "{$AdminName}", AcTCMS.ActCMS_Sys(6))
FileContent = Replace(FileContent, "{$AdminMail}", AcTCMS.ActCMS_Sys(7))
FileContent = Replace(FileContent, "{$AdminDir}", AcTCMS.ActCMS_Sys(8))
FileContent = Replace(FileContent, "{$actcms}", "Powered by <A href=""http://www.actcms.com"" target=""_blank""> ACTCMS 2.0</a>")
If InStr(FileContent, "{=GetTags") <> 0 Then
HtmlLabel = SelectLabelParameter(FileContent, "{=GetTags")
HtmlLabelArr=Split(HtmlLabel,"$$$")
For I=0 To Ubound(HtmlLabelArr)
Param = Split(FunctionLabelParam(HtmlLabelArr(I), "{=GetTags"),",")
FileContent = Replace(FileContent, HtmlLabelArr(I), GetTags(Param(0),Param(1)))
Next
End If
If InStr(FileContent, "{=TodayRenewal") <> 0 Then
HtmlLabel = SelectLabelParameter(FileContent, "{=TodayRenewal")
HtmlLabelArr=Split(HtmlLabel,"$$$")
For I=0 To Ubound(HtmlLabelArr)
Param = Split(FunctionLabelParam(HtmlLabelArr(I), "{=TodayRenewal"),",")
FileContent = Replace(FileContent, HtmlLabelArr(I), AcTCMS.TodayRenewal(Param(0)))
Next
End If
If InStr(FileContent, "{=CountClass") <> 0 Then
HtmlLabel = SelectLabelParameter(FileContent, "{=CountClass")
HtmlLabelArr=Split(HtmlLabel,"$$$")
For I=0 To Ubound(HtmlLabelArr)
Param = Split(FunctionLabelParam(HtmlLabelArr(I), "{=CountClass"),",")
FileContent = Replace(FileContent, HtmlLabelArr(I), AcTCMS.CountClass(Param(0)))
Next
End If
If InStr(FileContent, "{=SysCount") <> 0 Then
HtmlLabel = SelectLabelParameter(FileContent, "{=SysCount")
HtmlLabelArr=Split(HtmlLabel,"$$$")
For I=0 To Ubound(HtmlLabelArr)
Param = Split(FunctionLabelParam(HtmlLabelArr(I), "{=SysCount"),",")
FileContent = Replace(FileContent, HtmlLabelArr(I), AcTCMS.SysCount(Param(0)))
Next
End If
If InStr(FileContent, "{=UserLogin") <> 0 Then
HtmlLabel = SelectLabelParameter(FileContent, "{=UserLogin")
HtmlLabelArr=Split(HtmlLabel,"@@@")
For I=0 To Ubound(HtmlLabelArr)
Param = Split(FunctionLabelParam(HtmlLabelArr(I), "{=UserLogin"),",")
FileContent = Replace(FileContent, HtmlLabelArr(I), "<iframe wIDth="&Param(0)&" height="&Param(1)&" ID=""loginframe"" name=""loginframe"" src=""" & Domain & "User/Userlogin.asp"" frameBorder=""0"" scrolling=""no"" allowtransparency=""true""></iframe>")
Next
End If
GeneralLabel = FileContent
End Function
Function ReplaceChannel(FileContent)
on error resume next
If Application(AcTCMSN & "ACTCMS_TCJ_Type")<>"Folder" Then ReplaceChannel=FileContent:Exit Function
FileContent = Replace(FileContent, "{$ClassID}",Actcms.ACT_L(Application(AcTCMSN & "ClassID"),0))
FileContent = Replace(FileContent, "{$ClassName}",Actcms.ACT_L(Application(AcTCMSN & "ClassID"),2))
FileContent = Replace(FileContent, "{$ClassKeywords}", Actcms.ACT_L(Application(AcTCMSN & "ClassID"),8))
FileContent = Replace(FileContent, "{$ClassDescription}", Actcms.ACT_L(Application(AcTCMSN & "ClassID"),9))
ReplaceChannel = FileContent
End Function
Function ReplaceMode(FileContent)
on error resume next
If Application(AcTCMSN & "ACTCMS_TCJ_Type")<>"ACTCMSMODE" Then ReplaceMode=FileContent:Exit Function
FileContent = Replace(FileContent, "{$ModeName}",ACTCMS.ACT_C(Application(AcTCMSN & "ModeID"),1))
FileContent = Replace(FileContent, "{$Modekeywords}",ACTCMS.ACT_C(Application(AcTCMSN & "ModeID"),17))
FileContent = Replace(FileContent, "{$Modedescription}",ACTCMS.ACT_C(Application(AcTCMSN & "ModeID"),18))
ReplaceMode = FileContent
End Function
Function GetTags(Num,TagType)
on error resume next
if not isnumeric(num) then exit function
dim sqlstr,sql,i,n,str
select case cint(tagtype)
case 1:sqlstr="select top "&Num&" TagsChar,ModeID from Tags_ACT order by hits desc"
case 2:sqlstr="select top "&Num&" TagsChar,ModeID from Tags_ACT order by ClicksTime desc,ID desc"
case 3:sqlstr="select top "&Num&" TagsChar,ModeID from Tags_ACT order by AddTime desc,ID desc"
Case Else : sqlstr="select top "&Num&" TagsChar,ModeID from Tags_ACT order by hits desc"
end Select
dim rs:set rs=ACTCMS.ActExe(sqlstr)
if rs.eof then rs.close:set rs=nothing:exit function
sql=rs.getrows(-1)
rs.close:set rs=Nothing
for i=0 to ubound(sql,2)
if Actcms.FoundInArr(str,sql(0,i),",")=false Then
n=n+1
str=str & "," & sql(0,i)
gettags=gettags & " <a href=""" & Domain & "plus/search/search.asp?searchtype=5&ModeID=" & sql(1,i) & "&tags=" & sql(0,i)& """ target=""_blank"">" & sql(0,i) & "</a> "
end if
if n>=cint(num) then exit for
next
End Function
'将标签名称转换成对应标签内容
Function AllLabel(Content)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -