powereasy.article.asp

个人网站比较简短

<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Dim ArticleID, ArticleTitle, ArticleUrl
Dim rsArticle

Class Article

Private ArticlePro1, ArticlePro2, ArticlePro3, ArticlePro4
Private rsClass
Private strTempContent, strContentPageTitleArr
Public totalPage

'初始化需要用到的一些变量
Public Sub Init()
    FoundErr = False
    ErrMsg = ""
    PrevChannelID = ChannelID
    ChannelShortName = "文章"
        
    If XmlDoc.Load(Server.MapPath(InstallDir & "Language/Gb2312_Channel_" & ChannelID & ".xml")) = False Then XmlDoc.Load (Server.MapPath(InstallDir & "Language/Gb2312.xml"))
     
    '*****************************
    '读取语言包中的字符设置
    strListStr_Font = XmlText_Class("ArticleList/UpdateTimeColor_New", "color=""red""")
    strTop = XmlText_Class("ArticleList/t4", "固顶")
    strElite = XmlText_Class("ArticleList/t3", "推荐")
    strCommon = XmlText_Class("ArticleList/t5", "普通")
    strHot = XmlText_Class("ArticleList/t7", "热点")
    strNew = XmlText_Class("ArticleList/t6", "最新")
    strTop2 = XmlText_Class("ArticleList/Top", " 顶")
    strElite2 = XmlText_Class("ArticleList/Elite", " 荐")
    strHot2 = XmlText_Class("ArticleList/Hot", " 热")
    ArticlePro1 = XmlText_Class("ArticlePro1", "[图文]")
    ArticlePro2 = XmlText_Class("ArticlePro2", "[组图]")
    ArticlePro3 = XmlText_Class("ArticlePro3", "[推荐]")
    ArticlePro4 = XmlText_Class("ArticlePro4", "[注意]")
    Character_Author = XmlText("Article", "Include/Author", "[{$Text}]")
    Character_Date = XmlText("Article", "Include/Date", "[{$Text}]")
    Character_Hits = XmlText("Article", "Include/Hits", "[{$Text}]")
    Character_Class = XmlText("Article", "Include/ClassChar", "[{$Text}]")
    SearchResult_Content_NoPurview = XmlText("BaseText", "SearchPurviewContent", "此内容需要有指定权限才可以预览")
    SearchResult_ContentLenth = PE_CLng(XmlText_Class("ShowSearch/Content_Lenght", "200"))
    strList_Content_Div = XmlText_Class("ArticleList/Content_DIV", "style=""padding:0px 20px""")
    strList_Title = R_XmlText_Class("ArticleList/Title", "{$ChannelShortName}标题：{$Title}{$br}作&nbsp;&nbsp;&nbsp;&nbsp;者：{$Author}{$br}更新时间：{$UpdateTime}")
    strComment = XmlText_Class("ArticleList/CommentLink", "<font color=""red"">评论</font>")
    '*****************************

    strPageTitle = SiteTitle

    Call GetChannel(ChannelID)
    HtmlDir = InstallDir & ChannelDir
    If Trim(ChannelName) <> "" And ShowNameOnPath <> False Then
        strNavPath = strNavPath & "&nbsp;" & strNavLink & "&nbsp;<a class='LinkPath' href='"
        If UseCreateHTML > 0 Then
            strNavPath = strNavPath & ChannelUrl & "/Index" & FileExt_Index
        Else
            strNavPath = strNavPath & ChannelUrl_ASPFile & "/Index.asp"
        End If
        strNavPath = strNavPath & "'>" & ChannelName & "</a>"
        strPageTitle = strPageTitle & " >> " & ChannelName
    End If
End Sub

'=================================================
'函数名：ShowChannelCount
'作  用：显示频道统计信息
'参  数：无
'=================================================
Private Function GetChannelCount()
    GetChannelCount = Replace(Replace(Replace(Replace(Replace(Replace(R_XmlText_Class("ChannelCount", "{$ChannelShortName}总数： {$ItemChecked_Channel} {$ChannelItemUnit}<br>待审{$ChannelShortName}： {$UnItemChecked} {$ChannelItemUnit}<br>评论总数： {$CommentCount_Channel} 条<br>专题总数： {$SpecialCount_Channel} 个<br>{$ChannelShortName}阅读： {$HitsCount_Channel} 人次<br>"), "{$ItemChecked_Channel}", ItemChecked_Channel), "{$ChannelItemUnit}", ChannelItemUnit), "{$UnItemChecked}", treatAuditing("Article", ChannelID)), "{$CommentCount_Channel}", CommentCount_Channel), "{$SpecialCount_Channel}", SpecialCount_Channel), "{$HitsCount_Channel}", "<script language='javascript' src='" & ChannelUrl_ASPFile & "/GetHits.asp?Action=Count'></script>")
