Gestion des index

[Michael DELIQUE]

Code : Tout sélectionner

Public Function FTIndexGetInfo_API(wServer As String, wPathFile As String) As Variant
   
   Dim Index As FTINDEX
   Dim BID As BLOCKID
   Dim TDate As TimeDate
   Dim lstRetour List As String
   Dim nmServer As NotesName   
   Dim nbHandleLock As Long
   Dim nbReturn As Integer
   Dim nbIDX As Integer
   Dim nbOPT As Integer
   Dim nbFRQ As Integer
   Dim fullPath As String
   Dim nbHandleDB As Long
   Dim LastIndexedOn As String
   
   Const ERR_MASK = &H3FFF
   
   %REM
Type BLOCKID
hPool As Long
Block As Integer
End Type

Type TIMEDATE
      Innards(1) As Long
End Type

Type FTINDEX
Indexed As Integer 'Create index true / false
IndexAttachments As Integer 'Index attachments true / false
IndexAttachmentsFormat As Integer 'Index format true = raw text only, false = binary
EncryptedFields As Integer 'index encrypted fields true / false
IndexBreaks As Integer 'index sentence and paragraph breaks true /false
CaseSensitive As Integer 'case sensitive index true / false
UpdateFrequency As Integer 'update frequency : 0 = Daily | 1 = Scheduled | 2 = Hourly | 3 = Immediate
LastIndexedOn As String 'last index date/time
End Type

