powereasy.article.asp

个人网站比较简短

            strPic = strPic & GetInfoList_GetStrRSS(xml_nohtml(strTitle), strLink, strContent, strAuthor, xml_nohtml(rsPic("ClassName")), rsPic("UpdateTime"))
        End If
        rsPic.MoveNext
        iCount = iCount + 1
        If ArticleNum = 0 And iCount >= MaxPerPage Then Exit Do
        If ((iCount Mod Cols = 0) And (Not rsPic.EOF)) And ShowType < 4 Then strPic = strPic & "</tr><tr valign='top'>"
    Loop

    If ShowType < 4 Then strPic = strPic & "</tr></table>"
    rsPic.Close
    Set rsPic = Nothing
    If ShowType = 5 And RssCodeType = False Then strPic = unicode(strPic)
    GetPicArticle = strPic
End Function

'=================================================
'函数名：GetSlidePicArticle
'作  用：以幻灯片效果显示图片文章
'参  数：
'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        ImgWidth ---- 图片宽度
'10       ImgHeight ---- 图片高度
'11       TitleLen ---- 文章标题字数限制，0为不显示，-1为显示完整标题
'12       iTimeOut ---- 效果变换间隔时间，以毫秒为单位
'13       effectID ---- 图片转换效果，0至22指定某一种特效，23表示随机效果
'=================================================
Public Function GetSlidePicArticle(iChannelID, arrClassID, IncludeChild, iSpecialID, ArticleNum, IsHot, IsElite, DateNum, OrderType, ImgWidth, ImgHeight, TitleLen, iTimeOut, effectID)
    Dim sqlPic, rsPic, i, strPic
    Dim DefaultPicUrl, strTitle

    ArticleNum = PE_CLng(ArticleNum)
    ImgWidth = PE_CLng(ImgWidth)
    ImgHeight = PE_CLng(ImgHeight)

    If ArticleNum <= 0 Or ArticleNum > 100 Then ArticleNum = 10
    If ImgWidth < 0 Or ImgWidth > 1000 Then ImgWidth = 150
    If ImgHeight < 0 Or ImgHeight > 1000 Then ImgHeight = 150
    If iTimeOut < 1000 Or iTimeOut > 100000 Then iTimeOut = 5000
    If effectID < 0 Or effectID > 23 Then effectID = 23

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

    sqlPic = "select top " & ArticleNum & " A.ChannelID,A.ClassID,A.ArticleID,A.Title,A.UpdateTime,A.InfoPurview,A.InfoPoint,A.DefaultPicUrl"
    sqlPic = sqlPic & ",C.ClassName,C.ParentDir,C.ClassDir,C.ClassPurview"
    sqlPic = sqlPic & GetSqlStr(iChannelID, arrClassID, IncludeChild, iSpecialID, IsHot, IsElite, "", DateNum, OrderType, False, True)


    Dim ranNum
    Randomize
    ranNum = Int(900 * Rnd) + 100
    strPic = "<script language=JavaScript>" & vbCrLf
    strPic = strPic & "<!--" & vbCrLf
    strPic = strPic & "var SlidePic_" & ranNum & " = new SlidePic_Article(""SlidePic_" & ranNum & """);" & vbCrLf
    strPic = strPic & "SlidePic_" & ranNum & ".Width    = " & ImgWidth & ";" & vbCrLf
    strPic = strPic & "SlidePic_" & ranNum & ".Height   = " & ImgHeight & ";" & vbCrLf
    strPic = strPic & "SlidePic_" & ranNum & ".TimeOut  = " & iTimeOut & ";" & vbCrLf
    strPic = strPic & "SlidePic_" & ranNum & ".Effect   = " & effectID & ";" & vbCrLf
    strPic = strPic & "SlidePic_" & ranNum & ".TitleLen = " & TitleLen & ";" & vbCrLf

    Set rsPic = Server.CreateObject("ADODB.Recordset")
    rsPic.Open sqlPic, Conn, 1, 1
    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
        If Left(rsPic("DefaultPicUrl"), 1) <> "/" And InStr(rsPic("DefaultPicUrl"), "://") <= 0 Then
            DefaultPicUrl = ChannelUrl & "/" & UploadDir & "/" & rsPic("DefaultPicUrl")
        Else
            DefaultPicUrl = rsPic("DefaultPicUrl")
        End If
        If TitleLen = -1 Then
            strTitle = rsPic("Title")
        Else
            strTitle = GetSubStr(rsPic("Title"), TitleLen, ShowSuspensionPoints)
        End If
        
        strPic = strPic & "var oSP = new objSP_Article();" & vbCrLf
        strPic = strPic & "oSP.ImgUrl         = """ & DefaultPicUrl & """;" & vbCrLf
        strPic = strPic & "oSP.LinkUrl        = """ & GetArticleUrl(rsPic("ParentDir"), rsPic("ClassDir"), rsPic("UpdateTime"), rsPic("ArticleID"), rsPic("ClassPurview"), rsPic("InfoPurview"), rsPic("InfoPoint")) & """;" & vbCrLf
        strPic = strPic & "oSP.Title         = """ & strTitle & """;" & vbCrLf
        strPic = strPic & "SlidePic_" & ranNum & ".Add(oSP);" & vbCrLf
        
        rsPic.MoveNext
    Loop
    strPic = strPic & "SlidePic_" & ranNum & ".Show();" & vbCrLf
    strPic = strPic & "//-->" & vbCrLf
    strPic = strPic & "</script>" & vbCrLf
    
    rsPic.Close
    Set rsPic = Nothing
    GetSlidePicArticle = strPic
End Function

Private Function JS_SlidePic()
    Dim strJS, LinkTarget
    LinkTarget = XmlText_Class("SlidePicArticle/LinkTarget", "_blank")
    strJS = strJS & "<script language=""JavaScript"">" & vbCrLf
    strJS = strJS & "<!--" & vbCrLf
    strJS = strJS & "function objSP_Article() {this.ImgUrl=""""; this.LinkUrl=""""; this.Title="""";}" & vbCrLf
    strJS = strJS & "function SlidePic_Article(_id) {this.ID=_id; this.Width=0;this.Height=0; this.TimeOut=5000; this.Effect=23; this.TitleLen=0; this.PicNum=-1; this.Img=null; this.Url=null; this.Title=null; this.AllPic=new Array(); this.Add=SlidePic_Article_Add; this.Show=SlidePic_Article_Show; this.LoopShow=SlidePic_Article_LoopShow;}" & vbCrLf
    strJS = strJS & "function SlidePic_Article_Add(_SP) {this.AllPic[this.AllPic.length] = _SP;}" & vbCrLf
    strJS = strJS & "function SlidePic_Article_Show() {" & vbCrLf
    strJS = strJS & "  if(this.AllPic[0] == null) return false;" & vbCrLf
    strJS = strJS & "  document.write(""<div align='center'><a id='Url_"" + this.ID + ""' href='' target='" & LinkTarget & "'><img id='Img_"" + this.ID + ""' style='width:"" + this.Width + ""px; height:"" + this.Height + ""px; filter: revealTrans(duration=2,transition=23);' src='javascript:null' border='0'></a>"");" & vbCrLf
    strJS = strJS & "  if(this.TitleLen != 0) {document.write(""<br><span id='Title_"" + this.ID + ""'></span></div>"");}" & vbCrLf
    strJS = strJS & "  else{document.write(""</div>"");}" & vbCrLf
    strJS = strJS & "  this.Img = document.getElementById(""Img_"" + this.ID);" & vbCrLf
    strJS = strJS & "  this.Url = document.getElementById(""Url_"" + this.ID);" & vbCrLf
    strJS = strJS & "  this.Title = document.getElementById(""Title_"" + this.ID);" & vbCrLf
    strJS = strJS & "  this.LoopShow();" & vbCrLf
    strJS = strJS & "}" & vbCrLf
    strJS = strJS & "function SlidePic_Article_LoopShow() {" & vbCrLf
    strJS = strJS & "  if(this.PicNum<this.AllPic.length-1) this.PicNum++ ; " & vbCrLf
    strJS = strJS & "  else this.PicNum=0; " & vbCrLf
    strJS = strJS & "  this.Img.filters.revealTrans.Transition=this.Effect; " & vbCrLf
    strJS = strJS & "  this.Img.filters.revealTrans.apply(); " & vbCrLf
    strJS = strJS & "  this.Img.src=this.AllPic[this.PicNum].ImgUrl;" & vbCrLf
    strJS = strJS & "  this.Img.filters.revealTrans.play();" & vbCrLf
    strJS = strJS & "  this.Url.href=this.AllPic[this.PicNum].LinkUrl;" & vbCrLf
    strJS = strJS & "  if(this.Title) this.Title.innerHTML=""<a href=""+this.AllPic[this.PicNum].LinkUrl+"" target='" & LinkTarget & "'>""+this.AllPic[this.PicNum].Title+""</a>"";" & vbCrLf
    strJS = strJS & "  this.Img.timer=setTimeout(this.ID+"".LoopShow()"",this.TimeOut);" & vbCrLf
    strJS = strJS & "}" & vbCrLf
    strJS = strJS & "//-->" & vbCrLf
    strJS = strJS & "</script>" & vbCrLf
    JS_SlidePic = strJS
End Function

Private Function GetDefaultPicUrl(ByVal DefaultPicUrl, ByVal DefaultPicWidth, ByVal DefaultPicHeight)
    Dim strUrl, FileType, strPicUrl
    If DefaultPicUrl = "" Or IsNull(DefaultPicUrl) = True Then
        strUrl = strUrl & "<img src='" & strPicUrl & strInstallDir & "images/nopic.gif' "
        If DefaultPicWidth > 0 Then strUrl = strUrl & " width='" & DefaultPicWidth & "'"
        If DefaultPicHeight > 0 Then strUrl = strUrl & " height='" & DefaultPicHeight & "'"
        strUrl = strUrl & " border='0'>"
    Else
        FileType = LCase(Mid(DefaultPicUrl, InStrRev(DefaultPicUrl, ".") + 1))
        If Left(DefaultPicUrl, 1) <> "/" And InStr(DefaultPicUrl, "://") <= 0 Then
            strPicUrl = ChannelUrl & "/" & UploadDir & "/" & DefaultPicUrl
        Else
            strPicUrl = DefaultPicUrl
        End If
        Select Case FileType
        Case "swf"
            strUrl = strUrl & "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' "
            If DefaultPicWidth > 0 Then strUrl = strUrl & " width='" & DefaultPicWidth & "'"
            If DefaultPicHeight > 0 Then strUrl = strUrl & " height='" & DefaultPicHeight & "'"
            strUrl = strUrl & "><param name='movie' value='" & strPicUrl & "'><param name='quality' value='high'><embed src='" & strPicUrl & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' "
            If DefaultPicWidth > 0 Then strUrl = strUrl & " width='" & DefaultPicWidth & "'"
            If DefaultPicHeight > 0 Then strUrl = strUrl & " height='" & DefaultPicHeight & "'"
            strUrl = strUrl & "></embed></object>"
        Case "gif", "jpg", "jpeg", "jpe", "bmp", "png"
            strUrl = strUrl & "<img class='pic1' src='" & strPicUrl & "' "
            If DefaultPicWidth > 0 Then strUrl = strUrl & " width='" & DefaultPicWidth & "'"
            If DefaultPicHeight > 0 Then strUrl = strUrl & " height='" & DefaultPicHeight & "'"
            strUrl = strUrl & " border='0'>"
        Case Else
            strUrl = strUrl & "<img class='pic1' src='" & strInstallDir & "images/nopic.gif' "
            If DefaultPicWidth > 0 Then strUrl = strUrl & " width='" & DefaultPicWidth & "'"
            If DefaultPicHeight > 0 Then strUrl = strUrl & " height='" & DefaultPicHeight & "'"
            strUrl = strUrl & " border='0'>"
        End Select
    End If
    GetDefaultPicUrl = strUrl
End Function


Private Function GetSearchResultIDArr(iChannelID)
    Dim sqlSearch, rsSearch
    Dim rsField
    Dim ArticleNum, arrArticleID

    If PE_CLng(SearchResultNum) > 0 Then
        sqlSearch = "select top " & PE_CLng(SearchResultNum) & " ArticleID "
    Else
        sqlSearch = "select ArticleID "
    End If
    sqlSearch = sqlSearch & " from PE_Article where Deleted=" & PE_False & " and Status=3 and ReceiveType=0"
    If iChannelID > 0 Then
        sqlSearch = sqlSearch & " and ChannelID=" & iChannelID & " "
    End If
    If ClassID > 0 Then
        If Child > 0 Then
            sqlSearch = sqlSearch & " and ClassID in (" & arrChildID & ")"
        Else
            sqlSearch = sqlSearch & " and ClassID=" & ClassID
        End If
    End If
    If SpecialID > 0 Then
        sqlSearch = sqlSearch & " and ArticleID in (select ItemID from PE_InfoS where SpecialID=" & SpecialID & ")"
    End If
    If strField <> "" Then  '普通搜索
        Select Case strField
            Case "Title"
                sqlSearch = sqlSearch & SetSearchString("Title")
            Case "Content"
                sqlSearch = sqlSearch & SetSearchString("Content")
            Case "Author"
                sqlSearch = sqlSearch & SetSearchString("Author")
            Case "Inputer"
                sqlSearch = sqlSearch & SetSearchString("Inputer")
            Case "Editor"
                sqlSearch = sqlSearch & SetSearchString("Editor")
            Case "Keywords"
                sqlSearch = sqlSearch & SetSearchString("Keyword")
            Case Else  '自定义字段
                Set rsField = Conn.Execute("select Title from PE_Field where (ChannelID=-1 or ChannelID=" & iChannelID & ") and FieldName='" & ReplaceBadChar(strField) & "'")
                If rsField.BOF And rsField.EOF Then
                    sqlSearch = sqlSearch & SetSearchString("Title")
                Else
                    sqlSearch = sqlSearch & SetSearchString(ReplaceBadChar(strField))
                End If
                rsField.Close
                Set rsField = Nothing
        End Select
    Else   '高级搜索
        '定义高级搜索变量
        Dim Title, Intro, Content, Author, CopyFrom, Keyword2, LowInfoPoint, HighInfoPoint, BeginDate, EndDate, Inputer
        Title = Trim(Request("Title"))
        Content = Trim(Request("Content"))
        Intro = Trim(Request("Intro"))
        Author = Trim(Request("Author"))
        CopyFrom = Trim(Request("CopyFrom"))
        Keyword2 = Trim(Request("Keywords"))
        LowInfoPoint = PE_CLng(Request("LowInfoPoint"))
        HighInfoPoint = PE_CLng(Request("HighInfoPoint"))
        BeginDate = Trim(Request("BeginDate"))
        EndDate = Trim(Request("EndDate"))
        Inputer = Trim(Request("Inputer"))
        strFileName = "Search.asp?ModuleName=Article&ClassID=" & ClassID & "&SpecialID=" & SpecialID
        If Title <> "" Then
            Title = ReplaceBadChar(Title)
            strFileName = strFileName & "&Title=" & Title
            sqlSearch = sqlSearch & " and Title like '%" & Title & "%' "
        End If
        If Content <> "" Then
            Content = ReplaceBadChar(Content)