Lotus中定制搜索

          Sub SearchWeb()
           Dim QryDB As NotesDatabase
           Dim vwDBList As NotesView
           Dim sQueryString As String
           Dim sMinRecord,sMaxRecord,sSortMethod,sTemp,sQry,sOldQry,sSymbol As String
           Dim sSearchFuzzy As String
           Dim sUseCache As String
           Dim sServername As String
           Dim sDbName As String
           Dim sViewName As String
           Dim sPage As String
           Dim sCondition As String
           Dim sDBDocID As String
           Dim sFields As String
           Dim vResult() As Variant
           Dim vTemp,vDBDocList As Variant
           Dim i,j,iRecordNumber As Integer
           
           Set session = New NotesSession
           Set db = session.currentdatabase
           Set doc = session.documentcontext
           sQry = doc.Query_String_Decoded(0)
           sOldQry = sQry
           '-------------------------------- 獲取查詢參數 --------------------------------------
           vTemp = Evaluate("@ReplaceSubstring('"+sQry+"';'+';' ')")
           
           sTemp = vTemp(0)
           sQry = sTemp
           
           i = Instr(sTemp,"^")
           sCondition = Mid(sTemp,i+1) '查詢條件
           
           sDBDocID = Left(sTemp,i-1)
           i = Instr(sDBDocID,"&")
           sDBDocID = Mid(sDBDocID,i+1)'查詢視圖參數
           
           'sSortMethod = Mid(sCondition,Instr(sCondition,"~")+1,1)'排序方式 
           sSearchFuzzy = Mid(sCondition,Instr(sCondition,"!")+1,1)'是否使用模糊查詢
           sUseCache = Mid(sCondition,Instr(sCondition,"$")+1,1)'是否使用Cache
           
           i = Instr(sCondition,"@")
           j = Instr(i+1,sCondition,"@")
           sMinRecord=Val(Mid(sCondition,i+1,j-i-1))'查詢記錄起始數
           sMaxRecord=Val(Mid(sCondition,j+1))'查詢記錄每頁最大結果數
           sCondition = Mid(sCondition,1,i-1)'取得查詢關鍵字 
           
           vDBDocList = Extract(sDBDocID,",") '獲取查詢視圖參數的數組
           
           Call ExtractArray(sCondition) '獲取查詢關鍵字列表
           iRecordNumber = 0
           sPage = ""
           sSymbol = ""
           If sSearchFuzzy = "1" Then
            sSymbol = "*"
           End If
           '------------------------------------------------------------------------------------
           '---------------------------------- 開始查詢 ----------------------------------------
           Forall x In vDBDocList
            vTemp = Extract(Cstr(x),"!")'拆分查詢參數(所在服務器!所在數據庫!查詢視圖)
            
            sServerName=vTemp(0)'查詢數據庫所在服務器
            sDbName=vTemp(1)'查詢數據庫
            sViewName = vTemp(2)'查詢的視圖名
            
            Set QryDB = New NotesDatabase(sServerName,sDbName)'取得查詢數據庫對象
            
            Set view = QryDB.getview(sViewName)'取得查詢數據庫視圖
            sQry=""
            sQueryString = ""
            Forall y In sQryKey
             sQry = Replace(y,"""","''")
             sTemp = ""
             '當指定域查詢時
             If doc.Fields(0) <> "" Then
              Forall z In doc.Fields
               If sTemp = "" Then
                sTemp = "FIELD "+z+{ contains "}+sSymbol+sQry+sSymbol+{"}
               Else
                sTemp = sTemp + " AND FIELD "+z+{ contains "}+sSymbol+sQry+sSymbol+{"}
               End If
              End Forall
              
              If sQueryString = "" Then
               sQueryString = "(" + sTemp +")"
              Else
               sQueryString = sQueryString + " OR (" + sTemp +")"
              End If
             Else'未指定域
              If sQueryString = "" Then
               sQueryString = sQry
              Else
               sQueryString = sQueryString + " AND " + sQry
              End If
             End If
            End Forall
            j = view.FTSearch( sQueryString, Cint(sMaxRecord))'開始查詢
            '將結果形成XML數據
            If j>0 Then
             For i = 1 To j
              iRecordNumber = iRecordNumber + 1
              Set qrydoc = view.getnthdocument(i)
              sPage = sPage + {<row url="javascript:opendoc('/}+QryDB.Replicaid+{/0/}+qrydoc.Universalid+{?opendocument')">}
              sPage = sPage + {<number>}+Cstr(iRecordNumber)+{</number>}
              sPage = sPage + {<title>}+qrydoc.ColumnValues(0)+{</title>}
              sPage = sPage + {<category>}+doc.Name(0)+{</category>}
              sPage = sPage + {<score>}+Cstr(qrydoc.FTSearchScore)+{%</score>}
              sPage = sPage + {</row>}
             Next
            End If
            Call view.clear
           End Forall
           '------------------------------------------------------------------------------------
           '---------------------------------- 輸出結果 ----------------------------------------
           Print {Content-type: text/xml}
           Print {<?xml version='1.0' encoding="utf-8" ?>}
           Print {<view name="查詢結果" id="vgosearchresult.xml">}
           Print {<header>}
           Print { <number>序號</number>}
           Print { <title>標題</title>}
           Print { <category>位置</category>}
           Print { <score>匹配度</score>}
           Print {</header>}
           Print {<action/>}
           Print {<rows>}
           Print sPage
           Print {</rows>}
           Print {</view>}
           '------------------------------------------------------------------------------------
          End Sub

          posted on 2010-04-09 09:21 明高 閱讀(140) 評論(0)  編輯  收藏


          只有注冊用戶登錄后才能發表評論。


          網站導航:
          博客園   IT新聞   Chat2DB   C++博客   博問  
           
          <2010年4月>
          28293031123
          45678910
          11121314151617
          18192021222324
          2526272829301
          2345678

          導航

          統計

          常用鏈接

          留言簿

          隨筆分類

          隨筆檔案

          搜索

          最新評論

          閱讀排行榜

          評論排行榜

          主站蜘蛛池模板: 濉溪县| 厦门市| 新河县| 巴塘县| 英吉沙县| 常山县| 奉节县| 平遥县| 内江市| 定西市| 兰溪市| 贵港市| 太保市| 东城区| 七台河市| 青岛市| 土默特右旗| 宾川县| 开江县| 贵定县| 阿坝县| 永春县| 元氏县| 合水县| 新密市| 赣榆县| 栾城县| 荥经县| 舟山市| 岑溪市| 无为县| 保亭| 漯河市| 萝北县| 峨眉山市| 依兰县| 高安市| 潼关县| 西乌珠穆沁旗| 昌平区| 津南区|