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

 找回密码
 立即注册
查看: 2722|回复: 57

[ASP编程] 文章列表类别

[复制链接]

7万

主题

861

回帖

32万

积分

论坛元老

Rank: 8Rank: 8

积分
329525
发表于 2006-10-3 00:00:00 | 显示全部楼层 |阅读模式
<%
Dim HTML
Set HTML = New NewaspPublic_Cls
Class NewaspPublic_Cls

    Private Sub Class_Initialize()
        On Error Resume Next
        Newasp.LoadTemplates 0, 0, 0
    End Sub
    '================================================
    '函数名:LoadArticleList
    '作  用:装载文章列表
    '参  数:ClassID   ----分类ID
    '        ChannelID   ----频道ID
    '        SpecialID  ----专题ID
    '        sType   ----调用文章类型,0=所有最新文章,1=推荐文章,2=热门文章,3=图文文章,4=分类最新文章
    '        TopNum   ----显示文章列表数
    '        strlen   ----显示标题长度
    '        ShowClass   ----是否显示分类
    '        ShowPic   ----是否显示图文标题
    '        ShowDate   ----是否显示日期
    '        DateMode   ----显示日期模式
    '        newindow   ----新窗口打开
    '================================================
    Public Function LoadArticleList(ByVal ChannelID, ByVal ClassID, ByVal SpecialID, _
        ByVal stype, ByVal TopNum, ByVal strLen, _
        ByVal showclass, ByVal showpic, ByVal showdate, _
        ByVal DateMode, ByVal newindow, ByVal styles)

        Dim Rs, SQL, i, strContent, foundstr
        Dim sTitle, sTopic, ChildStr, ListStyle, BestCode, BestString
        Dim ArticleTopic, ClassName, HtmlFileUrl, WriteTime, LinkTarget, HtmlFileName

        ChannelID = Newasp.ChkNumeric(ChannelID)
        ClassID = Newasp.ChkNumeric(ClassID)
        SpecialID = Newasp.ChkNumeric(SpecialID)
        stype = Newasp.ChkNumeric(stype)

        On Error Resume Next
        Newasp.LoadChannel(ChannelID)

        If CInt(stype) >= 4 And CLng(ClassID) <> 0 Then
            SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID=" & ChannelID & " And ClassID=" & ClassID
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                Set Rs = Nothing
                LoadArticleList = ""
                Exit Function
            Else
                ChildStr = Rs("ChildStr")
            End If
            Set Rs = Nothing
        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.BriefTopic = 1 Or A.BriefTopic = 2) Order By A.Writetime Desc ,A.Articleid Desc"
            Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") Order By A.Writetime Desc ,A.Articleid Desc"
            Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 Order By A.Writetime Desc ,A.Articleid Desc"
            Case 6: foundstr = "And A.ClassID in (" & ChildStr & ") Order By A.AllHits Desc ,A.Articleid Desc"
            Case 7: foundstr = "And A.ClassID in (" & ChildStr & ") And (A.BriefTopic = 1 Or A.BriefTopic = 2) Order By A.Writetime Desc ,A.Articleid Desc"
        Case Else
            foundstr = "Order By A.Writetime Desc ,A.Articleid Desc"
        End Select
        If CInt(stype) >= 4 And CLng(ClassID) = 0 Then
            foundstr = "Order By A.Writetime Desc ,A.Articleid Desc"
        End If
        If CLng(SpecialID) <> 0 Then
            foundstr = "And A.SpecialID =" & CLng(SpecialID) & " " & 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(TopNum) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir,C.UseHtml FROM [NC_Article] A INNER JOIn [NC_Classify] C ON A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & ChannelID & " " & foundstr & ""
        Set Rs = Newasp.Execute(SQL)
        i = 0
        If Rs.BOF And Rs.EOF Then
            strContent = "该分类还没有添加任何内容!"
        Else
            strContent = "<table width=""100%"" border=0 cellpadding=2 cellspacing=0>"
            Do While Not Rs.EOF
                If (i Mod 2) = 0 Then
                    ListStyle = Trim(styles) & 1
                Else
                    ListStyle = Trim(styles) & 2
                End If
                If Rs("isBest") <> 0 Then
                    BestCode = 2
                    BestString = "<font color='" & Newasp.MainSetting(3) & "'>推荐</font>"
                Else
                    BestCode = 1
                    BestString = ""
                End If

                strContent = strContent & Newasp.MainSetting(13)

                sTitle = Newasp.GotTopic(Rs("title"), CInt(strLen))
                sTitle = Newasp.ReadFontMode(sTitle, Rs("ColorMode"), Rs("FontMode"))
                sTopic = 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) = 0 Then ClassName = ""
                If CInt(showpic) = 0 Then sTopic = ""
                If CInt(showdate) <> 0 Then
                    WriteTime = Newasp.ShowDateTime(Rs("WriteTime"), CInt(DateMode))
                Else
                    WriteTime = ""
                End If
                If CInt(newindow) <> 0 Then
                    LinkTarget = " target=""_blank"""
                Else
                    LinkTarget = ""
                End If
                ArticleTopic = "<a href='" & HtmlFileUrl & "'" & LinkTarget & " title='" & Newasp.ChannelModule & "标题:" & Rs("title") & " 发布时间:" & Rs("WriteTime") & " 阅览次数:" & Rs("AllHits") & "' class=showlist>" & sTitle & "</a>"
                strContent = Replace(strContent, "{$ArticleTopic}", ArticleTopic)
                strContent = Replace(strContent, "{$ArticleID}", Rs("ArticleID"))
                strContent = Replace(strContent, "{$InstallDir}", Newasp.InstallDir)
                strContent = Replace(strContent, "{$ArticleTitle}", sTitle)
                strContent = Replace(strContent, "{$Title}", Rs("title"))
                strContent = Replace(strContent, "{$DateAndTitle}", Rs("WriteTime"))
                strContent = Replace(strContent, "{$BriefTopic}", sTopic)
                strContent = Replace(strContent, "{$HtmlFileUrl}", HtmlFileUrl)
                strContent = Replace(strContent, "{$ClassName}", ClassName)
                strContent = Replace(strContent, "[]", "")
                strContent = Replace(strContent, "{$Target}", LinkTarget)
                strContent = Replace(strContent, "{$WriteTime}", WriteTime)
                strContent = Replace(strContent, "{$AticleHits}", Rs("AllHits"))
                strContent = Replace(strContent, "{$ListStyle}", ListStyle)
                strContent = Replace(strContent, "{$BestCode}", BestCode)
                strContent = Replace(strContent, "{$BestString}", BestString)
            Rs.MoveNext
            i = i + 1
            Loop
            strContent = strContent & "</table>"
        End If

        Rs.Close: Set Rs = Nothing
        LoadArticleList = strContent
    End Function
    '================================================
    '函数名:ReadArticleList
    '作  用:读取文章列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadArticleList(ByVal str)
        Dim strTemp, i
        Dim sTempContent, nTempContent
        Dim arrTempContent, arrTempContents, ArrayList
        On Error Resume Next
        strTemp = str
        If InStr(strTemp, "{$ReadArticleList(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadArticleList(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadArticleList(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复

使用道具 举报

0

主题

62

回帖

239

积分

中级会员

Rank: 3Rank: 3

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

使用道具 举报

0

主题

65

回帖

257

积分

中级会员

Rank: 3Rank: 3

积分
257
发表于 2006-10-3 00:01:26 | 显示全部楼层
")

            For i = 0 To UBound(arrTempContents)
                ArrayList = Split(arrTempContent(i), ",")
                strTemp = Replace(strTemp, arrTempContents(i), LoadArticleList(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10), ArrayList(11)))
            Next
        End If
        ReadArticleList = strTemp
    End Function
    '================================================
    '函数名:LoadSoftList
    '作  用:装载软件列表
    '参  数:ClassID   ----分类ID
    '        ChannelID   ----频道ID
    '        sType   ----调用类型
    '        TopNum   ----显示列表数
    '        strlen   ----显示标题长度
    '        ShowClass   ----是否显示分类
    '        ShowDate   ----是否显示日期
    '        DateMode   ----显示日期模式
    '        newindow   ----新窗口打开
    '================================================
    Public Function LoadSoftList(ByVal ChannelID, ByVal ClassID, ByVal SpecialID, _
        ByVal stype, ByVal TopNum, ByVal strLen, ByVal showclass, _
        ByVal showdate, ByVal DateMode, ByVal newindow, ByVal styles)

        Dim Rs, SQL, i, strContent, foundstr,j
        Dim strSoftName, ChildStr, ListStyle
        Dim HtmlFileName, BestCode, BestString,ChannelPath
        Dim ClassName, HtmlFileUrl, SoftTime, LinkTarget, SoftTopic

        ChannelID = Newasp.ChkNumeric(ChannelID)
        ClassID = Newasp.ChkNumeric(ClassID)
        SpecialID = Newasp.ChkNumeric(SpecialID)
        stype = Newasp.ChkNumeric(stype)

        On Error Resume Next
        Newasp.LoadChannel(ChannelID)

        If CInt(stype) >= 3 And CLng(ClassID) <> 0 Then
            SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID=" & ChannelID & " And ClassID = " & ClassID
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                Set Rs = Nothing
                LoadSoftList = ""
                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(SpecialID) <> 0 Then
            foundstr = "And A.SpecialID =" & CLng(SpecialID) & " " & 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(TopNum) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir,C.UseHtml FROM [NC_SoftList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & ChannelID & " " & foundstr & ""
        Set Rs = Newasp.Execute(SQL)
        j = 0

        If Rs.BOF And Rs.EOF Then
            strContent = "没有添加任何软件!"
        Else
            SQL=Rs.GetRows(-1)
            strContent = "<table width=""100%"" border=0 cellpadding=2 cellspacing=0>"
            For i=0 To Ubound(SQL,2)
                If (j Mod 2) = 0 Then
                    ListStyle = Trim(styles) & 1
                Else
                    ListStyle = Trim(styles) & 2
                End If
                If CInt(SQL(9,i)) <> 0 Then
                    BestCode = 2
                    BestString = "<font color='" & Newasp.MainSetting(3) & "'>推荐</font>"
                Else
                    BestCode = 1
                    BestString = ""
                End If
                strContent = strContent & Newasp.MainSetting(14)
                strSoftName = Newasp.GotTopic(SQL(4,i) & " " & SQL(5,i), CInt(strLen))
                strSoftName = Newasp.ReadFontMode(strSoftName, SQL(2,i), SQL(3,i))
                ClassName = Newasp.ReadFontMode(SQL(10,i), SQL(11,i), SQL(12,i))
                HtmlFileName = Newasp.ReadFileName(SQL(8,i), SQL(0,i), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
                If CInt(Newasp.ChannelUseHtml) <> 0 Then
                    HtmlFileUrl = Newasp.ChannelPath & SQL(13,i) & Newasp.ShowDatePath(SQL(8,i), Newasp.ChannelHtmlPath) & HtmlFileName
                    ClassName = "<a href='" & Newasp.ChannelPath & SQL(13,i) & "index" & Newasp.ChannelHtmlExt & "'>" & ClassName & "</a>"
                Else
                    HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & SQL(0,i)
                    ClassName = "<a href='" & Newasp.ChannelPath & "list.asp?classid=" & SQL(1,i) & "'>" & ClassName & "</a>"
                End If
                If CInt(showclass) = 0 Then ClassName = ""
                If CInt(showdate) <> 0 Then
                    SoftTime = Newasp.ShowDateTime(SQL(7,i), CInt(DateMode))
                Else
                    SoftTime = ""
                End If
                If CInt(newindow) <> 0 Then
                    LinkTarget = " target=""_blank"""
                Else
                    LinkTarget = ""
                End If
                SoftTopic = "<a href='" & HtmlFileUrl & "'" & LinkTarget & " title='" & Newasp.ChannelModule & "名称:" & Trim(SQL(4,i) & " " & SQL(5,i)) & " 发布时间:" & SQL(7,i) & " 下载次数:" & SQL(6,i) & "' class=showlist>" & strSoftName & "</a>"
                strContent = Replace(strContent, "{$SoftTopic}", SoftTopic)
                strContent = Replace(strContent, "{$SoftID}", Rs("softid"))
                strContent = Replace(strContent, "{$InstallDir}", Newasp.InstallDir)
                strContent = Replace(strContent, "{$SoftName}", strSoftName)
                strContent = Replace(strContent, "{$Title}", SQL(4,i))
                strContent = Replace(strContent, "{$DateAndTitle}", SQL(7,i))
                strContent = Replace(strContent, "{$HtmlFileUrl}", HtmlFileUrl)
                strContent = Replace(strContent, "{$ClassName}", ClassName)
                strContent = Replace(strContent, "[]", "")
                strContent = Replace(strContent, "{$Target}", LinkTarget)
                strContent = Replace(strContent, "{$SoftTime}", SoftTime)
                strContent = Replace(strContent, "{$SoftHits}", SQL(6,i))
                strContent = Replace(strContent, "{$ListStyle}", ListStyle)
                strContent = Replace(strContent, "{$BestCode}", BestCode)
                strContent = Replace(strContent, "{$BestString}", BestString)
            j = j + 1
            Next
            SQL=Null
            strContent = strContent & "</table>"
        End If
        Rs.Close: Set Rs = Nothing
        LoadSoftList = strContent
    End Function
    '================================================
    '函数名:ReadSoftList
    '作  用:读取软件列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadSoftList(ByVal str)
        Dim strTemp, i
        Dim sTempContent, nTempContent
        Dim arrTempContent, arrTempContents, ArrayList
        On Error Resume Next
        strTemp = str
        If InStr(strTemp, "{$ReadSoftList(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadSoftList(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadSoftList(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

65

回帖

257

积分

中级会员

Rank: 3Rank: 3

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

使用道具 举报

0

主题

65

回帖

257

积分

中级会员

Rank: 3Rank: 3

积分
257
发表于 2006-10-3 00:02:50 | 显示全部楼层
")
            For i = 0 To UBound(arrTempContents)
                ArrayList = Split(arrTempContent(i), ",")
                strTemp = Replace(strTemp, arrTempContents(i), LoadSoftList(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10)))
            Next
        End If
        ReadSoftList = strTemp
    End Function

    '================================================
    '函数名:LoadFlashList
    '作  用:装载动画列表
    '参  数:ClassID   ----分类ID
    '        ChannelID   ----频道ID
    '        sType   ----调用类型
    '        TopNum   ----显示列表数
    '        strlen   ----显示标题长度
    '        ShowClass   ----是否显示分类
    '        ShowDate   ----是否显示日期
    '        DateMode   ----显示日期模式
    '        newindow   ----新窗口打开
    '================================================
    Public Function LoadFlashList(ByVal ChannelID, ByVal ClassID, ByVal SpecialID, _
        ByVal stype, ByVal TopNum, ByVal strLen, ByVal showclass, _
        ByVal showdate, ByVal DateMode, ByVal newindow, ByVal styles)

        Dim Rs, SQL, i, strContent, foundstr,j
        Dim strTitle, ChildStr, ListStyle
        Dim HtmlFileName, BestCode, BestString,ChannelPath
        Dim ClassName, HtmlFileUrl, addTime, LinkTarget, FlashTopic

        ChannelID = Newasp.ChkNumeric(ChannelID)
        ClassID = Newasp.ChkNumeric(ClassID)
        SpecialID = Newasp.ChkNumeric(SpecialID)
        stype = Newasp.ChkNumeric(stype)

        On Error Resume Next
        Newasp.LoadChannel(ChannelID)

        If CInt(stype) >= 3 And CLng(ClassID) <> 0 Then
            SQL = "SELECT ChildStr FROM [NC_Classify] WHERE ChannelID=" & ChannelID & " And ClassID = " & ClassID
            Set Rs = Newasp.Execute(SQL)
            If Rs.BOF And Rs.EOF Then
                Set Rs = Nothing
                LoadFlashList = ""
                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.addTime Desc ,A.flashid Desc"
            Case 1: foundstr = "And A.isBest > 0 Order By A.addTime Desc ,A.flashid Desc"
            Case 2: foundstr = "Order By A.AllHits Desc ,A.flashid Desc"
            Case 3: foundstr = "And A.ClassID in (" & ChildStr & ") Order By A.addTime Desc ,A.flashid Desc"
            Case 4: foundstr = "And A.ClassID in (" & ChildStr & ") And A.isBest > 0 Order By A.addTime Desc ,A.flashid Desc"
            Case 5: foundstr = "And A.ClassID in (" & ChildStr & ") Order By A.AllHits Desc ,A.flashid Desc"
        Case Else
            foundstr = "Order By A.addTime Desc ,A.flashid Desc"
        End Select
        If CInt(stype) >= 3 And CLng(ClassID) = 0 Then
            foundstr = "Order By A.addTime Desc ,A.flashid Desc"
        End If
        If CLng(SpecialID) <> 0 Then
            foundstr = "And A.SpecialID =" & CLng(SpecialID) & " " & foundstr
        End If
        SQL = " A.flashid,A.ClassID,A.ColorMode,A.FontMode,A.title,A.Author,A.AllHits,A.addTime,A.HtmlFileDate,A.isBest,"
        SQL = "SELECT TOP " & CInt(TopNum) & SQL & " C.ClassName,C.ColorModes,C.FontModes,C.HtmlFileDir,C.UseHtml FROM [NC_FlashList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.isAccept>0 And A.ChannelID=" & ChannelID & " " & foundstr & ""
        Set Rs = Newasp.Execute(SQL)
        j = 0

        If Rs.BOF And Rs.EOF Then
            strContent = "没有添加任何信息!"
        Else
            SQL=Rs.GetRows(-1)
            strContent = "<table width=""100%"" border=0 cellpadding=2 cellspacing=0>"
            For i=0 To Ubound(SQL,2)
                If (j Mod 2) = 0 Then
                    ListStyle = Trim(styles) & 1
                Else
                    ListStyle = Trim(styles) & 2
                End If
                If CInt(SQL(9,i)) <> 0 Then
                    BestCode = 2
                    BestString = "<font color='" & Newasp.MainSetting(3) & "'>推荐</font>"
                Else
                    BestCode = 1
                    BestString = ""
                End If
                strContent = strContent & Newasp.MainSetting(22)
                strTitle = Newasp.GotTopic(SQL(4,i), CInt(strLen))
                strTitle = Newasp.ReadFontMode(strTitle, SQL(2,i), SQL(3,i))
                ClassName = Newasp.ReadFontMode(SQL(10,i), SQL(11,i), SQL(12,i))
                HtmlFileName = Newasp.ReadFileName(SQL(8,i), SQL(0,i), Newasp.ChannelHtmlExt, Newasp.ChannelPrefix, Newasp.ChannelHtmlForm, "")
                If CInt(Newasp.ChannelUseHtml) <> 0 Then
                    HtmlFileUrl = Newasp.ChannelPath & SQL(13,i) & Newasp.ShowDatePath(SQL(8,i), Newasp.ChannelHtmlPath) & HtmlFileName
                    ClassName = "<a href='" & Newasp.ChannelPath & SQL(13,i) & "index" & Newasp.ChannelHtmlExt & "'>" & ClassName & "</a>"
                Else
                    HtmlFileUrl = Newasp.ChannelPath & "show.asp?id=" & SQL(0,i)
                    ClassName = "<a href='" & Newasp.ChannelPath & "list.asp?classid=" & SQL(1,i) & "'>" & ClassName & "</a>"
                End If
                If CInt(showclass) = 0 Then ClassName = ""
                If CInt(showdate) <> 0 Then
                    addTime = Newasp.ShowDateTime(SQL(7,i), CInt(DateMode))
                Else
                    addTime = ""
                End If
                If CInt(newindow) <> 0 Then
                    LinkTarget = " target=""_blank"""
                Else
                    LinkTarget = ""
                End If
                FlashTopic = "<a href='" & HtmlFileUrl & "'" & LinkTarget & " title='" & Newasp.ChannelModule & "名称:" & SQL(4,i) & " 发布时间:" & SQL(7,i) & " 下载次数:" & SQL(6,i) & "' class=showlist>" & strTitle & "</a>"
                strContent = Replace(strContent, "{$FlashTopic}", FlashTopic)
                strContent = Replace(strContent, "{$FlashID}", Rs("flashid"))
                strContent = Replace(strContent, "{$InstallDir}", Newasp.InstallDir)
                strContent = Replace(strContent, "{$FlashTopic}", strTitle)
                strContent = Replace(strContent, "{$Title}", SQL(4,i))
                strContent = Replace(strContent, "{$DateAndTime}", SQL(7,i))
                strContent = Replace(strContent, "{$HtmlFileUrl}", HtmlFileUrl)
                strContent = Replace(strContent, "{$ClassName}", ClassName)
                strContent = Replace(strContent, "[]", "")
                strContent = Replace(strContent, "{$Target}", LinkTarget)
                strContent = Replace(strContent, "{$addTime}", addTime)
                strContent = Replace(strContent, "{$FlashHits}", SQL(6,i))
                strContent = Replace(strContent, "{$ListStyle}", ListStyle)
                strContent = Replace(strContent, "{$BestCode}", BestCode)
                strContent = Replace(strContent, "{$BestString}", BestString)
            j = j + 1
            Next
            SQL=Null
            strContent = strContent & "</table>"
        End If
        Rs.Close: Set Rs = Nothing
        LoadFlashList = strContent
    End Function
    '================================================
    '函数名:ReadFlashList
    '作  用:读取动画列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadFlashList(ByVal str)
        Dim strTemp, i
        Dim sTempContent, nTempContent
        Dim arrTempContent, arrTempContents, ArrayList
        On Error Resume Next
        strTemp = str
        If InStr(strTemp, "{$ReadFlashList(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadFlashList(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadFlashList(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

186

积分

注册会员

Rank: 2

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

使用道具 举报

0

主题

55

回帖

220

积分

中级会员

Rank: 3Rank: 3

积分
220
发表于 2006-10-3 00:03:57 | 显示全部楼层
")
            For i = 0 To UBound(arrTempContents)
                ArrayList = Split(arrTempContent(i), ",")
                strTemp = Replace(strTemp, arrTempContents(i), LoadFlashList(ArrayList(0), ArrayList(1), ArrayList(2), ArrayList(3), ArrayList(4), ArrayList(5), ArrayList(6), ArrayList(7), ArrayList(8), ArrayList(9), ArrayList(10)))
            Next
        End If
        ReadFlashList = strTemp
    End Function
    '================================================
    '函数名:LoadAnnounceContent
    '作  用:装载内容公告
    '参  数:str ----原字符串
    '================================================
    Public Function LoadAnnounceContent(ByVal sTopic, ByVal ChannelID)
        Dim SQL, Rs, strTemp
        strTemp = ""
        sTopic = Newasp.CheckStr(sTopic)
        If sTopic <> "" And sTopic <> "0" Then
            SQL = "Select AnnounceID,Content,PostTime,writer From NC_Announce where AnnounceType=1 And title = '" & sTopic & "' Order By PostTime Desc,AnnounceID Desc"
        Else
            SQL = "Select AnnounceID,Content From NC_Announce where AnnounceType=1 And ChannelID in (" & ChannelID & ",999) Order By PostTime Desc,AnnounceID Desc"
        End If
        Set Rs = Newasp.Execute(SQL)
        If Not (Rs.BOF And Rs.EOF) Then
            strTemp = Rs("Content")
        End If
        Rs.Close: Set Rs = Nothing
        LoadAnnounceContent = strTemp
    End Function
    '================================================
    '函数名:ReadAnnounceContent
    '作  用:读取内容公告
    '参  数:str ----原字符串
    '================================================
    Public Function ReadAnnounceContent(ByVal str, ByVal ChannelID)
        Dim strTemp, i, sTempContent, nTempContent, strValue
        Dim arrTempContent, arrTempContents
        On Error Resume Next
        strTemp = str
        If InStr(strTemp, "{$AnnounceContent(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$AnnounceContent(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$AnnounceContent(", ")}", 0)
            If nTempContent = "" Then nTempContent = "0"
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

186

积分

注册会员

Rank: 2

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

使用道具 举报

0

主题

65

回帖

257

积分

中级会员

Rank: 3Rank: 3

积分
257
发表于 2006-10-3 00:05:07 | 显示全部楼层
")
            For i = 0 To UBound(arrTempContents)
                strValue = arrTempContent(i)
                strTemp = Replace(strTemp, arrTempContents(i), LoadAnnounceContent(strValue, ChannelID))
            Next
        End If
        ReadAnnounceContent = strTemp
    End Function
    '================================================
    '函数名:LoadAnnounceList
    '作  用:装载公告列表
    '参  数:maxnum ----最多公告数
    '        maxlen ----字符长度
    '        newindow ----是否新窗口打开 1=是,0=否
    '        showdate ----是否显示时间 1=是,0=否
    '        DateMode ----时间模式
    '        showtree ----树型显示
    '================================================
    Public Function LoadAnnounceList(ByVal ChannelID, ByVal maxnum, ByVal maxlen, _
        ByVal newindow, ByVal showdate, ByVal DateMode, ByVal showtree)

        Dim Rs, SQL, strContent
        Dim AnnounceTopic, LinkTarget
        Dim PostTime

        ChannelID = Newasp.ChkNumeric(ChannelID)
        maxnum = Newasp.ChkNumeric(maxnum)
        If maxnum = 0 Then maxnum = 10

        On Error Resume Next
        Set Rs = Newasp.Execute("SELECT TOP " & CInt(maxnum) & " AnnounceID,title,Content,PostTime,writer,hits FROM NC_Announce WHERE (ChannelID=" & ChannelID & " Or ChannelID=999) And AnnounceType<>1 ORDER BY PostTime DESC,AnnounceID DESC")
        If Rs.BOF And Rs.EOF Then
            LoadAnnounceList = ""
            Set Rs = Nothing
            Exit Function
        Else
            Do While Not Rs.EOF
                If CInt(newindow) <> 0 Then
                    LinkTarget = " target=""_blank"""
                Else
                    LinkTarget = ""
                End If
                If CInt(showdate) <> 0 Then
                    PostTime = Newasp.ShowDateTime(Rs("PostTime"), CInt(DateMode))
                Else
                    PostTime = ""
                End If
                AnnounceTopic = Newasp.GotTopic(Rs("title"), CInt(maxlen))
                AnnounceTopic = "<a href=""" & Newasp.InstallDir & "Announce.Asp?AnnounceID=" & Rs("AnnounceID") & """ title=""" & Rs("title") & """" & LinkTarget & ">" & AnnounceTopic & "</a>"
                If CInt(showtree) = 1 Then
                    strContent = strContent & "<div>· " & AnnounceTopic & "</div><div align=""right"" class=""dottedline"">" & PostTime & "</div>" & vbNewLine
                Else
                    strContent = strContent & "· " & AnnounceTopic & "  " & PostTime & vbNewLine
                End If
                Rs.MoveNext
            Loop
        End If
        LoadAnnounceList = strContent
    End Function
    '================================================
    '函数名:ReadAnnounceList
    '作  用:读取公告列表
    '参  数:str ----原字符串
    '================================================
    Public Function ReadAnnounceList(ByVal str)
        Dim strTemp, i
        Dim sTempContent, nTempContent, ArrayList
        Dim arrTempContent, arrTempContents
        On Error Resume Next
        strTemp = str
        If InStr(strTemp, "{$ReadAnnounceList(") > 0 Then
            sTempContent = Newasp.CutMatchContent(strTemp, "{$ReadAnnounceList(", ")}", 1)
            nTempContent = Newasp.CutMatchContent(strTemp, "{$ReadAnnounceList(", ")}", 0)
            arrTempContents = Split(sTempContent, "
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

194

积分

注册会员

Rank: 2

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

使用道具 举报

高级模式
B Color Image Link Quote Code Smilies

本版积分规则

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

GMT+8, 2024-11-21 19:45 , Processed in 0.169339 second(s), 26 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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