Declare Function W32_OSPathNetConstruct Lib "nnotes.dll" Alias "OSPathNetConstruct"(ByVal portName As Integer, ByVal serverName As String, ByVal fileName As String,ByVal pathName As String) As Integer
Declare Function W32_NSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen"(ByVal dbName As String, hDb As Long) As Integer
Declare Function NSFDbGetExtendedInfo Lib "nnotes.dll" Alias "NSFDbGetExtendedInfo" (ByVal hDB As Long, hB As BLOCKID) As Integer
Declare Function W32_NSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" (ByVal hDb As Long) As Integer
Declare Private Function OSLockObject Lib "nnotes.dll" Alias "OSLockObject" (ByVal hM As Long) As Long
Declare Private Sub Peek Lib "MSVCRT" Alias "memcpy" (D As Any, ByVal P As Long, ByVal N As Long)
Declare Private Sub OSUnlockObject Lib "nnotes.dll" Alias "OSUnlockObject" (ByVal hM As Long)
Declare Private Function FTGetLastIndexTime Lib "nnotes.dll" Alias "FTGetLastIndexTime" (ByVal hDB As Long, T As TIMEDATE) As Integer
Declare Function ConvertTIMEDATEToText Lib "nnotes.dll" Alias "ConvertTIMEDATEToText" (ByVal zI As Long, ByVal zT As Long, T As TIMEDATE, ByVal S As String, ByVal nS As Integer, nT As Integer) As Integer
   %END REM
   
   On Error GoTo CatchError

   
   lstRetour("SERVER") = ""
   lstRetour("PATHFILE") = ""
   lstRetour("INDEXED") = ""
   lstRetour("INDEXEDLABEL") = ""
   lstRetour("INDEXATTACHMENTS") = ""
   lstRetour("INDEXATTACHMENTSLABEL") = ""
   lstRetour("INDEXATTACHMENTSFORMAT") = ""
   lstRetour("INDEXATTACHMENTSFORMATLABEL") = ""
   lstRetour("ENCRYPTEDFIELDS") = ""
   lstRetour("ENCRYPTEDFIELDSLABEL") = ""
   lstRetour("INDEXBREAKS") = ""
   lstRetour("INDEXBREAKSLABEL") = ""
   lstRetour("CASESENSITIVE") = ""
   lstRetour("CASESENSITIVELABEL") = ""
   lstRetour("UPDATEFREQUENCY") = ""
   lstRetour("UPDATEFREQUENCYLABEL") = ""
   lstRetour("LASTINDEXEDON") = ""
   
   FTIndexGetInfo_API = lstRetour
   
   If Trim(wPathFile) = "" Then
      Error 9999,"wPathFile is Empty"
      Exit Function
   End If
   
   If Trim(wServer) <> "" Then
      Set nmServer = New NotesName(Trim(wServer))
      lstRetour("SERVER") = nmServer.abbreviated
      Set nmServer = Nothing
   End If
   lstRetour("PATHFILE") = Trim(wPathFile)
   
   fullPath = String(1024, " ")
   Call W32_OSPathNetConstruct(0, lstRetour("SERVER"),Trim(wPathFile), fullPath)
   nbReturn = W32_NSFDbOpen(fullPath, nbHandleDB)
   If nbReturn <> 0 Then      
      Error 9999,"Couldn't open database ("+lstRetour("SERVER")+"!!"+Trim(wPathFile)+")"
      Exit Function
   End If
   
   If nbHandleDB = 0 Then
      Error 9999,"Couldn't open database ("+lstRetour("SERVER")+"!!"+Trim(wPathFile)+")"
      Exit Function
   End If
   
   nbReturn = NSFDbGetExtendedInfo (nbHandleDB, BID)
   If nbReturn And ERR_MASK = 0 Then
      Error 9999,"Can not get extended info form database ("+lstRetour("SERVER")+"!!"+Trim(wPathFile)+")"
      Exit Function
   End If
   
   If BID.hPool = 0 Then
      nbReturn = W32_NSFDbClose(nbHandleDB)
      If nbReturn <> 0 Then      
         Error 9999,"Couldn't close database ("+lstRetour("SERVER")+"!!"+Trim(wPathFile)+")"
         Exit Function
      End If
   End If
   nbHandleLock = OSLockObject(BID.hPool) + BID.Block
   Call Peek(nbIDX, nbHandleLock + 2, 2)
   Call Peek(nbOPT, nbHandleLock + 6, 2)
   Call Peek(nbFRQ, nbHandleLock + 8, 2)
   Call OSUnlockObject(BID.hPool)
   
   Call FTGetLastIndexTime(nbHandleDB, TDate)
   If Not TDate.Innards(0) = 0 Then
      LastIndexedOn = Space(256)
      Call ConvertTIMEDATEToText(0, 0, Tdate, LastIndexedOn, 256, nbFRQ)
      LastIndexedOn = Left$(LastIndexedOn, nbFRQ)      
   End If
   nbFRQ = 0
   
   nbReturn = W32_NSFDbClose(nbHandleDB)
   If nbReturn <> 0 Then      
      Error 9999,"Couldn't close database : "+Trim(wServer)+":"+Trim(wPathFile)
      Exit Function
   End If
   
   REM Check if database is indexed
   If nbIDX = 0 Then
      Index.Indexed="0"
      lstRetour("INDEXED") = CStr(False)
      lstRetour("INDEXEDLABEL") = "False"
   Else
      lstRetour("INDEXED") = CStr(True)
      lstRetour("INDEXEDLABEL") = "True"
      lstRetour("LASTINDEXEDON") = LastIndexedOn
   End If
   
   If (nbOPT And &H20) Then
      lstRetour("INDEXATTACHMENTS") = CStr(True)
      lstRetour("INDEXATTACHMENTSLABEL") = "True"
   Else
      Index.IndexAttachments="0"
      lstRetour("INDEXATTACHMENTS") = CStr(False)
      lstRetour("INDEXATTACHMENTSLABEL") = "False"
   End If
   
   If (nbOPT And &H80) Then
      lstRetour("INDEXATTACHMENTSFORMAT") = CStr(True)
      lstRetour("INDEXATTACHMENTSFORMATLABEL") = "True"
   Else
      lstRetour("INDEXATTACHMENTSFORMAT") = CStr(False)
      lstRetour("INDEXATTACHMENTSFORMATLABEL") = "False"
   End If
   
   If (nbOPT And &H40) Then      
      lstRetour("ENCRYPTEDFIELDS") = CStr(True)
      lstRetour("ENCRYPTEDFIELDSLABEL") = "True"      
   Else
      lstRetour("ENCRYPTEDFIELDS") = CStr(False)
      lstRetour("ENCRYPTEDFIELDSLABEL") = "False"
   End If
   
   If (nbOPT And &H10) Then
      lstRetour("INDEXBREAKS") = CStr(True)
      lstRetour("INDEXBREAKSLABEL") = "True"      
   Else
      lstRetour("INDEXBREAKS") = CStr(False)
      lstRetour("INDEXBREAKSLABEL") = "False"
   End If
   
   If (nbOPT And &H02) Then      
      lstRetour("CASESENSITIVE") = CStr(True)
      lstRetour("CASESENSITIVELABEL") = "True"
   Else      
      lstRetour("CASESENSITIVE") = CStr(False)
      lstRetour("CASESENSITIVELABEL") = "False"
   End If
   
   lstRetour("UPDATEFREQUENCY") = CStr(nbFRQ)
   Select Case nbFRQ
      Case 0
         lstRetour("UPDATEFREQUENCYLABEL") = "Daily"
      Case 1
         lstRetour("UPDATEFREQUENCYLABEL") = "Scheduled"
      Case 2
         lstRetour("UPDATEFREQUENCYLABEL") = "Hourly"
      Case 3
         lstRetour("UPDATEFREQUENCYLABEL") = "Immediate"
      Case Else
         lstRetour("UPDATEFREQUENCYLABEL") = "Wrong value"
   End Select
   
   FTIndexGetInfo_API = lstRetour
   Erase lstRetour
   
   Exit Function