End Function
'**************************************************
'函数名：treatAuditing
'作  用：待审核函数
'参  数：ModuleName ----表名
'        ChannelID ---- 频道ID
'返回值：待审核项目数
'**************************************************
Private Function treatAuditing(ByVal ModuleName, ByVal ChannelID)
    Dim trs
    Set trs = Conn.Execute("select Count(" & ModuleName & "ID) from PE_" & ModuleName & " where ChannelID=" & ChannelID & " and Status > -1 and Status < 3 and Deleted=" & PE_False & "")
    treatAuditing = trs(0)
    If IsNull(treatAuditing) Then treatAuditing = 0
    Set trs = Nothing
End Function

Private Function GetSqlStr(iChannelID, arrClassID, IncludeChild, iSpecialID, IsHot, IsElite, Author, DateNum, OrderType, ShowClassName, IsPicUrl)
    Dim strSql, IDOrder
    iSpecialID = PE_CLng(iSpecialID)
    If iSpecialID > 0 Then
        strSql = strSql & " from PE_InfoS I inner join (PE_Article A left join PE_Class C on A.ClassID=C.ClassID) on I.ItemID=A.ArticleID"
    Else
        strSql = strSql & " from PE_Article A left join PE_Class C on A.ClassID=C.ClassID"
    End If
    strSql = strSql & " where A.Deleted=" & PE_False & " and A.Status=3 and A.ReceiveType=0"
    If iChannelID > 0 Then
        strSql = strSql & " and A.ChannelID=" & iChannelID
    End If
    If arrClassID <> "0" Then
        If InStr(arrClassID, ",") = 0 And IncludeChild = True Then
            Dim trs
            Set trs = Conn.Execute("select arrChildID from PE_Class where ClassID=" & PE_CLng(arrClassID) & "")
            If trs.BOF And trs.EOF Then
                arrClassID = "0"
            Else
                If IsNull(trs(0)) Or Trim(trs(0)) = "" Then
                    arrClassID = "0"
                Else
                    arrClassID = trs(0)
                End If
            End If
            Set trs = Nothing
        End If
        
        If InStr(arrClassID, ",") > 0 Then
            strSql = strSql & " and A.ClassID in (" & FilterArrNull(arrClassID, ",") & ")"
        Else
            If PE_CLng(arrClassID) > 0 Then strSql = strSql & " and A.ClassID=" & PE_CLng(arrClassID)
        End If
    End If
    If iSpecialID > 0 Then
        strSql = strSql & " and I.ModuleType=1 and I.SpecialID=" & iSpecialID
    End If
    If IsHot = True Then
        strSql = strSql & " and A.Hits>=" & HitsOfHot
    End If
    If IsElite = True Then
        strSql = strSql & " and A.Elite=" & PE_True
    End If
    If Trim(Author) <> "" Then
        strSql = strSql & " and A.Author='" & Author & "'"
    End If
    If DateNum > 0 Then
        strSql = strSql & " and DateDiff(" & PE_DatePart_D & ",A.UpdateTime," & PE_Now & ")<" & DateNum
    End If

    If IsPicUrl = True Then
        strSql = strSql & " and A.DefaultPicUrl<>'' "
    End If

    strSql = strSql & " order by A.OnTop " & PE_OrderType & ","
    Select Case PE_CLng(OrderType)
    Case 1, 2
    
    Case 3
        strSql = strSql & "A.UpdateTime desc,"
    Case 4
        strSql = strSql & "A.UpdateTime asc,"
    Case 5
        strSql = strSql & "A.Hits desc,"
    Case 6
        strSql = strSql & "A.Hits asc,"
    Case 7
        strSql = strSql & "A.CommentCount desc,"
    Case 8
        strSql = strSql & "A.CommentCount asc,"
    Case Else

    End Select
    If OrderType = 2 Then
        IDOrder = "asc"
    Else
        IDOrder = "desc"
    End If
    If iSpecialID > 0 Then
        strSql = strSql & "I.InfoID " & IDOrder
    Else
        strSql = strSql & "A.ArticleID " & IDOrder
    End If
    GetSqlStr = strSql
End Function

