show.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 = "show"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)
    Set ScriptingContext = PassedScriptingContext
    Set Application = ScriptingContext.Application
    Set Request = ScriptingContext.Request
    Set Response = ScriptingContext.Response
    Set Server = ScriptingContext.Server
    Set Session = ScriptingContext.Session
    'Set Response = objContext.Item("Response")
    
End Sub
Public Sub OnEndPage()
    Conn.Close
    Set Conn = Nothing
    Set ScriptingContext = Nothing
    Set Application = Nothing
    Set Request = Nothing
    Set Response = Nothing
    Set Server = Nothing
    Set Session = Nothing
End Sub
'=================================================
'过程名：ShowHot
'作  用：显示热门文章
'参  数：ArticleNum  ----最多显示多少篇文章
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
Sub ShowHot(ArticleNum, TitleLen)
    Dim sqlHot, rsHot
    If ArticleNum > 0 And ArticleNum <= 7 Then
        sqlHot = "select top " & ArticleNum
    Else
        sqlHot = "select top 7 "
    End If
    sqlHot = sqlHot & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=0 and A.Passed=1 And A.Hits>=" & HitsOfHot & " order by A.ArticleID desc"
    Set rsHot = Server.CreateObject("ADODB.Recordset")
    rsHot.Open sqlHot, Conn, 1, 1
    If TitleLen < 0 Or TitleLen > 255 Then TitleLen = 50
    If rsHot.BOF And rsHot.EOF Then
        Response.Write "<li>无热门文章</li>"
    Else
        Do While Not rsHot.EOF
            Response.Write "<tr class='listbg'><td width='10'><img src='Images/article_elite.gif'>&nbsp;</td><td><a href='ShowArticle.asp?ArticleID=" & rsHot("articleid") & "' title='文章标题：" & rsHot("Title") & vbCrLf & "作    者：" & rsHot("Author") & vbCrLf & "更新时间：" & rsHot("UpdateTime") & vbCrLf & "点击次数：" & rsHot("Hits") & "' target='_blank'>" & gotTopic(rsHot("title"), TitleLen) & "</a>[<font color=red>" & rsHot("hits") & "</font>]</td></tr>"
            rsHot.MoveNext
        Loop
    End If
    rsHot.Close
    Set rsHot = Nothing
End Sub
'=================================================
'过程名：ShowElite
'作  用：显示推荐文章
'参  数：ArticleNum  ----最多显示多少篇文章
'        TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
Sub ShowElite(ArticleNum, TitleLen)
    Dim sqlElite, rsElite
    If ArticleNum > 0 And ArticleNum <= 100 Then
        sqlElite = "select top " & ArticleNum
    Else
        sqlElite = "select top 10"
    End If
    sqlElite = sqlElite & " A.ArticleID,A.Title,A.Author,A.UpdateTime,A.Hits,L.LayoutFileName from article A inner join Layout L on L.LayoutID=A.LayoutID where A.Deleted=0 and A.Passed=1 And A.Elite=1 order by A.articleid desc"
    Set rsElite = Server.CreateObject("ADODB.Recordset")
    rsElite.Open sqlElite, Conn, 1, 1
    If TitleLen < 0 Or TitleLen > 255 Then TitleLen = 50
    If rsElite.BOF And rsElite.EOF Then
        Response.Write "<li>无推荐文章</li>"
    Else
        Do While Not rsElite.EOF
            Response.Write "<tr class='listbg'><td width='10'><img  src='Images/article_elite.gif'>&nbsp;</td><td><a href='ShowArticle.asp?ArticleID=" & rsElite("articleid") & "' title='文章标题：" & rsElite("Title") & vbCrLf & "作    者：" & rsElite("Author") & vbCrLf & "更新时间：" & rsElite("UpdateTime") & vbCrLf & "点击次数：" & rsElite("Hits") & "' target='_blank'>" & gotTopic(rsElite("title"), TitleLen) & "</a>[<font color=red>" & rsElite("hits") & "</font>]</td></tr>"
            rsElite.MoveNext
        Loop
    End If
    rsElite.Close
    Set rsElite = Nothing
End Sub
'*************************************************
'函数名：gotTopic
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'*************************************************
Function gotTopic(str, strlen)
    If str = "" Then
        gotTopic = ""
        Exit Function
    End If
    Dim l, t, c, i
    str = Replace(Replace(Replace(Replace(str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
    l = Len(str)
    t = 0
    For i = 1 To l
        c = Abs(Asc(Mid(str, i, 1)))
        If c > 255 Then
            t = t + 2
        Else
            t = t + 1
        End If
        If t >= strlen Then
            gotTopic = Left(str, i) & "…"
            Exit For
        Else
            gotTopic = str
        End If
    Next
    gotTopic = Replace(Replace(Replace(Replace(gotTopic, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
End Function