index.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 = "index"
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

End Sub
Private Sub Class_Terminate()
    Power_Terminate
   Set rsArticle = Nothing
   Set rsSpecial = Nothing
   Set rsUser = Nothing
End Sub
Public Property Let MaxP(ByVal vMaxP As Variant)
    MaxPerPage = vMaxP
End Property
Public Property Let SID(ByVal vSID As Variant)
    SkinID = vSID
End Property
Public Property Let PTitle(ByVal vPTitle As Variant)
    PageTitle = vPTitle
End Property
Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)
ClassID = Trim(Request("ClassID"))
strField = Trim(Request("Field"))
keyword = Trim(Request("keyword"))
UserLevel = Request.Cookies("asp163")("UserLevel")

If UserLevel = "" Then
    UserLevel = 5000
Else
    UserLevel = CInt(UserLevel)
End If
If ClassID <> "" Then
    ClassID = CLng(ClassID)
Else
    ClassID = 0
End If
    
If Request("page") <> "" Then
    CurrentPage = CInt(Request("page"))
Else
    CurrentPage = 1
End If
If SpecialID = "" Then
    SpecialID = 0
Else
    SpecialID = CLng(SpecialID)
End If
    
End Sub
Public Sub OnEndPage()
    Conn.Close
    Set Conn = Nothing
End Sub

'=================================================
'过程名：ShowSiteCount
'作  用：显示站点统计信息
'参  数：无
'=================================================
Sub ShowSiteCount()
    Dim sqlCount, rsCount
    Set rsCount = Server.CreateObject("ADODB.Recordset")
    sqlCount = "select count(ArticleID) from Article where Deleted=0"
    rsCount.Open sqlCount, Conn, 1, 1
    Response.Write "文章总数：" & rsCount(0) & "篇<br>"
    rsCount.Close
    sqlCount = "select count(ArticleID) from Article where Passed=0 and Deleted=0"
    rsCount.Open sqlCount, Conn, 1, 1
    Response.Write "待审文章：" & rsCount(0) & "篇<br>"
    rsCount.Close
    sqlCount = "select count(CommentID) from Comment"
    rsCount.Open sqlCount, Conn, 1, 1
    Response.Write "评论总数：" & rsCount(0) & "条<br>"
    rsCount.Close
    sqlCount = "select count(SpecialID) from Special"
    rsCount.Open sqlCount, Conn, 1, 1
    Response.Write "专题总数：" & rsCount(0) & "个<br>"
    rsCount.Close
    sqlCount = "select count(UserID) from [User]"
    rsCount.Open sqlCount, Conn, 1, 1
    Response.Write "注册用户：" & rsCount(0) & "名<br>"
    rsCount.Close
    sqlCount = "select sum(Hits) from article"
    rsCount.Open sqlCount, Conn, 1, 1
    Response.Write "文章阅读：" & rsCount(0) & "人次<br>"
    rsCount.Close
    Set rsCount = Nothing
End Sub
'=================================================
'过程名：ShowTopUser
'作  用：显示用户排行，按已发表的文章数排序，若相等，再按注册先后顺序排序
'参  数：UserNum-------显示的用户个数
'=================================================
Sub ShowTopUser(UserNum)
    If UserNum <= 0 Or UserNum > 100 Then UserNum = 10
    Dim sqlTopUser, rsTopUser, i
    sqlTopUser = "select top " & UserNum & " * from [User] order by ArticleChecked desc,UserID asc"
    Set rsTopUser = Server.CreateObject("adodb.recordset")
    rsTopUser.Open sqlTopUser, Conn, 1, 1
    If rsTopUser.BOF And rsTopUser.EOF Then
        Response.Write "没有任何用户"
    Else
        Response.Write "<table  border='0' cellspacing='0' cellpadding='0'><tr><td align='left'>名次</td><td width='40%' align='center'>用户名</td><td align='right'>文章数</td></tr>"
        For i = 1 To rsTopUser.RecordCount
            Response.Write "<tr><td align='center'>" & CStr(i) & "</td><td align='left'><a href='ShowUserInfo.asp?UserID=" & rsTopUser("UserID") & "'>" & rsTopUser("UserName") & "</a></td><td align='right'>" & rsTopUser("ArticleChecked") & "</td></tr>"
            rsTopUser.MoveNext
        Next
        Response.Write "</table><br><a href='ShowUser.asp'>More……</a>"
    End If
    Set rsTopUser = Nothing