'=================================================
'函数名：GetArticleList
'作  用：显示文章标题等信息
'参  数：
'0        iChannelID ---- 频道ID
'1        arrClassID ---- 栏目ID数组，0为所有栏目
'2        IncludeChild ---- 是否包含子栏目，仅当arrClassID为单个栏目ID时才有效，True----包含子栏目，False----不包含
'3        iSpecialID ---- 专题ID，0为所有文章（含非专题文章），如果为大于0，则只显示相应专题的文章
'4        UrlType ---- 链接地址类型，0为相对路径，1为带网址的绝对路径，不对外公开，4.03时为ShowAllArticle
'5        ArticleNum ---- 文章数，若大于0，则只查询前几篇文章
'6        IsHot ---- 是否是热门文章，True为只显示热门文章，False为显示所有文章
'7        IsElite ---- 是否是推荐文章，True为只显示推荐文章，False为显示所有文章
'8        Author ---- 作者姓名，如果不为空，则只显示指定作者的文章，用于作者文集
'9        DateNum ---- 日期范围，如果大于0，则只显示最近几天内更新的文章
'10       OrderType ---- 排序方式，1--按文章ID降序，2--按文章ID升序，3--按更新时间降序，4--按更新时间升序，5--按点击数降序，6--按点击数升序，7--按评论数降序，8--按评论数升序
'11       ShowType ---- 显示方式，1为普通样式，2为表格式，3为各项独立式，4为智能多列式，5为输出DIV，6为输出RSS
'12       TitleLen ---- 标题最多字符数，一个汉字=两个英文字符，若为0，则显示完整标题
'13       ContentLen ---- 文章内容最多字符数，一个汉字=两个英文字符，为0时不显示。请文章数量较多，可能会导致溢出错误。
'14       ShowClassName ---- 是否显示所属栏目名称，True为显示，False为不显示
'15       ShowPropertyType ---- 显示文章属性（固顶/推荐/普通）的方式，0为不显示，1为小图片，2为符号，3--9为小图片，10为序号
'16       ShowIncludePic ---- 是否显示“[图文]”字样，True为显示，False为不显示
'17       ShowAuthor ---- 是否显示文章作者，True为显示，False为不显示
'18       ShowDateType ---- 显示更新日期的样式，0为不显示，1为显示年月日，2为只显示月日，3为以“月-日”方式显示月日。
'19       ShowHits ---- 是否显示文章点击数，True为显示，False为不显示
'20       ShowHotSign ---- 是否显示热门文章标志，True为显示，False为不显示
'21       ShowNewSign ---- 是否显示新文章标志，True为显示，False为不显示
'22       ShowTips ---- 是否显示作者、更新日期、点击数等浮动提示信息，True为显示，False为不显示
'23       ShowCommentLink ---- 是否显示评论链接，True为显示，False为不显示，此选项只有当相应文章在后台设置了“显示评论链接”才有效。
'24       UsePage ---- 是否分页显示，True为分页显示，False为不分页显示，每页显示的文章数量由MaxPerPage指定
'25       OpenType ---- 文章打开方式，0为在原窗口打开，1为在新窗口打开
'26       Cols ---- 每行的列数。超过此列数就换行。
'27       CssNameA ---- 列表中文字链接调用的CSS类名
'28       CssName1 ---- 列表中奇数行的CSS效果的类名
'29       CssName2 ---- 列表中偶数行的CSS效果的类名
'=================================================
Public Function GetArticleList(iChannelID, arrClassID, IncludeChild, iSpecialID, UrlType, ArticleNum, IsHot, IsElite, Author, DateNum, OrderType, ShowType, TitleLen, ContentLen, ShowClassName, ShowPropertyType, ShowIncludePic, ShowAuthor, ShowDateType, ShowHits, ShowHotSign, ShowNewSign, ShowTips, ShowCommentLink, UsePage, OpenType, Cols, CssNameA, CssName1, CssName2)
    Dim sqlInfo, rsInfoList, strInfoList, CssName, iCount, iNumber, InfoUrl
    Dim strProperty, strTitle, strLink, strAuthor, strUpdateTime, strHits, strHotSign, strNewSign, strContent, strClassName
    Dim iTitleLen, strCommentLink
    Dim TDWidth_Author, TdWidth_Date

    TDWidth_Author = 10 * AuthorInfoLen
    TdWidth_Date = GetTdWidth_Date(ShowDateType)

    iCount = 0
    UrlType = PE_CLng(UrlType)
    Cols = PE_CLng1(Cols)

    If ShowType = 6 Then UrlType = 1
    If TitleLen < 0 Or TitleLen > 200 Then TitleLen = 50
    If IsNull(CssNameA) Then CssNameA = "listA"
    If IsNull(CssName1) Then CssName1 = "listbg"
    If IsNull(CssName2) Then CssName2 = "listbg2"

    FoundErr = False
    If iChannelID <> PrevChannelID Or ChannelID = 0 Then
        Call GetChannel(iChannelID)
    End If
    PrevChannelID = iChannelID
    If FoundErr = True Then
        GetArticleList = ErrMsg
        Exit Function
    End If

    sqlInfo = "select"
    If ArticleNum > 0 Then
        If ShowType = 4 Then
            sqlInfo = sqlInfo & " top " & ArticleNum * 4
        Else
            sqlInfo = sqlInfo & " top " & ArticleNum
        End If
    End If
    sqlInfo = sqlInfo & " A.ChannelID,A.ClassID,A.ArticleID,A.Title,A.TitleFontColor,A.TitleFontType,A.ShowCommentLink,A.IncludePic,A.Author,A.UpdateTime,A.Hits,A.OnTop,A.Elite,A.InfoPurview,A.InfoPoint"
    If ContentLen > 0 Then
        sqlInfo = sqlInfo & ",A.Intro,A.Content"
    End If
    sqlInfo = sqlInfo & ",C.ClassName,C.ParentDir,C.ClassDir,C.ClassPurview"
    sqlInfo = sqlInfo & GetSqlStr(iChannelID, arrClassID, IncludeChild, iSpecialID, IsHot, IsElite, Author, DateNum, OrderType, ShowClassName, False)