load.cls

一个动易的组件源码,3.5的封装,本程序只是搜索部分,另本人己封装了动易3.5的组件,有源码,有意请联系我

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "load"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Sub Class_Initialize()
    Set Power_Object = Me
    Power_Initialize
    OpenDatabase
 UserLevel = Request.Cookies("asp163")("UserLevel")
If UserLevel = "" Then
    UserLevel = 5000
Else
    UserLevel = CInt(UserLevel)
End If


If ArticleID = "" Then
    ArticleID = 0
Else
    ArticleID = CLng(ArticleID)
End If
If ClassID <> "" Then
    ClassID = CLng(ClassID)
Else
    ClassID = 0
End If
If SpecialID = "" Then
    SpecialID = 0
Else
    SpecialID = CLng(SpecialID)
End If

star

End Sub
Private Sub Class_Terminate()
    Power_Terminate
    Set rsArticle = Nothing
    Set rsSpecial = Nothing
    Set rsUser = Nothing
End Sub
Private Sub star()
strPath = "&nbsp;您现在的位置：&nbsp;<a href='" & SiteUrl & "'>" & SiteName & "</a>"
strPageTitle = SiteTitle
If ShowSiteChannel = "Yes" Then
    strChannel = "|&nbsp;"
    sqlChannel = "select * from Channel order by OrderID"
    Set rsChannel = Server.CreateObject("adodb.recordset")
    rsChannel.Open sqlChannel, Conn, 1, 1
    Do While Not rsChannel.EOF
        If rsChannel("ChannelID") = ChannelID Then
            ChannelUrl = rsChannel("LinkUrl")
            ChannelName = rsChannel("ChannelName")
            strChannel = strChannel & "<a href='" & ChannelUrl & "'><font color=red>" & ChannelName & "</font></a>&nbsp;|&nbsp;"
        Else
            strChannel = strChannel & "<a href='" & rsChannel("LinkUrl") & "' target='_blank'>" & rsChannel("ChannelName") & "</a>&nbsp;|&nbsp;"
        End If
        rsChannel.MoveNext
    Loop
    rsChannel.Close
    Set rsChannel = Nothing
    strPath = strPath & "&nbsp;&gt;&gt;&nbsp;<a href='" & ChannelUrl & "'>" & ChannelName & "</a>"
    strPageTitle = strPageTitle & " >> " & ChannelName
End If

If ClassID > 0 Then
    sql = "select C.ClassName,C.RootID,C.ParentID,C.Depth,C.ParentPath,C.Child,C.SkinID,L.LayoutID,L.LayoutFileName,C.BrowsePurview From ArticleClass C"
    sql = sql & " inner join Layout L on C.LayoutID=L.LayoutID where C.ClassID=" & ClassID
    Set tClass = Conn.Execute(sql)
    If tClass.BOF And tClass.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>找不到指定的栏目</li>"
        Call WriteErrMsg
        Response.End
    Else
        If tClass(9) < UserLevel Then
            FoundErr = True
            ErrMsg = ErrMsg & "<br><li>对不起，你没有浏览本栏目的权限！</li>"
            Call WriteErrMsg
            Response.End
        Else
            ClassName = tClass(0)
            RootID = tClass(1)
            ParentID = tClass(2)
            Depth = tClass(3)
            ParentPath = tClass(4)
            Child = tClass(5)
            If ArticleID <= 0 Then
                SkinID = tClass(6)
                LayoutID = tClass(7)
            End If
            LayoutFilename = tClass(8)
            strPath = strPath & "&nbsp;&gt;&gt;&nbsp;"
            strPageTitle = strPageTitle & " >> "
            If ParentID > 0 Then
                Dim sqlPath, rsPath
                sqlPath = "select ArticleClass.ClassID,ArticleClass.ClassName,Layout.LayoutFileName,Layout.LayoutID From ArticleClass"
                sqlPath = sqlPath & " inner join Layout on ArticleClass.LayoutID=Layout.LayoutID where ArticleClass.ClassID in (" & ParentPath & ") order by ArticleClass.Depth"
                Set rsPath = Server.CreateObject("adodb.recordset")
                rsPath.Open sqlPath, Conn, 1, 1
                Do While Not rsPath.EOF
                    strPath = strPath & "<a href='" & rsPath(2) & "?ClassID=" & rsPath(0) & "&LayoutID=" & rsPath(3) & "'>" & rsPath(1) & "</a>&nbsp;&gt;&gt;&nbsp;"
                    strPageTitle = strPageTitle & rsPath(1) & " >> "
                    rsPath.MoveNext
                Loop
                rsPath.Close
                Set rsPath = Nothing
            End If
            strPath = strPath & "<a href='ShowClass.asp?ClassID=" & ClassID & "'>" & ClassName & "</a>"
            strPageTitle = strPageTitle & ClassName
        End If
    End If