CatchError:
   MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   If nbHandleDB <> 0 Then
      nbReturn = W32_NSFDbClose(nbHandleDB)   
   End If   
   Erase lstRetour
   lstRetour("SERVER") = "ERROR"
   lstRetour("PATHFILE") = CStr(Error)+ " ("+CStr(Err)+")"
   lstRetour("INDEXED") = "ERROR"
   lstRetour("INDEXEDLABEL") = "ERROR"
   lstRetour("INDEXATTACHMENTS") = "ERROR"
   lstRetour("INDEXATTACHMENTSLABEL") = "ERROR"
   lstRetour("INDEXATTACHMENTSFORMAT") = "ERROR"
   lstRetour("INDEXATTACHMENTSFORMATLABEL") = "ERROR"
   lstRetour("ENCRYPTEDFIELDS") = "ERROR"
   lstRetour("ENCRYPTEDFIELDSLABEL") = "ERROR"
   lstRetour("INDEXBREAKS") = "ERROR"
   lstRetour("INDEXBREAKSLABEL") = "ERROR"
   lstRetour("CASESENSITIVE") = "ERROR"
   lstRetour("CASESENSITIVELABEL") = "ERROR"
   lstRetour("UPDATEFREQUENCY") = "ERROR"
   lstRetour("UPDATEFREQUENCYLABEL") = "ERROR"
   lstRetour("LASTINDEXEDON") = "ERROR"   
   FTIndexGetInfo_API = lstRetour
   Erase lstRetour
   Exit Function
End Function

Public Function FTIndexSetInfo_API(wlstParam List As String)As Boolean
   
   REM in agent need security level 3
   REM forcreate index on not indexed db run updall with -X and database must be have a document
   
   Dim BID As BLOCKID
   Dim nmServer As NotesName
   Dim lstParam List As Integer
   Dim fullPath As String
   Dim nbHandleLock As Long
   Dim nbHandleDB As Long
   Dim nbReturn As Integer
   Dim nbIDX As Integer
   Dim nbOPT As Integer
   Dim nbFRQ As Integer
   Dim StrError As String
   
   Const ERR_MASK = &H3FFF
   REM Enable full text indexing
   Const DBOPTION_FT_INDEX = &H00000001
   
   %REM
      Type BLOCKID
