Gestion Index

Gestion Index

Messagepar Michael DELIQUE » 17 Mars 2014 à 09:30

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 "("+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
Cordialement

Michael (SMS-Phobique)
----------------------------
"La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi."
Albert EINSTEIN
Avatar de l’utilisateur
Michael DELIQUE
Administrateur
Administrateur
 
Message(s) : 12183
Inscrit(e) le : 16 Déc 2004 à 10:36
Localisation : Paris/Cergy

Retour vers API