search.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 = "Search"
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 Sub OnStartPage(PassedScriptingContext As ScriptingContext)
ClassID = Trim(Request("ClassID"))
strField = Trim(Request("Field"))
keyword = Trim(Request("keyword"))
UserLevel = Request.Cookies("asp163")("UserLevel")

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

Public Function ShowSearchResult(totalPut, MaxPerPage)
    Dim arrClassID, trs
    sqlSearch = sqlSearch & "select A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.[Key],A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,A.Content,"
    sqlSearch = sqlSearch & "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"
    sqlSearch = sqlSearch & " inner join Layout L on A.LayoutID=L.LayoutID where "
    
     sqlSearch = sqlSearch & "A.Deleted=0 and A.Passed=1"
  
    If ClassID > 0 Then
        If Child > 0 Then
            arrClassID = ClassID
            If ParentID > 0 Then
                Set trs = Conn.Execute("select ClassID from ArticleClass where ParentID=" & ClassID & " or ParentPath like '%" & ParentPath & "," & ClassID & ",%' and Child=0 and LinkUrl='' and BrowsePurview>=" & UserLevel)
            Else
                Set trs = Conn.Execute("select ClassID from ArticleClass where RootID=" & RootID & " and Child=0 and LinkUrl='' and BrowsePurview>=" & UserLevel)
            End If
            Do While Not trs.EOF
                arrClassID = arrClassID & "," & trs(0)
                trs.MoveNext
            Loop
            Set trs = Nothing
            sqlSearch = sqlSearch & " and A.ClassID in (" & arrClassID & ")"
        Else
            sqlSearch = sqlSearch & " and A.ClassID=" & ClassID
        End If
    End If
    If keyword <> "" Then
    Call keywordlike(strField)  '调用SQL字串对多字搜索加条件
    End If
    
    sqlSearch = sqlSearch & " order by A.Articleid desc"
    Response.Write sqlSearch
On Error Resume Next
    Set rsSearch = Server.CreateObject("ADODB.Recordset")
    rsSearch.Open sqlSearch, Conn, 1, 1

    If rsSearch.EOF And rsSearch.BOF Then
        totalPut = 0
        Response.Write "<p align='center'><br><br>没有或没有找到任何文章</p>"
    Else
        totalPut = rsSearch.RecordCount
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If
        If CurrentPage = 1 Then
            Call SearchResultContent(MaxPerPage)
        Else
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                rsSearch.Move (CurrentPage - 1) * MaxPerPage
                Dim bookmark
                bookmark = rsSearch.bookmark
                Call SearchResultContent(MaxPerPage)
            Else
                CurrentPage = 1
                Call SearchResultContent(MaxPerPage)
            End If
        End If
    End If
    rsSearch.Close
    Set rsSearch = Nothing
End Function
Public Function SearchResultContent(MaxPerPage)
    Dim i, strTemp, content
    i = 1
    Do While Not rsSearch.EOF
        strTemp = ""
        strTemp = strTemp & CStr(MaxPerPage * (CurrentPage - 1) + i) & ".<a href='ShowArticle.asp?ArticleID=" & rsSearch("articleid") & "'>"
    '搜索标题
    If strField = "Title" Then
        Searchtitle = nohtml(rsSearch("title"))
        Call colokey(Searchtitle, keyword)
        strTemp = strTemp & "<b>" & Searchtitle & "</b>"
        Else
            strTemp = strTemp & "<b>" & rsSearch("title") & "</b>"
        End If

    '搜索作者
    If strField = "Author" Then
           SearchAuthor = nohtml(rsSearch("Author"))
               Call colokey(SearchAuthor, keyword)
        strTemp = strTemp & "&nbsp;[" & SearchAuthor & "]"
        Else
            strTemp = strTemp & "&nbsp;[" & rsSearch("Author") & "]"
        End If
        strTemp = strTemp & "[" & FormatDateTime(rsSearch("UpdateTime"), 1) & "][" & rsSearch("Hits") & "]"
    '搜索内容
       content = Left$(nohtml(rsSearch("content")), 200)
    If strField = "Content" Then
        Call colokey(content, keyword)
        strTemp = strTemp & "<div style='padding:10px 20px;' >" & content & "……</div>"
        Else
            strTemp = strTemp & "<div style='padding:10px 20px'>" & content & "……</div>"
        End If
        strTemp = strTemp & "</a>"
        Response.Write strTemp
        i = i + 1
        If i > MaxPerPage Then Exit Do
        rsSearch.MoveNext
    Loop
End Function

Private Sub keywordlike(strField)
Dim keywordtmp, max, i, allkeyword
keywordtmp = Split(keyword, " ") '将输入的字符串根据空格分开，获得一个数组
max = UBound(keywordtmp) '得出这个数组的维数，即输入的关键字个数
 For i = 0 To max
    If i = 0 Then
          allkeyword = " A." & strField & " like '%" & keywordtmp(i) & "%'"
      Else
      If i = max Then
           allkeyword = allkeyword
          Else
          allkeyword = allkeyword & "and A." & strField & " like '%" & keywordtmp(i) & "%'"
     End If
  End If
 Next
   
 sqlSearch = sqlSearch & " and " & allkeyword
 End Sub
Private Sub colokey(strField, keyword)
Dim reskey, allkey, i
reskey = Split(keyword, " ")
max = UBound(reskey) + 1

For i = 0 To max
      If i = max Then
            allkey = allkey
            Else
            allkey = Replace(strField, "" & reskey(i) & "", "<font style='glow(color=#3333ff,strength=2)' color=red>" & reskey(i) & "</font>")
            strField = allkey
     End If
 Next
End Sub
Public Sub ShowSearchForm(Action, ShowType)
    If ShowType <> 1 And ShowType <> 2 And ShowType <> 3 Then
        ShowType = 1
    End If
    Response.Write "<table border='0' cellpadding='0' cellspacing='0'>"
    Response.Write "<form method='Get' name='SearchForm' action='" & Action & "'>"
    Response.Write "<tr><td height='28' align='center'>"
    If ShowType = 1 Then
        Response.Write "<input type='text' name='keyword'  size='15' value='关键字' maxlength='50' onFocus='this.select();'>&nbsp;"
        Response.Write "<input type='hidden' name='field' value='Title'>"
        Response.Write "<input type='submit' name='Submit'  value='搜索'>"
        'response.write "<br><br>高级搜索"
    ElseIf ShowType = 2 Then
        Response.Write "<select name='Field' size='1'>"
        Response.Write "<option value='Title' selected>文章标题</option>"
        Response.Write "<option value='Content'>文章内容</option>"
        Response.Write "<option value='Author'>文章作者</option>"
        Response.Write "<option value='Editor'>编辑姓名</option>"
        Response.Write "</select>&nbsp;"
        Response.Write "<select name='ClassID'><option value=''>所有栏目</option>"
        Call Admin_ShowClass_Option(1, 0) '-----------这里开始调用
        Response.Write "</select>&nbsp;<input type='text' name='keyword'  size='20' value='关键字' maxlength='50' onFocus='this.select();'>&nbsp;"
        Response.Write "<input type='submit' name='Submit'  value=' 搜索 '>"
    ElseIf ShowType = 3 Then
    
    End If
    Response.Write "</td></tr></form></table>"
End Sub