powereasy.article.asp

个人网站比较简短

                    CurrentTitleLen = iTitleLen
                    If ShowCommentLink = True And rsInfoList("ShowCommentLink") = True Then
                        CurrentTitleLen = CurrentTitleLen + 1 + Charlong(nohtml(strComment))
                    End If
             
                    strInfoList = strInfoList & "</td></tr><tr>"
                    iCount = iCount + 1
                    If iCount Mod 2 = 0 Then
                        CssName = CssName1
                    Else
                        CssName = CssName2
                    End If
                    strInfoList = strInfoList & "<td valign='top' class='" & CssName & "'>" & strProperty & strLink
                    rownum = rownum + 1
                    If rownum > ArticleNum Then
                        If CurrentTitleLen >= TitleLen Then
                            strInfoList = strInfoList & "</td></tr>"
                            Exit Do
                        Else
                            outend = True
                        End If
                    End If
                Else
                    If CurrentTitleLen > TitleLen + 1 Then
                        strInfoList = strInfoList & "</td></tr>"
                        Exit Do
                    Else
                        strInfoList = strInfoList & "&nbsp;" & strLink
                        CurrentTitleLen = CurrentTitleLen + 1
                    End If
                End If
            End If
        End Select
        rsInfoList.MoveNext
        If UsePage = True And iCount >= MaxPerPage Then Exit Do
    Loop
    If ShowType = 2 Or Cols > 1 Then
        strInfoList = strInfoList & "</tr></table>"
    ElseIf ShowType = 4 Then
        strInfoList = strInfoList & "</table>"
    End If

    rsInfoList.Close
    Set rsInfoList = Nothing
    If ShowType = 6 And RssCodeType = False Then strInfoList = unicode(strInfoList)
    GetArticleList = strInfoList
End Function


Private Function GetInfoList_GetTitleLen(TitleLen, ShowIncludePic, ShowCommentLink, IncludePic, CommentLink)
    Dim iTitleLen
    If IncludePic > 0 And ShowIncludePic = True Then
        iTitleLen = TitleLen - 6
    Else
        iTitleLen = TitleLen
    End If
    If CommentLink = True And ShowCommentLink = True Then
        iTitleLen = iTitleLen - 4
    End If
    GetInfoList_GetTitleLen = iTitleLen
End Function


Private Function GetInfoList_GetStrIncludePic(IncludePic)
    Dim strIncludePic
    strIncludePic = ""
    Select Case IncludePic
    Case 1
        strIncludePic = strIncludePic & "<span class=""S_headline1"">" & ArticlePro1 & "</span>"
    Case 2
        strIncludePic = strIncludePic & "<span class=""S_headline2"">" & ArticlePro2 & "</span>"
    Case 3
        strIncludePic = strIncludePic & "<span class=""S_headline3"">" & ArticlePro3 & "</span>"
    Case 4
        strIncludePic = strIncludePic & "<span class=""S_headline4"">" & ArticlePro4 & "</span>"
    End Select
    GetInfoList_GetStrIncludePic = strIncludePic
End Function


