powereasy.photo.asp

个人网站比较简短

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

Dim PhotoID, rsPhoto, PhotoName, PhotoUrl

Class Photo

'定义其它全局的变量
Private rsClass

'初始化需要用到的一些变量
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"))
         
    '*****************************
    '读取语言包中的字符设置
    ChannelShortName = XmlText_Class("ChannelShortName", "图片")
    strListStr_Font = XmlText_Class("PhotoList/UpdateTimeColor_New", "color=""red""")
    strTop = XmlText_Class("PhotoList/t4", "固顶")
    strElite = XmlText_Class("PhotoList/t3", "推荐")
    strCommon = XmlText_Class("PhotoList/t5", "普通")
    strHot = XmlText_Class("PhotoList/t7", "热点")
    strNew = XmlText_Class("PhotoList/t6", "最新")
    strTop2 = XmlText_Class("PhotoList/Top", " 顶")
    strElite2 = XmlText_Class("PhotoList/Elite", " 荐")
    strHot2 = XmlText_Class("PhotoList/Hot", " 热")
    Character_Author = XmlText("Photo", "Include/Author", "[{$Text}]")
    Character_Date = XmlText("Photo", "Include/Date", "[{$Text}]")
    Character_Hits = XmlText("Photo", "Include/Hits", "[{$Text}]")
    Character_Class = XmlText("Photo", "Include/ClassChar", "[{$Text}]")
    SearchResult_Content_NoPurview = XmlText("BaseText", "SearchPurviewContent", "此内容需要有指定权限才可以预览")
    SearchResult_ContentLenth = PE_CLng(XmlText_Class("ShowSearch/Content_Lenght", "200"))
    strList_Content_Div = XmlText_Class("PhotoList/Content_DIV", "style=""padding:0px 20px""")
    strList_Title = R_XmlText_Class("PhotoList/Title", "{$ChannelShortName}名称：{$PhotoName}{$br}作&nbsp;&nbsp;&nbsp;&nbsp;者：{$Author}{$br}更新时间：{$UpdateTime}")
    strComment = XmlText_Class("PhotoList/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
'response.write "ChannelID =" & ChannelID
'response.write "ChannelUrl =" & ChannelUrl
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("Photo", 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_Photo P left join PE_Class C on P.ClassID=C.ClassID) on I.ItemID=P.PhotoID"
    Else
        strSql = strSql & " from PE_Photo P left join PE_Class C on P.ClassID=C.ClassID"
    End If
    strSql = strSql & " where P.Deleted=" & PE_False & " and P.Status=3"
    If iChannelID > 0 Then
        strSql = strSql & " and P.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 P.ClassID in (" & FilterArrNull(arrClassID, ",") & ")"
        Else
            If PE_CLng(arrClassID) > 0 Then strSql = strSql & " and P.ClassID=" & PE_CLng(arrClassID)
        End If
    End If
    If iSpecialID > 0 Then
        strSql = strSql & " and I.ModuleType=3 and I.SpecialID=" & iSpecialID
    End If
    If IsHot = True Then
        strSql = strSql & " and P.Hits>=" & HitsOfHot
    End If
    If IsElite = True Then
        strSql = strSql & " and P.Elite=" & PE_True
    End If
    If Trim(Author) <> "" Then
        strSql = strSql & " and P.Author='" & Author & "'"
    End If
    If DateNum > 0 Then
        strSql = strSql & " and DateDiff(" & PE_DatePart_D & ",P.UpdateTime," & PE_Now & ")<" & DateNum
    End If

    If IsPicUrl = True Then
        strSql = strSql & " and P.PhotoThumb<>'' "
    End If

    strSql = strSql & " order by P.OnTop " & PE_OrderType & ","
    Select Case PE_CLng(OrderType)
    Case 1, 2

    Case 3
        strSql = strSql & "P.UpdateTime desc,"
    Case 4
        strSql = strSql & "P.UpdateTime asc,"
    Case 5
        strSql = strSql & "P.Hits desc,"
    Case 6
        strSql = strSql & "P.Hits asc,"
    Case 7
        strSql = strSql & "P.CommentCount desc,"
    Case 8
        strSql = strSql & "P.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 & "P.PhotoID " & IDOrder
    End If
    GetSqlStr = strSql
End Function

'=================================================
'函数名：GetPhotoList
'作  用：显示图片名称等信息
'参  数：
'0        iChannelID ---- 频道ID
'1        arrClassID ---- 栏目ID数组，0为所有栏目
'2        IncludeChild ---- 是否包含子栏目，仅当arrClassID为单个栏目ID时才有效，True----包含子栏目，False----不包含
'3        iSpecialID ---- 专题ID，0为所有图片（含非专题图片），如果为大于0，则只显示相应专题的图片
'4        UrlType ---- 链接地址类型，0为相对路径，1为带网址的绝对路径，不对外公开，4.03时为ShowAllPhoto
'5        PhotoNum ---- 图片数，若大于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为输出DIV格式，5为输出RSS格式
'12       TitleLen ---- 标题最多字符数，一个汉字=两个英文字符，若为0，则显示完整标题
'13       ContentLen ---- 图片简介最多字符数，一个汉字=两个英文字符，为0时不显示。
'14       ShowClassName ---- 是否显示所属栏目名称，True为显示，False为不显示
'15       ShowPropertyType ---- 显示图片属性（固顶/推荐/普通）的方式，0为不显示，1为小图片，2为符号
'16       ShowAuthor ---- 是否显示图片作者，True为显示，False为不显示
'17       ShowDateType ---- 显示更新日期的样式，0为不显示，1为显示年月日，2为只显示月日，3为以“月-日”方式显示月日。
'18       ShowHits ---- 是否显示图片点击数，True为显示，False为不显示
'19       ShowHotSign ---- 是否显示热门图片标志，True为显示，False为不显示
'20       ShowNewSign ---- 是否显示新图片标志，True为显示，False为不显示
'21       ShowTips ---- 是否显示作者、更新日期、点击数等浮动提示信息，True为显示，False为不显示
'22       UsePage ---- 是否分页显示，True为分页显示，False为不分页显示，每页显示的图片数量由MaxPerPage指定
'23       OpenType ---- 图片打开方式，0为在原窗口打开，1为在新窗口打开
'24       Cols ---- 每行的列数。超过此列数就换行。
'25       CssNameA ---- 列表中文字链接调用的CSS类名
'26       CssName1 ---- 列表中奇数行的CSS效果的类名
'27       CssName2 ---- 列表中偶数行的CSS效果的类名
'=================================================
Public Function GetPhotoList(iChannelID, arrClassID, IncludeChild, iSpecialID, UrlType, PhotoNum, IsHot, IsElite, Author, DateNum, OrderType, ShowType, TitleLen, ContentLen, ShowClassName, ShowPropertyType, ShowAuthor, ShowDateType, ShowHits, ShowHotSign, ShowNewSign, ShowTips, 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 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 = 5 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
        GetPhotoList = ErrMsg
        Exit Function
    End If

    sqlInfo = "select"
    If PhotoNum > 0 Then
        sqlInfo = sqlInfo & " top " & PhotoNum
    End If
    sqlInfo = sqlInfo & " P.ChannelID,P.ClassID,P.PhotoID,P.PhotoName,P.Author,P.UpdateTime,P.Hits,P.OnTop,P.Elite,P.InfoPurview,P.InfoPoint"
    If ContentLen > 0 Then
        sqlInfo = sqlInfo & ",P.PhotoIntro"
    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)

    Set rsInfoList = Server.CreateObject("ADODB.Recordset")
    rsInfoList.Open sqlInfo, Conn, 1, 1
    If rsInfoList.BOF And rsInfoList.EOF Then
        If UsePage = True Then totalPut = 0
        If ShowType < 5 Then
            strInfoList = GetInfoList_StrNoItem(arrClassID, iSpecialID, IsHot, IsElite, strHot, strElite)
        End If
        rsInfoList.Close