hPool As Long
Block As Integer
End Type

Declare Function W32_OSPathNetConstruct Lib "nnotes.dll" Alias "OSPathNetConstruct"(ByVal portName As Integer, ByVal serverName As String, ByVal fileName As String,ByVal pathName As String) As Integer
Declare Function W32_NSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen"(ByVal dbName As String, hDb As Long) As Integer
Declare Function W32_NSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" (ByVal hDb As Long) As Integer
Declare Function NSFDbSetOptions Lib "nnotes.dll" Alias "NSFDbSetOptions" (ByVal hDB As Long, ByVal dboptions As Long, ByVal optionmask As Long ) As Integer
Declare Function NSFDbGetExtendedInfo Lib "nnotes.dll" Alias "NSFDbGetExtendedInfo" (ByVal hDB As Long, hB As BLOCKID) As Integer
Declare Function NSFDbSetExtendedInfo Lib "nnotes.dll" Alias "NSFDbSetExtendedInfo" (ByVal hDB As Long, ByVal hB As Long) As Integer
Declare Private Sub Poke Lib "MSVCRT" Alias "memcpy" (ByVal D As Long, D As Any, ByVal N As Long)
Declare Private Function OSLockObject Lib "nnotes.dll" Alias "OSLockObject" (ByVal hM As Long) As Long
Declare Private Sub OSUnlockObject Lib "nnotes.dll" Alias "OSUnlockObject" (ByVal hM As Long)
   %END REM
   
   On Error GoTo CatchError

   FTIndexSetInfo_API = False
   
   If Trim(wlstParam("SERVER")) <> "" Then
      Set nmServer = New NotesName(Trim(wlstParam("SERVER")))
      wlstParam("SERVER") = nmServer.Abbreviated
      Set nmServer = Nothing
   End If
   
   If IsElement(wlstParam("PATHFILE")) = False Then
      Error 9999,"PATHFILE value is not defined"
   End If
   If Trim(wlstParam("PATHFILE")) = "" Then
      Error 9999,"PATHFILE value is Empty"
   End If
   
   lstParam("INDEXED") = False
   If IsElement(wlstParam("INDEXED")) = True Then
      Select Case UCase(Trim(wlstParam("INDEXED")))
      Case "Y","YES","T","TRUE",CStr(True)
         lstParam("INDEXED") = True
      Case "N","NO","F","FALSE","D","DEFAULT","",CStr(False)
         lstParam("INDEXED") = False
      Case Else
         Error 9999,"INDEXED, wrong value : "+Trim(wlstParam("INDEXED"))
   End Select
   End If
   
   lstParam("INDEXATTACHMENTS") = False
   If IsElement(wlstParam("INDEXATTACHMENTS")) = True Then
      Select Case UCase(Trim(wlstParam("INDEXATTACHMENTS")))
      Case "Y","YES","T","TRUE",CStr(True)
         lstParam("INDEXATTACHMENTS") = True
      Case "N","NO","F","FALSE","D","DEFAULT","",CStr(False)
         lstParam("INDEXATTACHMENTS") = False
      Case Else
         Error 9999,"INDEXATTACHMENTS, wrong value : "+Trim(wlstParam("INDEXATTACHMENTS"))
   End Select
   End If

   lstParam("INDEXATTACHMENTSFORMAT") = False
   If IsElement(wlstParam("INDEXATTACHMENTSFORMAT")) = True Then
      Select Case UCase(Trim(wlstParam("INDEXATTACHMENTSFORMAT")))
      Case "Y","YES","T","TRUE",CStr(True)
         lstParam("INDEXATTACHMENTSFORMAT") = True
      Case "N","NO","F","FALSE","D","DEFAULT","",CStr(False)
         lstParam("INDEXATTACHMENTSFORMAT") = False
      Case Else
         Error 9999,"INDEXATTACHMENTSFORMAT, wrong value : "+Trim(wlstParam("INDEXATTACHMENTSFORMAT"))
   End Select
   End If
   
   lstParam("ENCRYPTEDFIELDS") = False
   If IsElement(wlstParam("ENCRYPTEDFIELDS")) = True Then
      Select Case UCase(Trim(wlstParam("ENCRYPTEDFIELDS")))
      Case "Y","YES","T","TRUE",CStr(True)
         lstParam("ENCRYPTEDFIELDS") = True
      Case "N","NO","F","FALSE","D","DEFAULT","",CStr(False)
         lstParam("ENCRYPTEDFIELDS") = False
      Case Else
         Error 9999,"ENCRYPTEDFIELDS, wrong value : "+Trim(wlstParam("ENCRYPTEDFIELDS"))
   End Select
   End If
   
   lstParam("INDEXBREAKS") = False
   If IsElement(wlstParam("INDEXBREAKS")) = True Then
      Select Case UCase(Trim(wlstParam("INDEXBREAKS")))
      Case "Y","YES","T","TRUE",CStr(True)
         lstParam("INDEXED") = True
      Case "N","NO","F","FALSE","D","DEFAULT","",CStr(False)
         lstParam("INDEXBREAKS") = False
      Case Else
         Error 9999,"INDEXBREAKS, wrong value : "+Trim(wlstParam("INDEXBREAKS"))
   End Select
   End If
   
   lstParam("CASESENSITIVE") = False
   If IsElement(wlstParam("CASESENSITIVE")) = True Then
      Select Case UCase(Trim(wlstParam("CASESENSITIVE")))
      Case "Y","YES","T","TRUE",CStr(True)
         lstParam("CASESENSITIVE") = True
      Case "N","NO","F","FALSE","D","DEFAULT","",CStr(False)
         lstParam("CASESENSITIVE") = False
      Case Else
         Error 9999,"CASESENSITIVE, wrong value : "+Trim(wlstParam("CASESENSITIVE"))
   End Select
   End If
   
   nbFRQ = 0
   If IsElement(wlstParam("UPDATEFREQUENCY")) = True Then
      Select Case UCase(Trim(wlstParam("UPDATEFREQUENCY")))
      Case "0","D","DAILY","DAY","Q","QUOTIDIEN","QUOTIDIENNE","","D","DEFAULT"
         nbFRQ = 0
      Case "1","S","SCHEDULE","SCHEDULED","P","PLANIFIE","PLANIFIER"
         nbFRQ = 1
      Case "2","H","HOUR","HOURS","HOURLY","HORAIRE","HEURE"
         nbFRQ = 2
      Case "3","I","IMMEDIATE","IMMEDIATLY"
         nbFRQ = 3
      Case Else
         Error 9999,"UPDATEFREQUENCY, wrong value : "+Trim(wlstParam("UPDATEFREQUENCY"))
   End Select
   End If
   
   lstParam("UPDALL") = False
   If IsElement(wlstParam("UPDALL")) = True Then
      Select Case UCase(Trim(wlstParam("UPDALL")))
      Case "Y","YES","T","TRUE",CStr(True)
         lstParam("UPDALL") = True
      Case "N","NO","F","FALSE","D","DEFAULT","",CStr(False)
         lstParam("UPDALL") = False
      Case Else
         Error 9999,"UPDALL, wrong value : "+Trim(wlstParam("UPDALL"))
   End Select
   End If
   
   fullPath = String(1024, " ")
   Call W32_OSPathNetConstruct(0, wlstParam("SERVER"),wlstParam("PATHFILE"), fullPath)
   nbReturn = W32_NSFDbOpen(fullPath, nbHandleDB)
   If nbReturn <> 0 Then   
      StrError = APIError_Log   (nbReturn)
      Error 9999,"Couldn't open database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+") : "+StrError
      Exit Function
   End If   
   If nbHandleDB = 0 Then
      Error 9999,"Couldn't open database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
      Exit Function
   End If

   
   REM ***** Compute values to set *****
   REM Check if database needs to be indexed
   If lstParam("INDEXED") = True Then
      nbIDX = 1
      REM set database options so the index will be created
      nbReturn = NSFDbSetOptions(nbHandleDB, DBOPTION_FT_INDEX, DBOPTION_FT_INDEX)
      If nbReturn And ERR_MASK <> 0 Then
         StrError = APIError_Log   (nbReturn)
         Error 9999,"Can not index Database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+") : "+StrError
         Exit Function
      End If
   Else
      nbIDX = 0
   End If
   REM Index attachments
   If lstParam("INDEXATTACHMENTS") = True Then
      nbOPT = nbOPT Or &H20
   Else
      nbOPT = nbOPT  And &HDF
   End If
   REM Index binary attachments
   If lstParam("INDEXATTACHMENTSFORMAT") = True Then
      nbOPT = nbOPT Or &H80
   Else
      nbOPT = nbOPT And &H7F
   End If
   REM Index encrypted fields
   If lstParam("ENCRYPTEDFIELDS") Then
      nbOPT = nbOPT Or &H40
   Else
      nbOPT = nbOPT And &HBF
   End If
   REM Index sentence and paragraph breaks
   If lstParam("INDEXBREAKS") Then
      nbOPT = nbOPT Or &H10
   Else
      nbOPT = nbOPT And &HEF
   End If
   REM Index case-sensitive
   If lstParam("CASESENSITIVE") Then
      nbOPT = nbOPT Or &H02
   Else
      nbOPT = nbOPT And &HFD
   End If
   
   REM ***** Set new attributes *****
   nbReturn = NSFDbGetExtendedInfo (nbHandleDB, BID)
   If nbReturn And ERR_MASK = 0 Then
      StrError = APIError_Log   (nbReturn)
      Error 9999,"Can not get extended info form database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+") : "+StrError
      Exit Function
   End If
   If Not BID.hPool = 0 Then
      nbHandleLock  = OSLockObject(BID.hPool) + BID.Block
      Call Poke (nbHandleLock  + 2, nbIDX , 2)
      Call Poke (nbHandleLock  + 6, nbOPT , 2)
      Call Poke (nbHandleLock  + 8, nbFRQ , 2)
   Else
      nbReturn = W32_NSFDbClose(nbHandleDB)
      If nbReturn <> 0 Then
         StrError = APIError_Log   (nbReturn)      
         Error 9999,"Couldn't close database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+") : "+StrError
         Exit Function
      End If      
      Exit Function
   End If
   
   Call OSUnlockObject (BID.hPool)
   nbReturn = NSFDbSetExtendedInfo (nbHandleDB, BID.hPool)
   If nbReturn And ERR_MASK = 0 Then
      StrError = APIError_Log   (nbReturn)
      Error 9999,"Can not set extended info form database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+") : "+StrError
      Exit Function
   End If
   
   nbReturn = W32_NSFDbClose(nbHandleDB)
   If nbReturn <> 0 Then
      StrError = APIError_Log   (nbReturn)      
      Error 9999,"Couldn't close database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+") : "+StrError
      Exit Function
   End If
         
   If lstParam("UPDALL") = True Then
      fullPath = ""
      If Session Is Nothing Then
         Set Session = New NotesSession
      End If      
      fullPath = "Load Updall "+wlstParam("PATHFILE")
      If IsElement(wlstParam("UPDALLOPTIONS")) = True Then
         If Trim(wlstParam("UPDALLOPTIONS")) <> "" Then
            fullPath = Trim(fullPath)+" "+Trim(wlstParam("UPDALLOPTIONS"))
         End If
      End If      
      Call Session.Sendconsolecommand(wlstParam("SERVER"), FullPath)
   End If
         
   FTIndexSetInfo_API = True
   Erase lstParam   

   %rem
   lstParam("SERVER") = ""
   lstParam("PATHFILE") = ""
   lstParam("INDEXED") = ""
   lstParam("INDEXATTACHMENTS") = ""
   lstParam("INDEXATTACHMENTSFORMAT") = ""
   lstParam("ENCRYPTEDFIELDS") = ""
   lstParam("INDEXBREAKS") = ""
   lstParam("CASESENSITIVE") = ""
   lstParam("UPDATEFREQUENCY") = ""
   lstParam("UPDALL") = ""
   lstParam("UPDALLOPTIONS") = ""
   %end rem

   Exit Function