End If
If SpecialID > 0 Then
    sql = "select S.SpecialID,S.SpecialName,S.SkinID,S.LayoutID,L.LayoutFileName,S.BrowsePurview from Special S inner join Layout L on L.LayoutID=S.LayoutID where S.SpecialID=" & SpecialID
    Set tSpecial = Conn.Execute(sql)
    If tSpecial.BOF And tSpecial.EOF Then
        FounErr = True
        ErrMsg = ErrMsg & "<br><li>找不到指定的栏目</li>"
        Call WriteErrMsg
        Response.End
    Else
        If tSpecial(5) < UserLevel Then
            FoundErr = True
            ErrMsg = ErrMsg & "<br><li>对不起，你没有浏览本专题的权限！</li>"
            Call WriteErrMsg
            Response.End
        Else
            SpecialName = tSpecial(1)
            If ArticleID <= 0 Then
                SkinID = tSpecial(2)
                LayoutID = tSpecial(3)
            End If
            LayoutFilename = tSpecial(4)
            strPath = strPath & "&nbsp;&gt;&gt;&nbsp;<font color=blue>[专题]</font><a href='" & tSpecial(4) & "?SpecialID=" & tSpecial(0) & "'>" & SpecialName & "</a>"
            strPageTitle = strPageTitle & " >> [专题]" & SpecialName
        End If
    End If
End If
End Sub
'=================================================
'过程名：ShowPath
'作  用：显示“你现在所有位置”导航信息
'参  数：无
'=================================================
Sub ShowPath()
    If PageTitle <> "" Then
        strPath = strPath & "&nbsp;&gt;&gt;&nbsp;" & PageTitle
    End If
    Response.Write strPath
End Sub
'=================================================
'过程名：ShowRootClass_Menu
'作  用：显示一级栏目（下拉菜单效果）
'参  数：无
'=================================================
Sub ShowRootClass_Menu()
    Dim sqlRoot, rsRoot
    sqlRoot = "select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,C.LinkUrl,C.Child From ArticleClass C"
    sqlRoot = sqlRoot & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=0 order by C.RootID"
    Set rsRoot = Server.CreateObject("ADODB.Recordset")
    rsRoot.Open sqlRoot, Conn, 1, 1
    If rsRoot.BOF And rsRoot.EOF Then
        Response.Write ("还没有任何栏目，请首先添加栏目。")
    Else
        If ClassID > 0 Then
            Response.Write "|<a href='" & ChannelUrl & "'>&nbsp;首页&nbsp;</a>|"
        Else
            Response.Write "|<a href='" & ChannelUrl & "'><font color=red>&nbsp;首页&nbsp;</font></a>|"
        End If
        Do While Not rsRoot.EOF
            If rsRoot(4) <> "" Then
                Response.Write "<a href='ShowClass.asp' target='_blank'>&nbsp;" & rsRoot(1) & "&nbsp;</a> | "
            Else
                If rsRoot(5) > 0 Then
                    If rsRoot(2) = RootID Then
                        Response.Write "<a href='ShowClass.asp?ClassID=" & rsRoot(0) & "' onMouseOver='ShowMenu(menu" & rsRoot(2) & ",100)'><font color=red>&nbsp;" & rsRoot(1) & "&nbsp;</font></a>|"
                    Else
                        Response.Write "<a href='ShowClass.asp?ClassID=" & rsRoot(0) & "' onMouseOver='ShowMenu(menu" & rsRoot(2) & ",100)'>&nbsp;" & rsRoot(1) & "&nbsp;</a>|"
                    End If
                Else
                    If rsRoot(2) = RootID Then
                        Response.Write "<a href='ShowClass.asp?ClassID=" & rsRoot(0) & "'><font color=red>&nbsp;" & rsRoot(1) & "&nbsp;</font></a>|"
                    Else
                        Response.Write "<a href='ShowClass.asp?ClassID=" & rsRoot(0) & "'>&nbsp;" & rsRoot(1) & "&nbsp;</a>|"
                    End If
                End If
            End If
            rsRoot.MoveNext
        Loop
    End If
    rsRoot.Close
    Set rsRoot = Nothing
End Sub