End Sub
'=================================================
'过程名：ShowVote
'作  用：显示网站调查
'参  数：无
'=================================================
Sub ShowVote()
    Dim sqlVote, rsVote, i
    sqlVote = "select top 1 * from Vote where IsSelected=1"
    Set rsVote = Server.CreateObject("ADODB.Recordset")
    rsVote.Open sqlVote, Conn, 1, 1
    If rsVote.BOF And rsVote.EOF Then
        Response.Write "&nbsp;没有任何调查"
    Else
        Response.Write "<form name='VoteForm' method='post' action='vote.asp' target='_blank'>"
        Response.Write "&nbsp;&nbsp;&nbsp;&nbsp;" & rsVote("Title") & "<br>"
        If rsVote("VoteType") = "Single" Then
            For i = 1 To 8
                If Trim(rsVote("Select" & i) & "") = "" Then Exit For
                Response.Write "<input type='radio' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
            Next
        Else
            For i = 1 To 8
                If Trim(rsVote("Select" & i) & "") = "" Then Exit For
                Response.Write "<input type='checkbox' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
            Next
        End If
        Response.Write "<br><input name='VoteType' type='hidden'value='" & rsVote("VoteType") & "'>"
        Response.Write "<input name='Action' type='hidden' value='Vote'>"
        Response.Write "<input name='ID' type='hidden' value='" & rsVote("ID") & "'>"
        Response.Write "<div align='center'>"
        Response.Write "<a href='javascript:VoteForm.submit();'><img src='images/voteSubmit.gif' width='52' height='18' border='0'></a>&nbsp;&nbsp;"
        Response.Write "<a href='Vote.asp?ID=" & rsVote("ID") & "&Action=Show' target='_blank'><img src='images/voteView.gif' width='52' height='18' border='0'></a>"
        Response.Write "</div></form>"
    End If
    rsVote.Close
    Set rsVote = Nothing
End Sub
'=================================================
'过程名：ShowAnnounce
'作  用：显示本站公告信息
'参  数：ShowType ------显示方式，1为纵向，2为横向
'        AnnounceNum  ----最多显示多少条公告
'=================================================
Sub ShowAnnounce(ShowType, AnnounceNum)
    Dim sqlAnnounce, rsAnnounce, i
    If AnnounceNum > 0 And AnnounceNum <= 10 Then
        sqlAnnounce = "select top " & AnnounceNum
    Else
        sqlAnnounce = "select top 10"
    End If
    sqlAnnounce = sqlAnnounce & " * from Announce where IsSelected=1 order by ID Desc"
    Set rsAnnounce = Server.CreateObject("ADODB.Recordset")
    rsAnnounce.Open sqlAnnounce, Conn, 1, 1
    If rsAnnounce.BOF And rsAnnounce.EOF Then
        AnnounceCount = 0
        Response.Write "<p>&nbsp;&nbsp;没有通告</p>"
    Else
        AnnounceCount = rsAnnounce.RecordCount
        If ShowType = 1 Then
            Do While Not rsAnnounce.EOF
                Response.Write "<a href='Announce.asp?ID=" & rsAnnounce("id") & "' title='" & rsAnnounce("Content") & "' target=_Blank>&nbsp;&nbsp;&nbsp;&nbsp;" & rsAnnounce("title") & "</div><br><div align='right'>" & rsAnnounce("Author") & "&nbsp;&nbsp;<br>" & FormatDateTime(rsAnnounce("DateAndTime"), 1) & "</a>"
                rsAnnounce.MoveNext
                i = i + 1
                If i < AnnounceCount Then Response.Write "<hr>"
            Loop
        Else
            Do While Not rsAnnounce.EOF
                Response.Write "<a href='Announce.asp?ID=" & rsAnnounce("id") & "' title='" & rsAnnounce("Content") & "' target=_Blank>&nbsp;&nbsp;&nbsp;&nbsp;" & rsAnnounce("title") & "&nbsp;&nbsp;[" & rsAnnounce("Author") & "&nbsp;&nbsp;" & FormatDateTime(rsAnnounce("DateAndTime"), 1) & "]</a>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
                rsAnnounce.MoveNext
            Loop
        End If
    End If
    rsAnnounce.Close
    Set rsAnnounce = Nothing