CatchError:
   MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   Call ErreurGestion(ErrorAction,"", "","",Nothing,"","", Structure_Log, CStr(GetThreadInfo(10)), CStr(GetThreadInfo (1)), CStr(Err),CStr(Error),CStr(Erl),Nothing,"",False)
   If nbHandleDB <> 0 Then
      nbReturn = W32_NSFDbClose(nbHandleDB)   
   End If   
   FTIndexSetInfo_API = False
   Exit Function
End Function

Public Function FTCreateIndex_API(wlstParam List As String) As Boolean

%REM
   Type FTIndexStats
DocsAdded As Long
DocsUpdated As Long
DocsDeleted As Long
BytesIndexed As Long
End Type

Declare Function W32_OSPathNetConstruct Lib "nnotes.dll" Alias "OSPathNetConstruct"(ByVal portName As Integer, ByVal serverName As String, ByVal fileName As String,ByVal pathName As String) As Integer
Declare Function W32_NSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen"(ByVal dbName As String, hDb As Long) As Integer
Declare Function W32_NSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" (ByVal hDb As Long) As Integer
Declare Function FTIndex Lib "nnotes.dll" Alias "FTIndex" (ByVal hDb As Long, ByVal options As Integer, stopfile As Long, stats As Long) As Integer
   
