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