📄 act.code.asp
字号:
End If
ReplaceMX=TempletContent
End Function
Function ReplaceKeyTags(ModeID,KeyStr)
on error resume next
If Trim(KeyStr)="" Then Exit Function
Dim I,ActArr:ActArr=Split(KeyStr,",")
For I=0 To Ubound(ActArr)
ReplaceKeyTags=ReplaceKeyTags & "<a href=""" & Domain & "plus/search/search.asp?SearchType=5&ModeID=" & ModeID & "&tags=" & ActArr(i) & """ target=""_blank"">" & ActArr(i) & "</a> "
Next
End Function
'上一篇、下一篇
Function NextArticle(NowID, classID, TypeStr,ModeID)
Dim SqlStr
If Trim(TypeStr) = "Prev" Then
SqlStr = " SELECT Top 1 ClassID,ID,ChangesLink,FileName,GroupID_ACT,Score_ACT,title From "&ACTCMS.ACT_C(ModeID,2)&" Where classID='" & Trim(classID) & "' And ID<" & NowID & " And isAccept=0 AND delif=0 Order By ID Desc"
ElseIf Trim(TypeStr) = "Next" Then
SqlStr = " SELECT Top 1 ClassID,ID,ChangesLink,FileName,GroupID_ACT,Score_ACT,title From "&ACTCMS.ACT_C(ModeID,2)&" Where classID='" & Trim(classID) & "' And ID>" & NowID & " And isAccept=0 AND delif=0 Order By ID"
Else
NextArticle = "":Exit Function
End If
Dim RS:Set RS=Server.CreateObject("ADODB.Recordset")
RS.Open SqlStr, Conn, 1, 1
If RS.EOF And RS.BOF Then
NextArticle = "没有了"
Else
NextArticle = "<a href=""" &ACTCMS.GetInfoUrl(ModeID,Rs(0),Rs(1),Rs(2),Rs(3),Rs(4),Rs(5)) & """ title=""" & ACTCMS.CloseHtml(RS("title")) & """>" & RS("title") & "</a>"
End If
RS.Close:Set RS = Nothing
End Function
Function CreateArticleList(ModeID,FolderRs)
Dim TemplateContent,FilePath,IndexHtml,FolderDir
Application(AcTCMSN & "ACTCMS_TCJ_Type")="Folder"
Application(AcTCMSN & "ModeID")=FolderRs("ModeID")
Application(AcTCMSN & "ClassID")=FolderRs("ClassID")
If Trim(FolderRs("ParentID")) = "0" Then Application(AcTCMSN & "ModeHome")= True Else Application(AcTCMSN & "ModeHome") = False
TemplateContent = LoadTemplate(FolderRs("FolderTemplate"))'模版
If TemplateContent = "" Then TemplateContent ="模板文件丢失"
TemplateContent = AllLabel(TemplateContent)'标签转换
TemplateContent = LableFlag(GeneralLabel(TemplateContent))'通用标签转换
TemplateContent =ReplaceAllLabel(TemplateContent)
IndexHtml = FolderRs("Extension")
FilePath = ASys & Actcms.ACT_C(ModeID,6)& FolderRs("ClassEName")
Call Actcms.CreateFolder(FilePath)
If (Application(Cstr(AcTCMSN & "PageList")) <> "") Then
Call GetPageStr(Application(Cstr(AcTCMSN & "PageList")), IndexHtml, TemplateContent,FilePath, True)
Application.Contents.Remove (AcTCMSN & "PageList")
Else
TemplateContent = Replace(TemplateContent, "{PageListStr}", "")
Call FSOSaveFile(TemplateContent,FilePath & IndexHtml)
End If
End Function
Sub GetPageStr(PageContent, Index, FileContent,FilePath, TypeSelect)
Dim CurrPage, PageStr, TempFileContent, I, PageContentArr, J, SelectStr
Dim TotalPage
Dim HomeLink
Dim LinkUrlFileName
Dim FileName
Dim FExt
HomeLink = Index
FExt = MID(Trim(Index), InStrRev(Trim(Index), "."))
FileName = Replace(Trim(Index), FExt, "")
LinkUrlFileName = FileName
PageContentArr = Split(PageContent, "{$PageList}")
TotalPage = UBound(PageContentArr)
For I = LBound(PageContentArr) To TotalPage - 1
CurrPage = I + 1
Select Case Application(AcTCMSN & "PageStyle")
Case 1
If CurrPage = 1 And CurrPage <> TotalPage Then
PageStr = "首页 上一页 <a href=""" & LinkUrlFileName & "_" & CurrPage + 1 & FExt & """>下一页</a> <a href= """ & LinkUrlFileName & "_" & TotalPage & FExt & """>尾页</a>"
ElseIf CurrPage = 1 And CurrPage = TotalPage Then
PageStr = "首页 上一页 下一页 尾页"
ElseIf CurrPage = TotalPage And CurrPage <> 2 Then
PageStr = "<a href=""" & HomeLink & """>首页</a> <a href=""" & LinkUrlFileName & "_" & CurrPage - 1 & FExt & """>上一页</a> 下一页 尾页"
ElseIf CurrPage = TotalPage And CurrPage = 2 Then
PageStr = "<a href=""" & HomeLink & """>首页</a> <a href=""" & HomeLink & """>上一页</a> 下一页 尾页"
ElseIf CurrPage = 2 Then
PageStr = "<a href=""" & HomeLink & """>首页</a> <a href=""" & HomeLink & """>上一页</a> <a href=""" & LinkUrlFileName & "_" & CurrPage + 1 & FExt & """>下一页</a> <a href= """ & LinkUrlFileName & "_" & (TotalPage & FExt) & """>尾页</a>"
Else
PageStr = "<a href=""" & HomeLink & """>首页</a> <a href=""" & LinkUrlFileName & "_" & CurrPage - 1 & FExt & """>上一页</a> <a href=""" & LinkUrlFileName & "_" & CurrPage + 1 & FExt & """>下一页</a> <a href= """ & LinkUrlFileName & "_" & (TotalPage & FExt) & """>尾页</a>"
End If
Case 2
If CurrPage=1 Then
PageStr="<font face=webdings>9</font> <font face=webdings>7</font>"
ElseIf CurrPage=2 Then
PageStr="<a href=""" & HomeLink & """ title=""首页""><font face=webdings>9</font></a> <a href=""" & HomeLink & """ title=""上一页""><font face=webdings>7</font></a>"
Else
PageStr="<a href=""" & HomeLink & """ title=""首页""><font face=webdings>9</font></a> <a href=""" & LinkUrlFileName & "_" & CurrPage - 1 & FExt & """ title=""上一页""><font face=webdings>7</font></a> "
End If
For J=CurrPage To CurrPage+9
If J>TotalPage Then Exit For
If J= CurrPage Then
PageStr=PageStr & " <font color=red>[" & J &"]</font>"
Else
PageStr=PageStr & " <a href=""" & LinkUrlFileName & "_" & J & FExt & """>[" & J &"]</a>"
End If
Next
If CurrPage=TotalPage Then
PageStr=PageStr & " <font face=webdings>8</font> <font face=webdings>:</font>"
Else
PageStr=PageStr & " <a href=""" & LinkUrlFileName & "_" & CurrPage + 1 & FExt & """ title=""上一页""><font face=webdings>8</font></a> <a href=""" & LinkUrlFileName & "_" & TotalPage & FExt & """><font face=webdings>:</font></a> "
End If
Case 3
If CurrPage=1 Then
PageStr="<font face=webdings>9</font> <font face=webdings>7</font>"
ElseIf CurrPage=2 Then
PageStr="<a href=""" & HomeLink & """ title=""首页""><font face=webdings>9</font></a> <a href=""" & HomeLink & """ title=""上一页""><font face=webdings>7</font></a>"
Else
PageStr="<a href=""" & HomeLink & """ title=""首页""><font face=webdings>9</font></a> <a href=""" & LinkUrlFileName & "_" & CurrPage - 1 & FExt & """ title=""上一页""><font face=webdings>7</font></a> "
End If
If CurrPage=TotalPage Then
PageStr=PageStr & " <font face=webdings>8</font> <font face=webdings>:</font>"
Else
PageStr=PageStr & " <a href=""" & LinkUrlFileName & "_" & CurrPage + 1 & FExt & """ title=""上一页""><font face=webdings>8</font></a> <a href=""" & LinkUrlFileName & "_" & TotalPage & FExt & """><font face=webdings>:</font></a> "
End If
End Select
If CBool(TypeSelect) = True Then
PageStr = PageStr & " 转到：<select name=""page"" size=""1"" onchange=""javascript:window.location=this.options[this.selectedIndex].value;"">"
For J = 1 To TotalPage
If J = CurrPage Then
SelectStr = " selected"
Else
SelectStr = ""
End If
If J = 1 Then
PageStr = PageStr & "<option value=""" & HomeLink & """" & SelectStr & ">第" & J & "页</option>"
Else
PageStr = PageStr & "<option value=""" & LinkUrlFileName & "_" & J & FExt & """" & SelectStr & ">第" & J & "页</option>"
End If
Next
PageStr = PageStr & "</select>"
End If
TempFileContent = Replace(FileContent, "{PageListStr}", PageContentArr(I) & PageStr & "</div></div>")
Dim TempFilePath
If CurrPage = 1 Then
TempFilePath =FilePath&Index
Else
TempFilePath = FilePath&FileName & "_" & CurrPage & FExt
End If
Call FSOSaveFile( TempFileContent, TempFilePath)
Next
End Sub
Function FormatImg(content)
dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(script)"
Content=re.Replace(Content,"script")
re.Pattern="<img.[^>]*src(=| )(.[^>]*)>"
Content=re.replace(Content,"<img src=$2 style=""cursor: pointer"" onmousewheel=""return bbimg(this)"" onload=""javascript:resizepic(this)"" onclick=""javascript:window.open(this.src);"" border=""0""/>")
set re = nothing
FormatImg = content
End Function
Function ACT_A_List(ClassID,ActF,ATT,ArticleSort,OpenTypeStr,ListNumber,RowHeight,TitleLen,ColNumber,TypeClassName,TypeNew,ACTIF,NavType,Nav,MoreLinkType,MoreLink,Division,DateForm,DateAlign,TitleCss,DateCss,divID,divclass,ulID,ulclass,liID,liclass,ModeID)
Dim SqlStr, Parameter,OpenType,MoreLinkStr,ACT_IF,ACTCMS_ATT
Select Case ClassID
Case "","0":Parameter=""
Case "1":Parameter="ClassID='" & Application(AcTCMSN & "ClassID") & "' And"
Case Else
If InStr(ClassID, ",") > 0 Then
Parameter="ClassID In (" & ClassID & ") And"
Else
Parameter="ClassID='" & Replace(ClassID,"'","") & "' And"
End If
End Select
'OpenType = Gopen(OpenTypeStr)
If ACTIF<>"" Then ACT_IF = " And "&ACTIF
If ATT="0" Then ACTCMS_ATT="" Else ACTCMS_ATT = " And ATT="&ATT
If MoreLink <> "" And InStr(ClassID, ",") = 0 And ClassID <> "0" Then MoreLinkStr=MLink(ColNumber,RowHeight,MoreLinkType, MoreLink, AcTCMS.MoreName(ClassID),OpenTypeStr)
If Lcase(Left(Trim(ArticleSort),2))<>"ID" Then ArticleSort=ArticleSort & ",ID Desc"
Sqlstr="Select TOP " & ListNumber & " ID,ClassID,Title,UpdateTime,ChangesLink,FileName,GroupID_ACT,Score_ACT From "&ACTCMS.ACT_C(ModeID,2)&" Where " & Parameter & " isAccept=0 AND delif=0 " & ACTCMS_ATT &ACT_IF& " ORDER BY IsTop Desc," & ArticleSort
ACT_A_List = ACTCMS_A_SQL(SqlStr,OpenTypeStr,RowHeight,TitleLen,ColNumber,TypeClassname,TypeNew,NavType,Nav,MoreLinkStr,Division,DateForm,DateAlign,TitleCss,DateCss,ACTF,DivID,DivClass,UlID,UlClass,LiID,LiClass,ModeID)
End Function
Function ACTCMS_A_SQL(SqlStr,OpenType,RowHeight,TitleLen,ColNumber,TypeClassname,TypeNew,NavType,Nav,MoreLinkStr,Division,DateForm,DateAlign,TitleCss,DateCss,ACTF,DivID,DivClass,UlID,UlClass,LiID,LiClass,ModeID)
on error resume next
Dim RS,I,K,N,DateStr,TitleCssName,ColSpanNum,TypeNews,TempTitle,NaviStr,DateCssStr,ACTSQL
Set RS=ACTCMS.ActExe(SqlStr)
If RS.EOF Then ACTCMS_A_SQL="<li>暂无内容</li>":RS.Close:Set RS=Nothing:Exit Function
ACTSQL=RS.GetRows(-1):Set RS = Nothing
Dim ActNum:ActNum=Ubound(ACTSQL,2)
Dim Title,ClassnameLink
TitleCssName = GCss(TitleCss):DateCssStr = GCss(DateCss):RowHeight = GRowHeight(RowHeight):NaviStr = GNavi(NavType,Nav)
If ActF=2 Then
If DivID<>"0" Then ACTCMS_A_SQL = "<div"&GCssID(DivID)&GCss(DivClass) &">" & vbCrLf
If UlID <>"0" Then ACTCMS_A_SQL=ACTCMS_A_SQL& " <ul"&GCssID(UlID)&GCss(UlClass) &">" & vbCrLf
For K=0 To ActNum
If CBool(TypeClassname) = True Then ClassnameLink = "<span>[" & AcTCMS.GainClassName(ACTSQL(1,N),OpenType,TitleCssName) & "]</span>"
If Cbool(TypeNew)=True And (Year(ACTSQL(3,N))&Month(ACTSQL(3,N))&Day(ACTSQL(3,N)) =Year(Now)&Month(Now)&Day(Now)) Then TypeNews="<img src=""" & Domain&"ACT_inc/share/new.gif"" border=""0""/>" Else TypeNews=""
DateStr=GDDateStr(ACTSQL(3,N),DateForm,DateCssStr)
TempTitle = "<a " & TitleCssName & " href=""" &AcTCMS.GetInfoUrl(ModeID,ACTSQL(1,N),ACTSQL(0,N),ACTSQL(4,N),ACTSQL(5,N),ACTSQL(6,N),ACTSQL(7,N)) & """" & Gopen(OpenType) & " title=""" & AcTCMS.CloseHtml(ACTSQL(2,N)) & """>" &ACTCMS.GetStrValue(ACTSQL(2,N),TitleLen) & "</a>"
ACTCMS_A_SQL = ACTCMS_A_SQL & (" <li"&GCssID(LIID)&GCss(LiClass)&">" &NaviStr&ClassnameLink&TempTitle&TypeNews&DateStr & "</li>" & vbCrLf)
N=N+1
Next
ACTCMS_A_SQL = MoreLinkStr& vbCrLf&ACTCMS_A_SQL
If UlID<>"0" Then ACTCMS_A_SQL =ACTCMS_A_SQL&"</ul>" & vbCrLf
If DivID<>"0" Then ACTCMS_A_SQL =ACTCMS_A_SQL&"</div>"
Else
ACTCMS_A_SQL = "<table border=""0"" cellpadding=""0"" cellspacing=""0"" wIDth=""100%"">" & vbCrLf
For K=0 To ActNum
ACTCMS_A_SQL = ACTCMS_A_SQL & "<tr>" & vbCrLf
For I = 1 To ColNumber
If CBool(TypeClassname) = True Then ClassnameLink = "[" & AcTCMS.GainClassName(ACTSQL(1,N),OpenType,TitleCssName) & "]"
If Cbool(TypeNew)=True And (Year(ACTSQL(3,N))&Month(ACTSQL(3,N))&Day(ACTSQL(3,N)) =Year(Now)&Month(Now)&Day(Now)) Then TypeNews="<img src=""" & Domain&"ACT_inc/share/new.gif"" border=""0""/>" Else TypeNews=""
DateStr=GDateStr(ACTSQL(3,N),DateForm,DateAlign,DateCssStr,ColNumber,ColSpanNum)
TempTitle = "<a " & TitleCssName & " href=""" &AcTCMS.GetInfoUrl(ModeID,ACTSQL(1,N),ACTSQL(0,N),ACTSQL(4,N),ACTSQL(5,N),ACTSQL(6,N),ACTSQL(7,N)) & """" & Gopen(OpenType) & " title=""" & AcTCMS.CloseHtml(ACTSQL(2,N)) & """>" &ACTCMS.GetStrValue(ACTSQL(2,N),TitleLen) & "</a>"
If ColNumber=1 Then
ACTCMS_A_SQL = ACTCMS_A_SQL & (" <td height=""" & RowHeight & """>" &NaviStr&ClassnameLink&TempTitle&TypeNews&DateStr& "</td>" & vbCrLf)
Else
ACTCMS_A_SQL = ACTCMS_A_SQL & (" <td wIDth=""" & CInt(100 / CInt(ColNumber)) & "%"" height=""" &RowHeight& """>" & vbCrLf)
ACTCMS_A_SQL = ACTCMS_A_SQL & (" <table wIDth=""90%"" height=""100%"" cellpadding=""0"" cellspacing=""0"" border=""0"">" & vbCrLf)
ACTCMS_A_SQL = ACTCMS_A_SQL & (" <tr><td> " &NaviStr&ClassnameLink&TempTitle&TypeNews &DateStr )
ACTCMS_A_SQL = ACTCMS_A_SQL & (" </td></tr>" & vbcrlf &" </table>" & vbCrLf & " </td>" & vbCrLf)
End if
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -