源码网,源码论坛,源码之家,商业源码,游戏源码下载,discuz插件,棋牌源码下载,精品源码论坛

 找回密码
 立即注册
楼主: ttx9n

[ASP编程] 文章列表类别

[复制链接]

0

主题

2万

回帖

186

积分

注册会员

Rank: 2

积分
186
发表于 2006-10-3 00:14:10 | 显示全部楼层
")
            For i = 0 To UBound(arrTempContents)
                strTemp = Replace(strTemp, arrTempContents(i), CurrentStation(ChannelID, ClassID, ClassName, ParentID, strParent, HtmlFileDir, arrTempContent(i)))
            Next
        End If
        ReadCurrentStation = strTemp
    End Function
    '================================================
    '函数名:NewsPictureAndText
    '作  用:图文混排列表
    '================================================
    Public Function NewsPictureAndText(ByVal chanid, ByVal ClassID, ByVal specid, _
        ByVal stype, ByVal height, ByVal width, ByVal maxlen, _
        ByVal maxline, ByVal hspace, ByVal vspace, ByVal align, _
        ByVal divcss, ByVal target, ByVal start, ByVal showpic, _
        ByVal showclass, ByVal showdate, ByVal dateformat)

        Dim Rs, SQL, i, strContent, foundstr
        Dim ChildStr, HtmlFileUrl, HtmlFileName, strPicture
        Dim PicTopic, NewsTitle, ClassName, ArticleTitle, WriteTime

        chanid = Newasp.ChkNumeric(chanid)
        ClassID = Newasp.ChkNumeric(ClassID)
        specid = Newasp.ChkNumeric(specid)
        stype = Newasp.ChkNumeric(stype)

        On Error Resume Next
        Newasp.LoadChannel(chanid)

        If CInt(stype) >= 3 And CLng(ClassID) <> 0 Then
            SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID = " & chanid & " And ClassID = " & ClassID
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                Set Rs = Nothing
                NewsPictureAndText = ""
                Exit Function
            Else
                ChildStr = Rs("ChildStr")
            End If
            Rs.Close
        Else
            ChildStr = "0"
        End If
        Select Case CInt(stype)
            Case 0: foundstr = "ORDER BY A.Writetime DESC ,A.Articleid DESC"
            Case 1: foundstr = "And A.isBest > 0 ORDER BY A.Writetime DESC ,A.Articleid DESC"
            Case 2: foundstr = " ORDER BY A.AllHits DESC ,A.Articleid DESC"
            Case 3: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.Writetime DESC ,A.Articleid DESC"
            Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 ORDER BY A.Writetime DESC ,A.Articleid DESC"
            Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") And A.AllHits > B.LeastHotHist ORDER BY A.AllHits DESC ,A.Articleid DESC"
            Case 6: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.Writetime DESC ,A.Articleid DESC"
        Case Else
            foundstr = "ORDER BY A.Writetime DESC ,A.Articleid DESC"
        End Select
        If CInt(stype) >= 3 And CLng(ClassID) = 0 Then
            foundstr = "ORDER BY A.Writetime DESC ,A.Articleid DESC"
        End If
        If CLng(specid) <> 0 Then
            foundstr = "And A.SpecialID =" & CLng(specid) & " " & foundstr
        End If
        SQL = " A.ArticleID,A.ClassID,A.ColorMode,A.FontMode,A.title,A.BriefTopic,A.AllHits,A.WriteTime,A.HtmlFileDate,A.isBest,"
        SQL = "SELECT TOP " & CInt(maxline) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir FROM [NC_Article] A INNER JOIN [NC_Classify] C ON A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & chanid & " " & foundstr & ""
        Set Rs = Newasp.Execute(SQL)
        i = 0
        strContent = ""
        If Rs.BOF And Rs.EOF Then
            strContent = "还没有添加任何内容!"
        Else
            Do While Not Rs.EOF
                NewsTitle = Newasp.ReadTopic(Rs("title"), CInt(maxlen))
                NewsTitle = Newasp.ReadFontMode(NewsTitle, Rs("ColorMode"), Rs("FontMode"))
                PicTopic = Newasp.ReadPicTopic(Rs("BriefTopic"))
                ClassName = Newasp.ReadFontMode(Rs("ClassName"), Rs("ColorModes"), Rs("FontModes"))
                HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
                If CInt(Newasp.ChannelUseHtml) <> 0 Then
                    HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
                    ClassName = "[<a href='" & Newasp.ChannelPath & Rs("HtmlFileDir") & "index" & Newasp.ChannelHtmlExt & "'>" & ClassName & "</a>]"
                Else
                    HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("ArticleID")
                    ClassName = "[<a href='" & Newasp.ChannelPath & "list.asp?classid=" & Rs("ClassID") & "'>" & ClassName & "</a>]"
                End If
                If CInt(showclass) = 1 Then
                    ClassName = ClassName
                Else
                    ClassName = ""
                End If
                If CInt(showdate) = 1 Then
                    WriteTime = Newasp.ShowDateTime(Rs("WriteTime"), CInt(dateformat))
                Else
                    WriteTime = ""
                End If
                ArticleTitle = "<div " & divcss & ">" & start & ClassName & " <a href=""" & HtmlFileUrl & """ target=""" & target & """ title=""" & Newasp.ChannelModule & "标题:" & Rs("title") & " 发布时间:" & Rs("WriteTime") & " 阅览次数:" & Rs("AllHits") & """ class=showlist>" & NewsTitle & "</a>  " & WriteTime & "</div>"
                strContent = strContent & ArticleTitle
                Rs.MoveNext
                i = i + 1
            Loop
        End If
        Rs.Close: Set Rs = Nothing
        Dim sExtName, ExtName, ImageUrl
        If CInt(showpic) = 1 Then
            SQL = " A.ArticleID,A.ClassID,A.title,A.AllHits,A.WriteTime,A.HtmlFileDate,A.ImageUrl,"
            SQL = "SELECT " & SQL & " C.HtmlFileDir,B.ChannelDir,B.StopChannel,B.ModuleName,B.BindDomain,B.DomainName,B.IsCreateHtml,B.HtmlExtName,B.HtmlPath,B.HtmlForm,B.HtmlPrefix,B.LeastHotHist FROM ([NC_Article] A INNER JOIN [NC_Classify] C ON A.ClassID=C.ClassID) INNER JOIN [NC_Channel] B On A.ChannelID=B.ChannelID WHERE A.isAccept>0 And A.ChannelID=" & CInt(chanid) & " And A.ImageUrl<>'' " & foundstr & ""
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                strPicture = "<img src='" & Newasp.SiteUrl & Newasp.InstallDir & "images/no_pic.gif' width=""" & width & """ height=""" & height & """  hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ border=""0"">"
            Else
                HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
                If CInt(Newasp.ChannelUseHtml) <> 0 Then
                    HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
                Else
                    HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("ArticleID")
                End If
                ImageUrl = Newasp.GetImageUrl(Rs("ImageUrl"), Newasp.ChannelData(1))
                sExtName = Split(Rs("ImageUrl"), ".")
                ExtName = sExtName(UBound(sExtName))
                Select Case LCase(ExtName)
                Case "swf", "swi"
                    strPicture = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """>" & vbNewLine
                    strPicture = strPicture & "     <param name=""movie"" value=""" & ImageUrl & """>" & vbNewLine
                    strPicture = strPicture & "     <param name=""quality"" value=""high"">" & vbNewLine
                    strPicture = strPicture & "     <embed src=""" & ImageUrl & """ width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash""></embed>" & vbNewLine
                    strPicture = strPicture & "</object>" & vbNewLine
                Case Else
                    strPicture = "<a href=""" & HtmlFileUrl & """  target=""" & target & """ title=""" & Newasp.ChannelModule & "标题:" & Rs("title") & " 发布时间:" & Rs("WriteTime") & " 阅览次数:" & Rs("AllHits") & """><img src=""" & ImageUrl & """ width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ border=""0""></a>"
                End Select
            End If
            Rs.Close: Set Rs = Nothing
        Else
            strPicture = ""
        End If
        NewsPictureAndText = strPicture & strContent
    End Function
    '================================================
    '函数名:ReadNewsPicAndText
    '作  用:读取图文混排列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadNewsPicAndText(ByVal str)
        Dim strTemp, i, sTempContent
        Dim nTempContent, ArrayList
        Dim arrTempContent, arrTempContents
        On Error Resume Next
        strTemp = str
        If InStr(strTemp, "{$NewsPictureAndText(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$NewsPictureAndText(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$NewsPictureAndText(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

65

回帖

257

积分

中级会员

Rank: 3Rank: 3

积分
257
发表于 2006-10-3 00:14:44 | 显示全部楼层
")
            arrTempContent = Split(nTempContent, "
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

194

积分

注册会员

Rank: 2

积分
194
发表于 2006-10-3 00:15:31 | 显示全部楼层
")
            For i = 0 To UBound(arrTempContents)
                ArrayList = Split(arrTempContent(i), ",")
                strTemp = Replace(strTemp, arrTempContents(i), NewsPictureAndText(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10), ArrayList(11), ArrayList(12), ArrayList(13), ArrayList(14), ArrayList(15), ArrayList(16), ArrayList(17)))
            Next
        End If
        ReadNewsPicAndText = strTemp
    End Function
    '================================================
    '函数名:SoftPictureAndText
    '作  用:软件图文混排列表
    '================================================
    Public Function SoftPictureAndText(ByVal chanid, ByVal ClassID, ByVal specid, _
        ByVal stype, ByVal height, ByVal width, ByVal maxlen, _
        ByVal maxline, ByVal hspace, ByVal vspace, ByVal align, _
        ByVal divcss, ByVal target, ByVal start, ByVal showpic, _
        ByVal showclass, ByVal showdate, ByVal dateformat)

        Dim Rs, SQL, i, strContent, foundstr
        Dim ChildStr, HtmlFileUrl, HtmlFileName, strPicture
        Dim SoftTopic, ClassName, softname, SoftTime

        chanid = Newasp.ChkNumeric(chanid)
        ClassID = Newasp.ChkNumeric(ClassID)
        specid = Newasp.ChkNumeric(specid)
        stype = Newasp.ChkNumeric(stype)

        On Error Resume Next
        Newasp.LoadChannel(chanid)

        If CInt(stype) >= 3 And CLng(ClassID) <> 0 Then
            SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID = " & chanid & " And ClassID = " & ClassID
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                Set Rs = Nothing
                SoftPictureAndText = ""
                Exit Function
            Else
                ChildStr = Rs("ChildStr")
            End If
            Rs.Close
        Else
            ChildStr = "0"
        End If
        Select Case CInt(stype)
            Case 0: foundstr = "ORDER BY A.SoftTime DESC ,A.softid DESC"
            Case 1: foundstr = "And A.isBest > 0 ORDER BY A.SoftTime DESC ,A.softid DESC"
            Case 2: foundstr = "ORDER BY A.AllHits DESC ,A.softid DESC"
            Case 3: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.SoftTime DESC ,A.softid DESC"
            Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 ORDER BY A.SoftTime DESC ,A.softid DESC"
            Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.AllHits DESC ,A.softid DESC"
        Case Else
            foundstr = "ORDER BY A.SoftTime DESC ,A.softid DESC"
        End Select
        If CInt(stype) >= 3 And CLng(ClassID) = 0 Then
            foundstr = "ORDER BY A.SoftTime DESC ,A.softid DESC"
        End If
        If CLng(specid) > 0 Then
            foundstr = "And A.SpecialID =" & CLng(specid) & " " & foundstr
        End If
        SQL = " A.softid,A.ClassID,A.ColorMode,A.FontMode,A.SoftName,A.SoftVer,A.AllHits,A.SoftTime,A.HtmlFileDate,A.isBest,"
        SQL = "SELECT TOP " & CInt(maxline) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir FROM [NC_SoftList] A INNER JOIN [NC_Classify] C ON A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & chanid & " " & foundstr & ""
        Set Rs = Newasp.Execute(SQL)
        i = 0
        strContent = ""
        If Rs.BOF And Rs.EOF Then
            strContent = "还没有添加任何软件!"
        Else
            Do While Not Rs.EOF
                SoftTopic = Newasp.ReadTopic(Trim(Rs("SoftName") & " " & Rs("SoftVer")), CInt(maxlen))
                SoftTopic = Newasp.ReadFontMode(SoftTopic, Rs("ColorMode"), Rs("FontMode"))
                ClassName = Newasp.ReadFontMode(Rs("ClassName"), Rs("ColorModes"), Rs("FontModes"))
                HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("softid"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
                If CInt(Newasp.ChannelUseHtml) > 0 Then
                    HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
                    ClassName = "[<a href='" & Newasp.ChannelPath & Rs("HtmlFileDir") & "index" & Newasp.ChannelHtmlExt & "'>" & ClassName & "</a>]"
                Else
                    HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("softid")
                    ClassName = "[<a href='" & Newasp.ChannelPath & "list.asp?classid=" & Rs("ClassID") & "'>" & ClassName & "</a>]"
                End If
                If CInt(showclass) = 1 Then
                    ClassName = ClassName
                Else
                    ClassName = ""
                End If
                If CInt(showdate) = 1 Then
                    SoftTime = Newasp.ShowDateTime(Rs("SoftTime"), CInt(dateformat))
                Else
                    SoftTime = ""
                End If
                softname = "<div " & divcss & ">" & start & ClassName & " <a href=""" & HtmlFileUrl & """ target=""" & target & """ title=""" & Newasp.ChannelModule & "标题:" & Rs("SoftName") & " " & Rs("SoftVer") & " 发布时间:" & Rs("SoftTime") & " 阅览次数:" & Rs("AllHits") & """ class=showlist>" & SoftTopic & "</a>  " & SoftTime & "</div>"
                strContent = strContent & softname
                Rs.MoveNext
                i = i + 1
            Loop
        End If
        Rs.Close: Set Rs = Nothing
        Dim sExtName, ExtName, SoftImage
        If CInt(showpic) = 1 Then
            SQL = " A.softid,A.ClassID,A.SoftName,A.SoftVer,A.AllHits,A.SoftTime,A.HtmlFileDate,A.SoftImage,"
            SQL = "SELECT " & SQL & " C.HtmlFileDir,B.ChannelDir,B.ModuleName,B.BindDomain,B.DomainName,B.IsCreateHtml,B.HtmlExtName,B.HtmlPath,B.HtmlForm,B.HtmlPrefix,B.LeastHotHist FROM ([NC_SoftList] A INNER JOIN [NC_Classify] C ON A.ClassID=C.ClassID) INNER JOIN [NC_Channel] B On A.ChannelID=B.ChannelID WHERE A.isAccept>0 And A.ChannelID=" & CInt(chanid) & " And A.SoftImage<>'' " & foundstr & ""
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                strPicture = "<img src='" & Newasp.SiteUrl & Newasp.InstallDir & "images/no_pic.gif' width=""" & width & """ height=""" & height & """  hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ border=""0"">"
            Else
                HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("softid"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
                If CInt(Newasp.ChannelUseHtml) <> 0 Then
                    HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
                Else
                    HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("softid")
                End If
                SoftImage = Newasp.GetImageUrl(Rs("SoftImage"), Newasp.ChannelData(1))
                sExtName = Split(Rs("SoftImage"), ".")
                ExtName = sExtName(UBound(sExtName))
                Select Case LCase(ExtName)
                Case "swf", "swi"
                    strPicture = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """>" & vbNewLine
                    strPicture = strPicture & "     <param name=""movie"" value=""" & SoftImage & """>" & vbNewLine
                    strPicture = strPicture & "     <param name=""quality"" value=""high"">" & vbNewLine
                    strPicture = strPicture & "     <embed src=""" & SoftImage & """ width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash""></embed>" & vbNewLine
                    strPicture = strPicture & "</object>" & vbNewLine
                Case Else
                    strPicture = "<a href=""" & HtmlFileUrl & """  target=""" & target & """ title=""" & Newasp.ChannelModule & "标题:" & Rs("SoftName") & " " & Rs("SoftVer") & " 发布时间:" & Rs("SoftTime") & " 阅览次数:" & Rs("AllHits") & """><img src=""" & SoftImage & """ width=""" & width & """ height=""" & height & """ hspace=""" & hspace & """ vspace=""" & vspace & """ align=""" & align & """ border=""0""></a>"
                End Select
            End If
            Rs.Close: Set Rs = Nothing
        Else
            strPicture = ""
        End If
        SoftPictureAndText = strPicture & strContent
    End Function
    '================================================
    '函数名:ReadSoftPicAndText
    '作  用:读取软件图文混排列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadSoftPicAndText(ByVal str)
        On Error Resume Next
        Dim strTemp, i, sTempContent
        Dim nTempContent, ArrayList
        Dim arrTempContent, arrTempContents

        strTemp = str
        If InStr(strTemp, "{$SoftPictureAndText(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$SoftPictureAndText(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$SoftPictureAndText(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

74

回帖

293

积分

中级会员

Rank: 3Rank: 3

积分
293
发表于 2006-10-3 00:16:31 | 显示全部楼层
")
            arrTempContent = Split(nTempContent, "
回复 支持 反对

使用道具 举报

0

主题

65

回帖

257

积分

中级会员

Rank: 3Rank: 3

积分
257
发表于 2006-10-3 00:17:09 | 显示全部楼层
")
            For i = 0 To UBound(arrTempContents)
                ArrayList = Split(arrTempContent(i), ",")
                strTemp = Replace(strTemp, arrTempContents(i), SoftPictureAndText(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10), ArrayList(11), ArrayList(12), ArrayList(13), ArrayList(14), ArrayList(15), ArrayList(16), ArrayList(17)))
            Next
        End If
        ReadSoftPicAndText = strTemp
    End Function
    '================================================
    '函数名:LoadGuestList
    '作  用:装载留言列表
    '参  数:maxnum ----最多留言数
    '        maxlen ----字符长度
    '        newindow ----是否新窗口打开 1=是,0=否
    '        showdate ----是否显示时间 1=是,0=否
    '        DateMode ----时间模式
    '        styles ----风格名称
    '================================================
    Public Function LoadGuestList(ByVal maxnum, ByVal maxlen, ByVal newindow, _
        ByVal showdate, ByVal DateMode, ByVal styles)

        Dim Rs, SQL, strContent
        Dim i, ListStyle, GuestTopic, LinkTarget
        Dim WriteTime, lastime, GuestTitle,strChannelDir

        On Error Resume Next
        Set Rs = Newasp.Execute("SELECT TOP " & CInt(maxnum) & " guestid,Topicformat,title,username,WriteTime,lastime,ReplyNum FROM NC_GuestBook WHERE isAccept>0 ORDER BY isTop DESC,lastime DESC,guestid DESC")
        If Rs.BOF And Rs.EOF Then
            LoadGuestList = "没有任何留言!"
            Set Rs = Nothing
            Exit Function
        Else
            i = 0
            strContent = "<table width=""100%"" border=0 cellpadding=2 cellspacing=0>"
            strChannelDir = Newasp.GetChannelDir(4)
            Do While Not Rs.EOF
                If (i Mod 2) = 0 Then
                    ListStyle = Trim(styles) & 1
                Else
                    ListStyle = Trim(styles) & 2
                End If
                If CInt(newindow) <> 0 Then
                    LinkTarget = " target=""_blank"""
                Else
                    LinkTarget = ""
                End If
                If CInt(showdate) <> 0 Then
                    WriteTime = Newasp.ShowDateTime(Rs("WriteTime"), CInt(DateMode))
                    lastime = Newasp.ShowDateTime(Rs("lastime"), CInt(DateMode))
                Else
                    WriteTime = ""
                    lastime = ""
                End If
                GuestTitle = Newasp.HTMLEncode(Rs("title"))
                GuestTopic = "<span " & Rs("Topicformat") & ">" & Newasp.GotTopic(GuestTitle, CInt(maxlen)) & "</span>"
                GuestTopic = "<a href=""" & strChannelDir & "showreply.asp?guestid=" & Rs("guestid") & """ title=""主题:" & GuestTitle & " 时间:" & Rs("WriteTime") & " 作者:" & Newasp.HTMLEncode(Rs("username")) & """" & LinkTarget & ">" & GuestTopic & "</a>"
                strContent = strContent & Newasp.MainSetting(16)
                strContent = Replace(strContent, "{$GuestID}", Rs("guestid"))
                strContent = Replace(strContent, "{$UserName}", Newasp.HTMLEncode(Rs("username")))
                strContent = Replace(strContent, "{$GuestTopic}", GuestTopic)
                strContent = Replace(strContent, "{$ListStyle}", ListStyle)
                strContent = Replace(strContent, "{$Number}", i)
                strContent = Replace(strContent, "{$WriteTime}", WriteTime)
                strContent = Replace(strContent, "{$lastime}", lastime)
                Rs.MoveNext
                i = i + 1
            Loop
            strContent = strContent & "</table>"
        End If
        LoadGuestList = strContent
    End Function
    '================================================
    '函数名:ReadGuestList
    '作  用:读取留言列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadGuestList(ByVal str)
        Dim strTemp, i, sTempContent
        Dim nTempContent, ArrayList
        Dim arrTempContent, arrTempContents

        strTemp = str
        If InStr(strTemp, "{$ReadGuestList(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadGuestList(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadGuestList(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

74

回帖

293

积分

中级会员

Rank: 3Rank: 3

积分
293
发表于 2006-10-3 00:17:49 | 显示全部楼层
")
            arrTempContent = Split(nTempContent, "
回复 支持 反对

使用道具 举报

0

主题

65

回帖

257

积分

中级会员

Rank: 3Rank: 3

积分
257
发表于 2006-10-3 00:18:31 | 显示全部楼层
")
            For i = 0 To UBound(arrTempContents)
                ArrayList = Split(arrTempContent(i), ",")
                strTemp = Replace(strTemp, arrTempContents(i), LoadGuestList(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5)))
            Next
        End If
        ReadGuestList = strTemp
    End Function
    '================================================
    '函数名:LoadPopularSoft
    '作  用:装载排行软件列表
    '参  数:ClassID   ----分类ID
    '        chanid   ----频道ID
    '        stype   ----调用类型
    '        maxline   ----显示列表数
    '        maxlen   ----显示标题长度
    '        showhits   ----是否显示下载数
    '        target   ----连接目标
    '        start   ----标题头标记
    '        styles   ----样式名称
    '================================================
    Public Function LoadPopularSoft(ByVal chanid, ByVal ClassID, ByVal stype, _
        ByVal maxlen, ByVal maxline, ByVal showhits, _
        ByVal target, ByVal start, ByVal styles)

        Dim SQL, Rs, foundsql, strHits
        Dim ChildStr, i, strContent
        Dim HtmlFileName, HtmlFileUrl
        Dim NewsTitle, AllHits, strSoftName
        Dim divstyle

        chanid = Newasp.ChkNumeric(chanid)
        ClassID = Newasp.ChkNumeric(ClassID)
        stype = Newasp.ChkNumeric(stype)
        If chanid = 0 Then chanid = 1

        On Error Resume Next
        Newasp.LoadChannel(chanid)

        If CLng(ClassID) > 0 And Trim(ClassID) <> "" Then
            SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID=" & chanid & " And classid=" & ClassID
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                Set Rs = Nothing
                LoadPopularSoft = ""
                Exit Function
            Else
                ChildStr = Rs("ChildStr")
                foundsql = "And A.ClassID in (" & ChildStr & ")"
            End If
            Rs.Close
        Else
            ChildStr = "0"
            foundsql = ""
        End If

        Select Case CInt(stype)
        Case 1
            foundsql = foundsql & " ORDER BY A.DayHits DESC ,A.softid DESC"
            strHits = "DayHits"
        Case 2
            foundsql = foundsql & " ORDER BY A.WeekHits DESC ,A.softid DESC"
            strHits = "WeekHits"
        Case 3
            foundsql = foundsql & " ORDER BY A.MonthHits DESC ,A.softid DESC"
            strHits = "MonthHits"
        Case 4
            foundsql = foundsql & " And A.isBest>0 ORDER BY A.AllHits DESC ,A.softid DESC"
            strHits = "AllHits"
        Case Else
            foundsql = foundsql & "ORDER BY A.AllHits DESC ,A.softid DESC"
            strHits = "AllHits"
        End Select
        SQL = " A.softid,A.ClassID,A.ColorMode,A.FontMode,A.SoftName,A.SoftVer,A.AllHits,A.SoftTime,A.HtmlFileDate,A.isBest,A.DayHits,A.WeekHits,A.MonthHits,"
        SQL = "SELECT TOP " & CInt(maxline) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir FROM [NC_SoftList] A INNER JOIN [NC_Classify] C ON A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & chanid & " " & foundsql
        Set Rs = Newasp.Execute(SQL)
        i = 0
        strContent = ""
        If Rs.BOF And Rs.EOF Then
            strContent = "还没有找到任何内容!"
        Else
            Do While Not Rs.EOF
                If Trim(styles) <> "" And Trim(styles) <> "0" Then
                    If (i Mod 2) = 0 Then
                        divstyle = " class=""" & Trim(styles) & "1"""
                    Else
                        divstyle = " class=""" & Trim(styles) & "2"""
                    End If
                End If

                NewsTitle = Newasp.GotTopic(Rs("SoftName") & " " & Rs("SoftVer"), CInt(maxlen))
                NewsTitle = Newasp.ReadFontMode(NewsTitle, Rs("ColorMode"), Rs("FontMode"))
                HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("SoftID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
                If CInt(Newasp.ChannelUseHtml) > 0 Then
                    HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
                Else
                    HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("softid")
                End If
                If CInt(showhits) > 0 Then
                    AllHits = Rs(strHits)
                Else
                    AllHits = ""
                End If
                strSoftName = "<div" & divstyle & ">" & start & " <a href=""" & HtmlFileUrl & """ target=""" & target & """ title=""" & Newasp.ChannelModule & "名称:" & Rs("SoftName") & " " & Rs("SoftVer") & " 发布时间:" & Rs("SoftTime") & " 下载总数:" & Rs("AllHits") & """ class=popular>" & NewsTitle & "</a>  " & AllHits & "</div>"
                strContent = strContent & strSoftName

                Rs.MoveNext
                i = i + 1
            Loop
        End If
        Rs.Close: Set Rs = Nothing
        LoadPopularSoft = strContent
    End Function
    '================================================
    '函数名:ReadPopularSoft
    '作  用:读取软件排行列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadPopularSoft(ByVal str)
        On Error Resume Next
        Dim strTemp, i, sTempContent
        Dim nTempContent, ArrayList
        Dim arrTempContent, arrTempContents

        strTemp = str
        If InStr(strTemp, "{$ReadPopularSoft(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadPopularSoft(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadPopularSoft(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

74

回帖

293

积分

中级会员

Rank: 3Rank: 3

积分
293
发表于 2006-10-3 00:19:20 | 显示全部楼层
")
            arrTempContent = Split(nTempContent, "
回复 支持 反对

使用道具 举报

0

主题

55

回帖

220

积分

中级会员

Rank: 3Rank: 3

积分
220
发表于 2006-10-3 00:19:58 | 显示全部楼层
")
            For i = 0 To UBound(arrTempContents)
                ArrayList = Split(arrTempContent(i), ",")
                strTemp = Replace(strTemp, arrTempContents(i), LoadPopularSoft(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8)))
            Next
        End If
        ReadPopularSoft = strTemp
    End Function
    '================================================
    '函数名:LoadPopularArticle
    '作  用:装载排行文章列表
    '参  数:ClassID   ----分类ID
    '        chanid   ----频道ID
    '        stype   ----调用类型
    '        maxline   ----显示列表数
    '        maxlen   ----显示标题长度
    '        showhits   ----是否显示下载数
    '        target   ----连接目标
    '        start   ----标题头标记
    '        styles   ----样式名称
    '================================================
    Public Function LoadPopularArticle(ByVal chanid, ByVal ClassID, ByVal stype, _
        ByVal maxlen, ByVal maxline, ByVal showhits, ByVal target, _
        ByVal start, ByVal styles)

        Dim SQL, Rs, foundsql, strHits
        Dim ChildStr, i, strContent
        Dim HtmlFileName, HtmlFileUrl
        Dim NewsTitle, AllHits, ArticleTitle
        Dim divstyle

        chanid = Newasp.ChkNumeric(chanid)
        ClassID = Newasp.ChkNumeric(ClassID)
        stype = Newasp.ChkNumeric(stype)

        If chanid = 0 Then chanid = 2

        On Error Resume Next
        Newasp.LoadChannel(chanid)

        If CLng(ClassID) > 0 And Trim(ClassID) <> "" Then
            SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID=" & chanid & " And classid=" & CLng(ClassID)
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                Set Rs = Nothing
                LoadPopularArticle = ""
                Exit Function
            Else
                ChildStr = Rs("ChildStr")
                foundsql = "And A.ClassID in (" & ChildStr & ")"
            End If
            Rs.Close
        Else
            ChildStr = "0"
            foundsql = ""
        End If
        Select Case CInt(stype)
        Case 1
            foundsql = foundsql & " ORDER BY A.DayHits DESC ,A.Articleid DESC"
            strHits = "DayHits"
        Case 2
            foundsql = foundsql & " ORDER BY A.WeekHits DESC ,A.Articleid DESC"
            strHits = "WeekHits"
        Case 3
            foundsql = foundsql & " ORDER BY A.MonthHits DESC ,A.Articleid DESC"
            strHits = "MonthHits"
        Case 4
            foundsql = foundsql & " And A.isBest>0 ORDER BY A.AllHits DESC ,A.Articleid DESC"
            strHits = "AllHits"
        Case Else
            foundsql = foundsql & "ORDER BY A.AllHits DESC ,A.Articleid DESC"
            strHits = "AllHits"
        End Select
        SQL = " A.ArticleID,A.ClassID,A.ColorMode,A.FontMode,A.title,A.BriefTopic,A.AllHits,A.WriteTime,A.HtmlFileDate,A.isBest,A.DayHits,A.WeekHits,A.MonthHits,"
        SQL = "SELECT TOP " & CInt(maxline) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir FROM [NC_Article] A INNER JOIN [NC_Classify] C ON A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & chanid & " " & foundsql
        Set Rs = Newasp.Execute(SQL)
        i = 0
        strContent = ""
        If Rs.BOF And Rs.EOF Then
            strContent = "还没有找到任何软件!"
        Else
            Do While Not Rs.EOF
                If Trim(styles) <> "" And Trim(styles) <> "0" Then
                    If (i Mod 2) = 0 Then
                        divstyle = " class=""" & Trim(styles) & "1"""
                    Else
                        divstyle = " class=""" & Trim(styles) & "2"""
                    End If
                End If
                NewsTitle = Newasp.GotTopic(Rs("title"), CInt(maxlen))
                NewsTitle = Newasp.ReadFontMode(NewsTitle, Rs("ColorMode"), Rs("FontMode"))
                HtmlFileName = Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("ArticleID"), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
                If CInt(Newasp.ChannelUseHtml) > 0 Then
                    HtmlFileUrl = Newasp.ChannelPath & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.ChannelHtmlPath) & HtmlFileName
                Else
                    HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & Rs("ArticleID")
                End If
                If CInt(showhits) > 0 Then
                    AllHits = Rs(strHits)
                Else
                    AllHits = ""
                End If
                ArticleTitle = "<div" & divstyle & ">" & start & " <a href=""" & HtmlFileUrl & """ target=""" & target & """ title=""" & Newasp.ChannelModule & "标题:" & Rs("title") & " 发布时间:" & Rs("WriteTime") & " 阅览次数:" & Rs("AllHits") & """ class=popular>" & NewsTitle & "</a>  " & AllHits & "</div>"
                strContent = strContent & ArticleTitle
                Rs.MoveNext
                i = i + 1
            Loop
        End If
        Rs.Close: Set Rs = Nothing
        LoadPopularArticle = strContent
    End Function
    '================================================
    '函数名:ReadPopularSoft
    '作  用:读取软件排行列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadPopularArticle(ByVal str)
        On Error Resume Next
        Dim strTemp, i, sTempContent
        Dim nTempContent, ArrayList
        Dim arrTempContent, arrTempContents

        strTemp = str
        If InStr(strTemp, "{$ReadPopularArticle(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadPopularArticle(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadPopularArticle(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

55

回帖

220

积分

中级会员

Rank: 3Rank: 3

积分
220
发表于 2006-10-3 00:20:49 | 显示全部楼层
")
            arrTempContent = Split(nTempContent, "
回复 支持 反对

使用道具 举报

高级模式
B Color Image Link Quote Code Smilies

本版积分规则

手机版|小黑屋|网站地图|源码论坛 ( 海外版 )

GMT+8, 2024-11-21 23:56 , Processed in 0.066733 second(s), 18 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表