Gestion Index
Publié: 17 Mars 2014 à 09:30Public 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 "("+Structure_Log+" : "+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
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 "("+Structure_Log+" : "+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 for create 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
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
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
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
Error 9999,"Can not index Database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
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
Error 9999,"Can not get extended info form database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
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
Error 9999,"Couldn't close database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
Exit Function
End If
Exit Function
End If
Call OSUnlockObject (BID.hPool)
nbReturn = NSFDbSetExtendedInfo (nbHandleDB, BID.hPool)
If nbReturn And ERR_MASK = 0 Then
Error 9999,"Can not set extended info form 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
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 "("+Structure_Log+" : "+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
FTIndexSetInfo_API = False
Exit Function
End Function
%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 "("+Structure_Log+" : "+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
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 "("+Structure_Log+" : "+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 for create 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
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
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
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
Error 9999,"Can not index Database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
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
Error 9999,"Can not get extended info form database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
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
Error 9999,"Couldn't close database ("+wlstParam("SERVER")+"!!"+wlstParam("PATHFILE")+")"
Exit Function
End If
Exit Function
End If
Call OSUnlockObject (BID.hPool)
nbReturn = NSFDbSetExtendedInfo (nbHandleDB, BID.hPool)
If nbReturn And ERR_MASK = 0 Then
Error 9999,"Can not set extended info form 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
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 "("+Structure_Log+" : "+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
FTIndexSetInfo_API = False
Exit Function
End Function