Private Function GetListFromLabel(ByVal strSource) Dim arrTemp Dim tChannelID, ArticleNum, arrClassID, tSpecialID, AuthorName, OrderType, OpenType If strSource = "" Then GetListFromLabel = "" Exit Function End If strSource = Replace(strSource, Chr(34), "") strSource = FillInArrStr(strSource, "1,listA,listbg,listbg2", 30) arrTemp = Split(strSource, ",") If UBound(arrTemp) + 1 < 30 Then GetListFromLabel = "函数式标签:{$GetArticleList(参数列表)}的参数个数不对。请检查模板中的此标签。" Exit Function End If Select Case Trim(arrTemp(0)) Case "ChannelID" tChannelID = ChannelID Case Else tChannelID = arrTemp(0) End Select Select Case Trim(arrTemp(1)) Case "rsClass_arrChildID" If IsObject(rsClass) Then arrClassID = rsClass("arrChildID") Else arrClassID = arrChildID End If Case "arrChildID" arrClassID = arrChildID Case "ClassID" arrClassID = ClassID Case Else arrClassID = arrTemp(1) End Select arrClassID = Replace(Trim(arrClassID), "|", ",") tChannelID = Replace(Trim(tChannelID), "|", ",") Select Case Trim(arrTemp(3)) Case "SpecialID" tSpecialID = SpecialID Case Else tSpecialID = PE_CLng(arrTemp(3)) End Select Select Case Trim(arrTemp(5)) Case "rsClass_TopNumber" ArticleNum = 8 Case "TopNumber" ArticleNum = 8 Case Else ArticleNum = PE_CLng(arrTemp(5)) End Select AuthorName = Replace(Replace(Trim(arrTemp(8)), "?", ""), """, "") Select Case Trim(arrTemp(10)) Case "rsClass_ItemListOrderType" OrderType = rsClass("ItemListOrderType") Case "ItemListOrderType" OrderType = ItemListOrderType Case Else OrderType = PE_CLng(arrTemp(10)) End Select Select Case Trim(arrTemp(25)) Case "rsClass_ItemOpenType" OpenType = rsClass("ItemOpenType") Case "ItemOpenType" OpenType = ItemOpenType Case Else OpenType = PE_CLng(arrTemp(25)) End Select GetListFromLabel = GetArticleList(tChannelID, arrClassID, PE_CBool(arrTemp(2)), tSpecialID, PE_CLng(arrTemp(4)), ArticleNum, PE_CBool(arrTemp(6)), PE_CBool(arrTemp(7)), AuthorName, PE_CLng(arrTemp(9)), OrderType, PE_CLng(arrTemp(11)), PE_CLng(arrTemp(12)), PE_CLng(arrTemp(13)), PE_CBool(arrTemp(14)), PE_CLng(arrTemp(15)), PE_CBool(arrTemp(16)), PE_CBool(arrTemp(17)), PE_CLng(arrTemp(18)), PE_CBool(arrTemp(19)), PE_CBool(arrTemp(20)), PE_CBool(arrTemp(21)), PE_CBool(arrTemp(22)), PE_CBool(arrTemp(23)), PE_CBool(arrTemp(24)), OpenType, PE_CLng(arrTemp(26)), Trim(arrTemp(27)), Trim(arrTemp(28)), Trim(arrTemp(29))) End Function Private Function GetCustomFromLabel(strTemp, strList) Dim arrTemp Dim strArticlePic, strPicTemp, arrPicTemp Dim iChannelID, arrClassID, IncludeChild, iSpecialID, ItemNum, IsHot, IsElite, Author, DateNum, OrderType, UsePage, TitleLen, ContentLen Dim iCols, iColsHtml, iRows, iRowsHtml, iNumber Dim IncludePic If strTemp = "" Or strList = "" Then GetCustomFromLabel = "": Exit Function iCols = 1: iRows = 1: iColsHtml = "": iRowsHtml = "" regEx.Pattern = "【(Cols|Rows)=(/d{1,2})/s*(?:/|||)(.+?)】" Set Matches = regEx.Execute(strList) For Each Match In Matches If LCase(Match.SubMatches(0)) = "cols" Then If Match.SubMatches(1) > 1 Then iCols = Match.SubMatches(1) iColsHtml = Match.SubMatches(2) ElseIf LCase(Match.SubMatches(0)) = "rows" Then If Match.SubMatches(1) > 1 Then iRows = Match.SubMatches(1) iRowsHtml = Match.SubMatches(2) End If strList = regEx.Replace(strList, "") Next arrTemp = Split(strTemp, ",") If UBound(arrTemp) <> 13 and UBound(arrTemp) <> 12 Then GetCustomFromLabel = "自定义列表标签:【ArticleList(参数列表)】列表内容【/ArticleList】的参数个数不对。请检查模板中的此标签。" Exit Function End If Select Case Trim(arrTemp(0)) Case "ChannelID" iChannelID = ChannelID Case Else iChannelID = arrTemp(0) End Select Select Case Trim(arrTemp(1)) Case "rsClass_arrChildID" If IsObject(rsClass) Then arrClassID = rsClass("arrChildID") Else arrClassID = arrChildID End If Case "arrChildID" arrClassID = arrChildID Case "ClassID" arrClassID = ClassID Case Else arrClassID = arrTemp(1) End Select arrClassID = Replace(Trim(arrClassID), "|", ",") iChannelID = Replace(Trim(iChannelID), "|", ",") IncludeChild = PE_CBool(arrTemp(2)) Select Case Trim(arrTemp(3)) Case "SpecialID" iSpecialID = SpecialID Case Else iSpecialID = PE_CLng(arrTemp(3)) End Select ItemNum = PE_CLng(arrTemp(4)) IsHot = PE_CBool(arrTemp(5)) IsElite = PE_CBool(arrTemp(6)) Author = Replace(Replace(Replace(Trim(arrTemp(7)), "?", ""), """, ""), Chr(34), "") DateNum = PE_CLng(arrTemp(8)) Select Case Trim(arrTemp(9)) Case "rsClass_ItemListOrderType" OrderType = rsClass("ItemListOrderType") Case "ItemListOrderType" OrderType = ItemListOrderType Case Else OrderType = PE_CLng(arrTemp(9)) End Select UsePage = PE_CBool(arrTemp(10)) TitleLen = PE_CLng(arrTemp(11)) ContentLen = PE_CLng(arrTemp(12)) If UBound(arrTemp) = 13 then IncludePic = PE_CBool(arrTemp(13)) Else IncludePic = False End If FoundErr = False If (PE_Clng(iChannelID) <> 0 and Instr(iChannelID,",")=0) and (PE_Clng(iChannelID)<>PrevChannelID Or ChannelID = 0) Then Call GetChannel(PE_Clng(iChannelID)) PrevChannelID = iChannelID End If If FoundErr = True Then GetCustomFromLabel = ErrMsg Exit Function End If Dim rsField, ArrField, iField Set rsField = Conn.Execute("select FieldName,LabelName from PE_Field where ChannelID=-1 or ChannelID=" & ChannelID & "") If Not (rsField.BOF And rsField.EOF) Then ArrField = rsField.getrows(-1) End If Set rsField = Nothing Dim sqlCustom, rsCustom, iCount, strCustomList, strThisClass, strLink iCount = 0 sqlCustom = "" strThisClass = "" strCustomList = "" sqlCustom = "select " If ItemNum > 0 Then sqlCustom = sqlCustom & "top " & ItemNum & " " End If If ContentLen > 0 Then sqlCustom = sqlCustom & "A.Content," End If If IsArray(ArrField) Then For iField = 0 To UBound(ArrField, 2) sqlCustom = sqlCustom & "A." & ArrField(0, iField) & "," Next End If sqlCustom = sqlCustom & "A.ArticleID,A.ChannelID,A.ClassID,A.Title,A.Subheading,A.Keyword,A.Intro,A.DefaultPicUrl" sqlCustom = sqlCustom & ",A.Author,A.CopyFrom,A.Inputer,A.Editor,A.UpdateTime,A.Stars,A.Hits,A.OnTop,A.Elite,A.InfoPoint,A.InfoPurview" sqlCustom = sqlCustom & ",C.ClassName,C.ParentDir,C.ClassDir,C.Readme,C.ClassPurview" sqlCustom = sqlCustom & GetSqlStr(iChannelID, arrClassID, IncludeChild, iSpecialID, IsHot, IsElite, Author, DateNum, OrderType, False, IncludePic) Set rsCustom = Server.CreateObject("ADODB.Recordset") rsCustom.Open sqlCustom, Conn, 1, 1 If rsCustom.BOF And rsCustom.EOF Then totalPut = 0 strCustomList = GetInfoList_StrNoItem(arrClassID, iSpecialID, IsHot, IsElite, strHot, strElite) rsCustom.Close Set rsCustom = Nothing GetCustomFromLabel = strCustomList Exit Function End If If UsePage = True Then totalPut = rsCustom.RecordCount If CurrentPage < 1 Then CurrentPage = 1 End If If (CurrentPage - 1) * MaxPerPage > totalPut Then If (totalPut Mod MaxPerPage) = 0 Then CurrentPage = totalPut / MaxPerPage Else CurrentPage = totalPut / MaxPerPage + 1 End If End If If CurrentPage > 1 Then If (CurrentPage - 1) * MaxPerPage < totalPut Then iMod = 0 If CurrentPage > UpdatePages Then iMod = totalPut Mod MaxPerPage If iMod <> 0 Then iMod = MaxPerPage - iMod End If rsCustom.Move (CurrentPage - 1) * MaxPerPage - iMod Else CurrentPage = 1 End If End If End If PrevChannelID = 0 Do While Not rsCustom.EOF 'If iChannelID = 0 Then If rsCustom("ChannelID") <> PrevChannelID Then Call GetChannel(rsCustom("ChannelID")) PrevChannelID = rsCustom("ChannelID") End If ' End If strTemp = strList If UsePage = True Then iNumber = (CurrentPage - 1) * MaxPerPage + iCount + 1 Else iNumber = iCount + 1 End If strTemp = PE_Replace(strTemp, "{$Number}", iNumber) strTemp = PE_Replace(strTemp, "{$ClassID}", rsCustom("ClassID")) strTemp = PE_Replace(strTemp, "{$ClassName}", rsCustom("ClassName")) strTemp = PE_Replace(strTemp, "{$ParentDir}", rsCustom("ParentDir")) strTemp = PE_Replace(strTemp, "{$ClassDir}", rsCustom("ClassDir")) strTemp = PE_Replace(strTemp, "{$Readme}", rsCustom("ReadMe")) If InStr(strTemp, "{$ClassUrl}") > 0 Then strTemp = PE_Replace(strTemp, "{$ClassUrl}", GetClassUrl(rsCustom("ParentDir"), rsCustom("ClassDir"), rsCustom("ClassID"), rsCustom("ClassPurview"))) strTemp = PE_Replace(strTemp, "{$ArticleID}", rsCustom("ArticleID")) If InStr(strTemp, "{$ArticleUrl}") > 0 Then strTemp = PE_Replace(strTemp, "{$ArticleUrl}", GetArticleUrl(rsCustom("ParentDir"), rsCustom("ClassDir"), rsCustom("UpdateTime"), rsCustom("ArticleID"), rsCustom("ClassPurview"), rsCustom("InfoPurview"), rsCustom("InfoPoint"))) If InStr(strTemp, "{$UpdateDate}") > 0 Then strTemp = PE_Replace(strTemp, "{$UpdateDate}", FormatDateTime(rsCustom("UpdateTime"), 2)) strTemp = PE_Replace(strTemp, "{$UpdateTime}", rsCustom("UpdateTime")) strTemp = PE_Replace(strTemp, "{$Stars}", GetStars(rsCustom("Stars"))) strTemp = PE_Replace(strTemp, "{$Author}", rsCustom("Author")) strTemp = PE_Replace(strTemp, "{$CopyFrom}", rsCustom("CopyFrom")) strTemp = PE_Replace(strTemp, "{$Hits}", rsCustom("Hits")) strTemp = PE_Replace(strTemp, "{$Inputer}", rsCustom("Inputer")) strTemp = PE_Replace(strTemp, "{$Editor}", rsCustom("Editor")) If InStr(strTemp, "{$InfoPoint}") > 0 Then strTemp = PE_Replace(strTemp, "{$InfoPoint}", GetInfoPoint(rsCustom("InfoPoint"))) If InStr(strTemp, "{$ReadPoint}") > 0 Then strTemp = PE_Replace(strTemp, "{$ReadPoint}", GetInfoPoint(rsCustom("InfoPoint"))) If InStr(strTemp, "{$Keyword}") > 0 Then strTemp = PE_Replace(strTemp, "{$Keyword}", GetKeywords(",", rsCustom("Keyword"))) If rsCustom("OnTop") = True Then strTemp = PE_Replace(strTemp, "{$Property}", "OnTop") ElseIf rsCustom("Elite") = True Then strTemp = PE_Replace(strTemp, "{$Property}", "Elite") ElseIf rsCustom("Hits") > HitsOfHot Then strTemp = PE_Replace(strTemp, "{$Property}", "Hot") Else strTemp = PE_Replace(strTemp, "{$Property}", "Common") End If If rsCustom("OnTop") = True Then strTemp = PE_Replace(strTemp, "{$Top}", strTop2) Else strTemp = PE_Replace(strTemp, "{$Top}", "") End If If rsCustom("Elite") = True Then strTemp = PE_Replace(strTemp, "{$Elite}", strElite2) Else strTemp = PE_Replace(strTemp, "{$Elite}", "") End If If rsCustom("Hits") > HitsOfHot Then strTemp = PE_Replace(strTemp, "{$Hot}", strHot2) Else strTemp = PE_Replace(strTemp, "{$Hot}", "") End If If TitleLen > 0 Then strTemp = PE_Replace(strTemp, "{$Title}", GetSubStr(rsCustom("Title"), TitleLen, ShowSuspensionPoints)) Else strTemp = PE_Replace(strTemp, "{$Title}", rsCustom("Title")) End If strTemp = PE_Replace(strTemp, "{$TitleOriginal}", rsCustom("Title")) If ContentLen > 0 Then If InStr(strTemp, "{$Content}") > 0 Then strTemp = PE_Replace(strTemp, "{$Content}", Left(nohtml(rsCustom("Content")), ContentLen)) Else strTemp = PE_Replace(strTemp, "{$Content}", "") End If strTemp = PE_Replace(strTemp, "{$Subheading}", rsCustom("Subheading")) strTemp = PE_Replace(strTemp, "{$Intro}", rsCustom("Intro")) '替换首页图片 regEx.Pattern = "/{/$ArticlePic/((.*?)/)/}" Set Matches = regEx.Execute(strTemp) For Each Match In Matches arrPicTemp = Split(Match.SubMatches(0), ",") strArticlePic = GetDefaultPicUrl(Trim(rsCustom("DefaultPicUrl")), PE_CLng(arrPicTemp(0)), PE_CLng(arrPicTemp(1))) strTemp = Replace(strTemp, Match.Value, strArticlePic) Next If IsArray(ArrField) Then For iField = 0 To UBound(ArrField, 2) strTemp = PE_Replace(strTemp, ArrField(1, iField), PE_HTMLEncode(rsCustom(Trim(ArrField(0, iField))))) Next End If strCustomList = strCustomList & strTemp rsCustom.MoveNext iCount = iCount + 1 If iCols > 1 And iCount Mod iCols = 0 Then strCustomList = strCustomList & iColsHtml If iRows > 1 And iCount Mod iCols * iRows = 0 Then strCustomList = strCustomList & iRowsHtml If UsePage = True And iCount >= MaxPerPage Then Exit Do Loop rsCustom.Close Set rsCustom = Nothing GetCustomFromLabel = strCustomList End Function