So. Nach einigen NSDs und Verlussten in den Reihen meiner Nervenzellen ist es mir gelungen das Performanceproblem zu lösen.
Die Testdatenbank gab mit der obigen Funktionsversion erst nach ca. 1 Minute die Replication Formulas zurück. Vermutlich liegt es daran, dass diese Funktion eigentlich zum Identifizieren von geänderten Dokumenten dient.
Die nachvolgenden Funktionsversion rückt die Replication Formulas der Testdatenbank bereits nach 0,02 Sekunden raus.
Option Public
Option Declare
Private Const MAXTUMBLERLEVELS = 32
Private Const NAVIGATE_CURRENT = 0
Private Const NAVIGATE_NEXT = 1
Private Const READ_MASK_NOTEID = 1&
Private Const READ_MASK_NOTECLASS = 4&
Private Const NOTE_CLASS_REPLFORMULA = 2048&
Private Const NOTE_ID_SPECIAL = &HFFFF0000&
Private Const NOTE_CLASS_DESIGN = &H0020&
Private Const SIGNAL_MORE_TO_DO = &H0020
Private Const SIGNAL_DEFN_ITEM_MODIFIED = &H0001
Private Const SIGNAL_VIEW_ITEM_MODIFIED = &H0002
Private Const SIGNAL_INDEX_MODIFIED = &H0004
Private Const SIGNAL_UNREADLIST_MODIFIED = &H0008
Private Const SIGNAL_DATABASE_MODIFIED = &H0010
Private Const SIGNAL_VIEW_TIME_RELATIVE = &H0040
Private Const SIGNAL_NOT_SUPPORTED = &H0080
Private Const SIGNAL_ANY_CONFLICT = SIGNAL_DEFN_ITEM_MODIFIED Or SIGNAL_VIEW_ITEM_MODIFIED Or SIGNAL_INDEX_MODIFIED Or SIGNAL_UNREADLIST_MODIFIED Or SIGNAL_DATABASE_MODIFIED
Private Const SIGNAL_ANY_NONDATA_CONFLICT = SIGNAL_DEFN_ITEM_MODIFIED Or SIGNAL_VIEW_ITEM_MODIFIED Or SIGNAL_INDEX_MODIFIED Or SIGNAL_UNREADLIST_MODIFIED
Private Type COLLECTIONPOSITION
Level As Integer
MinLevel As String * 1
MaxLevel As String * 1
Tumbler(0 To MAXTUMBLERLEVELS - 1) As Long
End Type
Private Type DESIGNOBJECTS
NoteID As Long
NoteClass As Integer
End Type
Declare Private Function apiIDEntries Lib "nnotes.dll" Alias "IDEntries" (Byval lng_tablehandle As Long) As Integer
Declare Private Function apiNIFCloseCollection Lib "nnotes.dll" Alias "NIFCloseCollection" ( Byval hCol As Long) As Integer
Declare Private Function apiNSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" (Byval lng_dbhandle As Long) As Integer
Declare Private Function apiNSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen" (Byval str_netfilepath As String, lng_dbhandle As Long) As Integer
Declare Private Function apiNIFOpenCollection Lib "nnotes.dll" Alias "NIFOpenCollection" (Byval lng_viewdbhandle As Long, Byval lng_datadbhandle As Long, Byval lng_viewnoteid As Long, _
Byval int_openflags As Integer, Byval lng_unreadlisthandle As Long, rethCollection As Long, Byval rethViewNote As Long, Byval retViewUNID As Long, _
Byval rethCollapsedList As Long, Byval rethSelectedList As Long) As Integer
Declare Private Function apiNIFReadEntries Lib "nnotes.dll" Alias "NIFReadEntries" (Byval lng_collectionhandle As Long, cp_index As COLLECTIONPOSITION, _
Byval int_skipnavigator As Integer, Byval lng_skipcount As Long, Byval ReturnNavigator As Integer, _
Byval lng_retcount As Long, Byval lng_retmask As Long, lng_retbuffer As Long, int_retbufferlength As Integer, lng_skippedcount As Long, lng_returncount As Long, int_signal As Integer) As Integer
Declare Private Function apiNIFUpdateCollection Lib "nnotes.dll" Alias "NIFUpdateCollection" (Byval lng_collectionhandle As Long) As Integer
Declare Private Function apiOSLockObject Lib "nnotes.dll" Alias "OSLockObject" (Byval handle As Long) As Long
Declare Private Function apiOSPathNetConstruct Lib "nnotes.dll" Alias "OSPathNetConstruct" (Byval lng_port As Long, Byval str_server As String, Byval str_filepath As String, Byval str_netfilepath As String) As Integer
Declare Private Function apiOSUnlockObject Lib "nnotes.dll" Alias "OSUnlockObject" (Byval Handle As Long) As Integer
Declare Private Sub apiMoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Byval Length As Long)
Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase
Dim dbl_start As Double
Dim dbl_end As Double
Set db = s.GetDatabase("sedcd109.wk.dcx.com", "dart\096\dev\sclaren\bhbtest.nsf")
Set db = s.CurrentDatabase
dbl_start = Timer
Call FindReplicationFormulas(db)
dbl_end = Timer
Print "FindReplicationFormulas: " & Round(dbl_end - dbl_start, 2)
End Sub
Function GetNetFilePath(str_server As String, str_filepath As String) As String
Dim lng_apiresult As Long
Dim str_netfilepath As String
' ### get network file path ###
str_netfilepath = Space(256)
lng_apiresult = apiOSPathNetConstruct(0, str_server, str_filepath, str_netfilepath)
If Not(lng_apiresult = 0) Then
Goto terminate
End If
If Instr(str_netfilepath, Chr(0)) > 0 Then
str_netfilepath = Strleft(str_netfilepath, Chr(0))
End If
' ### return value ###
GetNetFilePath = Trim(str_netfilepath)
' ### terminate ###
terminate:
Exit Function
End Function
Function FindReplicationFormulas(db_source As NotesDatabase) As NotesDocumentCollection
Dim cp_index As COLLECTIONPOSITION
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim int_apiresult As Integer
Dim int_bufferlength As Integer
Dim int_counter As Integer
Dim int_signal As Integer
Dim lng_bufferaddress As Long
Dim lng_bufferhandleaddress As Long
Dim lng_hcollection As Long
Dim lng_hdb As Long
Dim lng_htable As Long
Dim lng_returnedcount As Long
Dim lng_skippedcount As Long
Dim str_networkfilepath As String
Dim do_noteinfo As DesignObjects
' ### initialize ###
If db_source Is Nothing Then Goto terminate
' ### open database ###
str_networkfilepath = GetNetFilePath(db_source.Server, db_source.FilePath)
If str_networkfilepath = "" Then Goto terminate
int_apiresult = apiNSFDbOpen(str_networkfilepath, lng_hdb)
If Not(int_apiresult = 0) Then Goto terminate
' ### open collection ###
int_apiresult = apiNIFOpenCollection(lng_hdb, lng_hdb, (NOTE_CLASS_DESIGN Or NOTE_ID_SPECIAL), 0, 0&, lng_hcollection, 0, 0&, 0&, 0&)
If Not(int_apiresult = 0) Then Goto closecollection
If lng_hcollection = 0 Then Goto closedb
' ### read entries ###
' initialize the position in the collection
cp_index.Level = 0
cp_index.Tumbler(0) = 0
' do while there is anything to read
Do
' read all entries and load the note id and the note class into buffer
Do
int_apiresult = apiNIFReadEntries(lng_hcollection, cp_index, NAVIGATE_NEXT, 1&, NAVIGATE_NEXT, -1&, (READ_MASK_NOTEID Or READ_MASK_NOTECLASS), _
lng_bufferhandleaddress, int_bufferlength, lng_skippedcount, lng_returnedcount, int_signal)
If Not(int_apiresult = 0) Goto closecollection
' update collection if the collection was changed since last read
If (int_signal And SIGNAL_ANY_CONFLICT) = SIGNAL_ANY_CONFLICT Then
int_apiresult = apiNIFUpdateCollection(lng_hcollection)
If Not(int_apiresult = 0) Then Goto closecollection
End If
Loop While ((int_signal And SIGNAL_ANY_CONFLICT) = SIGNAL_ANY_CONFLICT)
If lng_bufferhandleaddress = 0 Then Goto closecollection
' lock buffer and return the address of the buffer
lng_bufferaddress = apiOSLockObject(lng_bufferhandleaddress)
' get the design documents
For int_counter = 1 To lng_returnedcount
' copy the information of one design document into the design object structure
' long 4 bytes + integer 2 bytes
Call apiMoveMemory(do_noteinfo, Byval lng_bufferaddress + ((int_counter - 1) * 6), Byval 6)
' add document to document collection if a replication formula was found
If do_noteinfo.NoteClass = NOTE_CLASS_REPLFORMULA Then
If dc Is Nothing Then Set dc = db_source.Search({}, Nothing, 0)
Set doc = db_source.GetDocumentByID(Hex$(do_noteinfo.NoteID))
If Not(doc Is Nothing) Then Call dc.AddDocument(doc)
End If
Next int_counter
' unlock buffer
Call apiOSUnlockObject(lng_bufferhandleaddress)
Loop While ((int_signal And SIGNAL_MORE_TO_DO) = SIGNAL_MORE_TO_DO)
' ### close collection ###
closecollection:
int_apiresult = apiNIFCloseCollection(lng_hcollection)
If Not(int_apiresult = 0) Then Goto closedb
' ### close database ###
closedb:
Call apiNSFDbClose(lng_hdb)
' ### return value ###
If Not(dc Is Nothing) Then Set FindReplicationFormulas = dc
' ### terminate ###
terminate:
Exit Function
End Function
Thema: Replication Settings von großen Datenbanken per C API auslesen (Gelesen 2790 mal)