'=================================================
'函数名：GetPicArticle
'作  用：显示图片文章
'参  数：
'0        iChannelID ---- 频道ID
'1        arrClassID ---- 栏目ID数组，0为所有栏目
'2        IncludeChild ---- 是否包含子栏目，仅当arrClassID为单个栏目ID时才有效，True----包含子栏目，False----不包含
'3        iSpecialID ---- 专题ID，0为所有文章（含非专题文章），如果为大于0，则只显示相应专题的文章
'4        ArticleNum ---- 最多显示多少篇文章
'5        IsHot ---- 是否是热门文章
'6        IsElite ---- 是否是推荐文章
'7        DateNum ---- 日期范围，如果大于0，则只显示最近几天内更新的文章
'8        OrderType ---- 排序方式，1--按文章ID降序，2--按文章ID升序，3--按更新时间降序，4--按更新时间升序，5--按点击数降序，6--按点击数升序，7--按评论数降序，8--按评论数升序
'9        ShowType ---- 显示方式。1为图片+标题+内容简介：上下排列；2为（图片+标题：上下排列）+内容简介：左右排列，3为图片+（标题+内容简介：上下排列）：左右排列，4为输出DIV格式，5为输出RSS格式
'10       ImgWidth ---- 图片宽度
'11       ImgHeight ---- 图片高度
'12       TitleLen ---- 标题最多字符数，一个汉字=两个英文字符。若为0，则不显示标题；若为-1，则显示完整标题
'13       ContentLen ---- 内容最多字符数，一个汉字=两个英文字符。若为0，则不显示内容简介
'14       ShowTips ---- 是否显示作者、更新时间、点击数等提示信息，True为显示，False为不显示
'15       Cols ---- 每行的列数。超过此列数就换行。
'16       UrlType ---- 链接地址类型，0为相对路径，1为带网址的绝对路径。
'=================================================
Public Function GetPicArticle(iChannelID, arrClassID, IncludeChild, iSpecialID, ArticleNum, IsHot, IsElite, DateNum, OrderType, ShowType, ImgWidth, ImgHeight, TitleLen, ContentLen, ShowTips, Cols, UrlType)
    Dim sqlPic, rsPic, iCount, strPic, strLink, strAuthor, InfoUrl
    Dim strDefaultPicUrl, strLink_DefaultPicUrl, strTitle, strLink_Title, strContent, strLink_Content

    iCount = 0
    ArticleNum = PE_CLng(ArticleNum)
    ShowType = PE_CLng(ShowType)
    ImgWidth = PE_CLng(ImgWidth)
    ImgHeight = PE_CLng(ImgHeight)
    UrlType = PE_CLng(UrlType)
    Cols = PE_CLng1(Cols)

    If ArticleNum < 0 Or ArticleNum >= 100 Then ArticleNum = 10
    If ShowType < 1 And ShowType > 5 Then ShowType = 2
    If ImgWidth < 0 Or ImgWidth > 1000 Then ImgWidth = 150
    If ImgHeight < 0 Or ImgHeight > 1000 Then ImgHeight = 150
    If ShowType = 5 Then UrlType = 1
    If Cols <= 0 Then Cols = 5

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

    sqlPic = "select"
    If ArticleNum > 0 Then
        sqlPic = sqlPic & " top " & ArticleNum
    End If
    sqlPic = sqlPic & " A.ChannelID,A.ClassID,A.ArticleID,A.Title,A.TitleFontColor,A.TitleFontType,A.Author,A.UpdateTime,A.Hits,A.InfoPurview,A.InfoPoint,A.DefaultPicUrl"
    If ContentLen > 0 Then
        sqlPic = sqlPic & ",A.Intro,A.Content"
    End If
    sqlPic = sqlPic & ",C.ClassName,C.ClassDir,C.ParentDir,C.ClassPurview"
    sqlPic = sqlPic & GetSqlStr(iChannelID, arrClassID, IncludeChild, iSpecialID, IsHot, IsElite, "", DateNum, OrderType, False, True)

    Set rsPic = Server.CreateObject("ADODB.Recordset")
    rsPic.Open sqlPic, Conn, 1, 1
    If ShowType < 4 Then strPic = "<table width='100%' cellpadding='0' cellspacing='5' border='0' align='center'><tr valign='top'>"
    If rsPic.BOF And rsPic.EOF Then
        If ArticleNum = 0 Then totalPut = 0
        If ShowType < 4 Then
            strPic = strPic & "<td align='center'><img class='pic1' src='" & strInstallDir & "images/nopic.gif' width='" & ImgWidth & "' height='" & ImgHeight & "' border='0'><br>" & R_XmlText_Class("PicArticle/NoFound", "没有任何图片{$ChannelShortName}") & "</td></tr></table>"
        ElseIf ShowType = 4 Then
            strPic = strPic & "<div class=""pic_art""><img class=""pic1"" src=""" & strInstallDir & "images/nopic.gif"" width=""" & ImgWidth & """ height=""" & ImgHeight & """ border=""0""><br>" & R_XmlText_Class("PicArticle/NoFound", "没有任何图片{$ChannelShortName}") & "</div>"
        End If
        
        rsPic.Close
        Set rsPic = Nothing
        GetPicArticle = strPic
        Exit Function
    End If

    If ArticleNum = 0 And ShowType < 5 Then
        totalPut = rsPic.RecordCount
        If totalPut > 0 Then
            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
                    rsPic.Move (CurrentPage - 1) * MaxPerPage - iMod
                Else
                    CurrentPage = 1
                End If
            End If
        End If
    End If
    
    If ShowType = 5 Then Set XMLDOM = Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
    Do While Not rsPic.EOF
        If iChannelID = 0 Then
            If rsPic("ChannelID") <> PrevChannelID Then
                Call GetChannel(rsPic("ChannelID"))
                PrevChannelID = rsPic("ChannelID")
            End If
        End If

        ChannelUrl = UrlPrefix(UrlType, ChannelUrl) & ChannelUrl
        ChannelUrl_ASPFile = UrlPrefix(UrlType, ChannelUrl_ASPFile) & ChannelUrl_ASPFile
        If ShowType < 5 Then
            InfoUrl = GetArticleUrl(rsPic("ParentDir"), rsPic("ClassDir"), rsPic("UpdateTime"), rsPic("ArticleID"), rsPic("ClassPurview"), rsPic("InfoPurview"), rsPic("InfoPoint"))
            strDefaultPicUrl = GetDefaultPicUrl(rsPic("DefaultPicUrl"), ImgWidth, ImgHeight)
            strLink_DefaultPicUrl = GetInfoList_GetStrInfoLink(strList_Title, ShowTips, 1, "", strDefaultPicUrl, InfoUrl, rsPic("Title"), rsPic("Author"), rsPic("UpdateTime"))

            If ShowType = 4 Then
                strPic = strPic & "<div class=""pic_art"">" & vbCrLf
                strPic = strPic & "<div class=""pic_art_img"">" & strLink_DefaultPicUrl & "</div>" & vbCrLf
            Else
                strPic = strPic & "<td align='center'>"
                strPic = strPic & strLink_DefaultPicUrl
            End If

            If TitleLen <> 0 Then
                strTitle = GetInfoList_GetStrTitle(rsPic("Title"), TitleLen, rsPic("TitleFontType"), rsPic("TitleFontColor"))
                strLink_Title = GetInfoList_GetStrInfoLink(strList_Title, ShowTips, 1, "", strTitle, InfoUrl, rsPic("Title"), rsPic("Author"), rsPic("UpdateTime"))
                Select Case PE_CLng(ShowType)
                Case 1, 2
                    strPic = strPic & "<br>" & strLink_Title
                Case 3
                    strPic = strPic & "</td><td valign='top' align='left'>" & strLink_Title
                Case 4
                    strPic = strPic & "<div class=""pic_art_title"">" & strLink_Title & "</div>" & vbCrLf
                End Select
            End If
            If ContentLen > 0 Then
                If Trim(rsPic("Intro") & "") = "" Then
                    strContent = Left(Replace(Replace(Replace(nohtml(rsPic("Content")), "[NextPage]", ""), ">", "&gt;"), "<", "&lt;"), ContentLen) & "……"
                Else
                    strContent = Left(rsPic("Intro"), ContentLen)
                End If
                strLink_Content = GetInfoList_GetStrInfoLink(strList_Title, ShowTips, 1, "", strContent, InfoUrl, rsPic("Title"), rsPic("Author"), rsPic("UpdateTime"))
                Select Case PE_CLng(ShowType)
                Case 1, 3
                    strPic = strPic & "<br><div align='left'>" & strLink_Content & "</div>"
                Case 2
                    strPic = strPic & "</td><td valign='top' align='left'>" & strLink_Content
                Case 4
                    strPic = strPic & "<div class=""pic_art_content"">" & strLink_Content & "</div>" & vbCrLf
                End Select
            End If
            If ShowType = 4 Then
                strPic = strPic & "</div>" & vbCrLf
            Else
                strPic = strPic & "</td>"
            End If
        Else
            strTitle = GetInfoList_GetStrTitle(rsPic("Title"), TitleLen, 0, "")
            strLink = GetArticleUrl(rsPic("ParentDir"), rsPic("ClassDir"), rsPic("UpdateTime"), rsPic("ArticleID"), rsPic("ClassPurview"), rsPic("InfoPurview"), rsPic("InfoPoint"))
            strAuthor = GetInfoList_GetStrAuthor_RSS(rsPic("Author"))
            If ContentLen > 0 Then
                If Trim(rsPic("Intro") & "") = "" Then
                    strContent = Left(Replace(Replace(Replace(xml_nohtml(rsPic("Content")), "[NextPage]", ""), ">", "&gt;"), "<", "&lt;"), ContentLen)
                Else
                    strContent = Left(xml_nohtml(rsPic("Intro")), ContentLen)
                End If
            End If