%END REM

   Dim nmServer As NotesName
   Dim fullPath As String
   Dim nbHandleDB As Long
   Dim nbOption As Long
   Dim nbReturn As Integer
   Dim nbNullHandle As Long
   Dim stats As FTIndexStats
   
   REM Re-index from scratch 2
   Const FT_INDEX_REINDEX = &H0002
   REM Build case sensitive index 4
   Const FT_INDEX_CASE_SENSITIVE = &H0004
   REM Build stem index 8
   Const FT_INDEX_STEM_INDEX = &H0008
   REM Index breaks 16
   Const FT_INDEX_BREAKS = &H0010
   REM Optimize index (e.g. for CD-ROM) 32
   Const FT_INDEX_OPTIMIZE =  &H0020
   REM Index attachments 64
   Const FT_INDEX_ATTACHMENTS = &H0040
   REM Index encrypted fields 128
   Const FT_INDEX_ENCRYPTED_FIELDS = &H0080
   REM Get options From database 256
   Const FT_INDEX_AUTOOPTIONS = &H0100
   REM Index summary data only 512
   Const FT_INDEX_SUMMARY_ONLY = &H0200
   REM Index Binary attachments 1024
   Const FT_INDEX_ATTACHMENTS_BINARY = &H1000

On Error GoTo CatchError

   FTCreateIndex_API = False

   If Trim(wlstParam("SERVER")) <> "" Then
      Set nmServer = New NotesName(Trim(wlstParam("SERVER")))
      wlstParam("SERVER") = nmServer.Abbreviated
      Set nmServer = Nothing
   End If
   
   If IsElement(wlstParam("PATHFILE")) = False Then
      Error 9999,"PATHFILE value is not defined"
   End If
   If Trim(wlstParam("PATHFILE")) = "" Then
      Error 9999,"PATHFILE value is Empty"
   End If

   fullPath = String(1024, " ")
   Call W32_OSPathNetConstruct(0, wlstParam("SERVER"),wlstParam("PATHFILE"), fullPath)
   nbReturn = W32_NSFDbOpen(fullPath, nbHandleDB)
   If nbReturn <> 0 Then      
      Error 9999,"Couldn't open database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
      Exit Function
   End If   
   If nbHandleDB = 0 Then
      Error 9999,"Couldn't open database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
      Exit Function
   End If
   
   If IsElement(wlstParam("REINDEX")) = True Then
      Select Case UCase(Trim(wlstParam("REINDEX")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_REINDEX
   End Select
   End If
   
   If IsElement(wlstParam("CASESENSITIVE")) = True Then
      Select Case UCase(Trim(wlstParam("CASESENSITIVE")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_CASE_SENSITIVE
   End Select
   End If
   
   If IsElement(wlstParam("STEM")) = True Then
      Select Case UCase(Trim(wlstParam("STEM")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_REINDEX
   End Select
   End If
   
   If IsElement(wlstParam("BREAKS")) = True Then
      Select Case UCase(Trim(wlstParam("BREAKS")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_BREAKS
   End Select
   End If
   
   If IsElement(wlstParam("OPTIMIZE")) = True Then
      Select Case UCase(Trim(wlstParam("OPTIMIZE")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_OPTIMIZE
   End Select
   End If
   
   If IsElement(wlstParam("ATTACHMENTS")) = True Then
      Select Case UCase(Trim(wlstParam("ATTACHMENTS")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_REINDEX
   End Select
   End If
   
   If IsElement(wlstParam("ENCRYPTEDFIELDS")) = True Then
      Select Case UCase(Trim(wlstParam("ENCRYPTEDFIELDS")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_ENCRYPTED_FIELDS
   End Select
   End If
   
   If IsElement(wlstParam("AUTOOPTIONS")) = True Then
      Select Case UCase(Trim(wlstParam("AUTOOPTIONS")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_AUTOOPTIONS
   End Select
   End If
   
   If IsElement(wlstParam("SUMMARYONLY")) = True Then
      Select Case UCase(Trim(wlstParam("SUMMARYONLY")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_SUMMARY_ONLY
   End Select
   End If
   
   If IsElement(wlstParam("ATTACHMENTSBINARY")) = True Then
      Select Case UCase(Trim(wlstParam("ATTACHMENTSBINARY")))
      Case "Y","YES","T","TRUE", CStr(True)
         nbOption = nbOption+FT_INDEX_ATTACHMENTS_BINARY
   End Select
   End If
   
   nbReturn = FTIndex (nbHandleDB,nbOption, nbNullHandle,nbNullHandle)
   If nbReturn <> 0 Then      
      Error 9999,"Can not index database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
      Exit Function
   End If
   
   nbReturn = W32_NSFDbClose(nbHandleDB)
   If nbReturn <> 0 Then      
      Error 9999,"Couldn't close database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
      Exit Function
   End If
   
   FTCreateIndex_API = True
   
   %rem
   lstParam("SERVER") = ""
   lstParam("PATHFILE") = ""
   lstParam("REINDEX") = ""
   lstParam("CASESENSITIVE") = ""
   lstParam("STEM") = ""
   lstParam("BREAKS") = ""
   lstParam("OPTIMIZE") = ""
   lstParam("ATTACHMENTS") = ""
   lstParam("ENCRYPTEDFIELDS") = ""
   lstParam("AUTOOPTIONS") = ""
   lstParam("SUMMARYONLY") = ""
   lstParam("ATTACHMENTSBINARY") = ""
   %end rem

   Exit Function
CatchError:
   MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   If nbHandleDB <> 0 Then
      nbReturn = W32_NSFDbClose(nbHandleDB)   
   End If   
   FTCreateIndex_API = False
Exit Function
End Function