End Sub

'=================================================
'过程名：ShowPicArticle
'作  用：显示图片文章
'参  数：intClassID  ----栏目ID，0为所有栏目，若大于0，则显示指定栏目及其子栏目的图片文章
'        ArticleNum  ----最多显示多少篇文章
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'        ShowType   ----显示方式。1为只有图片+标题，2为图片+标题+内容简介
'        Cols       ----列数。超过此列数就换行。
'        ImgWidth   ----图片宽度
'        ImgHeight  ----图片高度
'        ContentLen ----内容最多字符数
'        Hot        ----是否是热门文章
'        Elite      ----是否是推荐文章
'=================================================
Sub ShowPicArticle(intClassID, ArticleNum, TitleLen, ShowType, Cols, ImgWidth, ImgHeight, ContentLen, Hot, Elite)
    Dim sqlPic, i, tClass, trs, arrClassID
    If ArticleNum < 0 Or ArticleNum >= 50 Then
        ArticleNum = 5
    End If
    If ShowType <> 1 And ShowType <> 2 Then
        ShowType = 1
    End If
    If Cols <= 0 Or Cols >= 10 Then
        Cols = 5
    End If
    If ImgWidth < 0 Or ImgWidth > 500 Then
        ImgWidth = 150
    End If
    If ImgHeight < 0 Or ImgHeight > 500 Then
        ImgHeight = 150
    End If
    If Hot <> True And Hot <> False Then
        Hot = False
    End If
    If Elite <> True And Elite <> False Then
        Elite = False
    End If
    sqlPic = "select top " & ArticleNum
    sqlPic = sqlPic & " A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.[Key],A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
    If ShowType = 2 Then
        sqlPic = sqlPic & "A.Content,"
    End If
    sqlPic = sqlPic & " A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl from Article A"
    sqlPic = sqlPic & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=0 and A.Passed=1 and DefaultPicUrl<>''"
    If intClassID > 0 Then
        Set tClass = Conn.Execute("select ClassID,Child,ParentPath from ArticleClass where ClassID=" & intClassID)
        If Not (tClass.BOF And tClass.EOF) Then
            If tClass(1) > 0 Then
                arrClassID = ClassID
                Set trs = Conn.Execute("select ClassID from ArticleClass where ParentID=" & tClass(0) & " or ParentPath like '%" & tClass(2) & "," & tClass(0) & ",%' and Child=0 and LinkUrl=''")
                Do While Not trs.EOF
                    arrClassID = arrClassID & "," & trs(0)
                    trs.MoveNext
                Loop
                Set trs = Nothing
                sqlPic = sqlPic & " and A.ClassID in (" & arrClassID & ")"
            Else
                sqlPic = sqlPic & " and A.ClassID=" & tClass(0)
            End If
            Set trs = Nothing
        Else
            sqlPic = sqlPic & " and A.ClassID=" & tClass(0)
        End If
        Set tClass = Nothing
    End If
    If Hot = True Then
        sqlPic = sqlPic & " and A.Hits>=" & HitsOfHot
    End If
    If Elite = True Then
        sqlPic = sqlPic & " and A.Elite=1 "
    End If
    sqlPic = sqlPic & " order by A.OnTop,A.ArticleID desc"
    Set rsPic = Server.CreateObject("ADODB.Recordset")