Hier ist der Code:
' Notes API constants
Const DIRECTION_NEVER=0
Const DIRECTION_SEND=1
Const DIRECTION_RECEIVE=2
Const MAXPATH=256
Const MAXALPHATIMEDATE=80
Const ERR_SPECIAL_ID=578
' custom type for storing individual replication history entries
Type HIST_ENTRY
RepTime As String
ServerName As String
FileName As String
Direction As String
End Type
' Notes API types (based on C structs)
Type TIMEDATE
Innards1 As Long
Innards2 As Long
End Type
Type REPLHIST_SUMMARY
ReplicationTime As TIMEDATE
AccessLevel As Integer
AccessFlags As Integer
Direction As Integer
ServerNameOffset As Long
ServerNameLength As Integer
FileNameLength As Integer
Spare1 As Long
Spare2 As Long
End Type
' Notes API declares
Declare Sub OSPathNetConstruct Lib "nnotes" (Byval portName$, Byval ServerName$, Byval FileName$, Byval retPathName$)
Declare Function NSFDbGetReplHistorySummary% Lib "nnotes" (Byval hDb&, Byval Flags&, rethSummary&, retNumEntries&)
Declare Function NSFDbOpen% Lib "nnotes" (Byval PathName$, hDB&)
Declare Function NSFDbClose% Lib "nnotes" (Byval hDB&)
Declare Function OSMemFree% Lib "nnotes" (Byval Handle&)
Declare Function OSLockObject& Lib "nnotes" (Byval nHandle&)
Declare Function OSUnlockObject% Lib "nnotes" (Byval nHandle&)
Declare Function ConvertTIMEDATEToText% Lib "nnotes" (Byval intFormat&, Byval TextFormat&, InputTime As TIMEDATE, Byval retTextBuffer$, Byval TextBufferLength%, retTextLength%)
Declare Function OSLoadString% Lib "nnotes" (Byval hModule&, Byval StringCode%, Byval retBuffer$, BufferLength%)
' Win32 API declares
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As REPLHIST_SUMMARY, Byval pSource&, Byval dwLength&)
Declare Sub CopyMemoryStr Lib "kernel32" Alias "RtlMoveMemory" (Byval pDest$, Byval pSource&, Byval dwLength&)
Function GetReplHistory(db As NotesDatabase, sList() As String, lEntries&) As Integer
' This function returns the replication history for a database in the same format as you would see
' by selecting "File - Replication - History" (and clicking Server name radio button) in the Notes R5 client.
' The function has (3) parameters:
'
' 1. db (NotesDatabase) - [Input] Indicates the database you wish to open
' 2. sList (String array) - [Output] Returns array of strings that will hold the formatted history
' 3. lEntries (Long) - [Output] Returns the number of entries returned from the NSFDbGetReplHistorySummary call
' The function itself returns an integer. If no errors are found, it returns a 0. Otherwise, it returns the error
' code returned by the Notes API.
Dim hDb&, hLock&, hSummary&
Dim nLoop%, cbReturn%, nPos%, nRetCode%
Dim sPath$, sHold$, sRepTime$, sTemp$, sServer$, sFileName$
Dim summary As REPLHIST_SUMMARY
Dim entry() As HIST_ENTRY
Dim nm As NotesName
' what to return if no errors are found
GetReplHistory=0
' prepare a string for API call
sPath$=Space(MAXPATH)
' create an API-friendly path to the db and open it
OSPathNetConstruct "", db.Server, db.FilePath, sPath$
nRetCode%=NSFDbOpen(sPath$, hDb&)
If nRetCode% <> 0 Then
GetReplHistory = nRetCode%
Else
' get handle to replication history summary (sorted by server name)
nRetCode%=NSFDbGetReplHistorySummary(hDb&, 0, hSummary&, lEntries&)
If nRetCode% <> 0 Then
GetReplHistory = nRetCode%
Else
' process only if there are entries in the history summary
If lEntries& > 0 Then
Redim entry(lEntries& - 1)
sRepTime$=Space(MAXALPHATIMEDATE + 1)
' lock down the handle to the history summary so we can get at the data
hLock&=OSLockObject(hSummary&)
For nLoop%=0 To lEntries&-1
' extract replication history by looping over the array of REPLHIST_SUMMARY structs
CopyMemory summary, hLock&, Lenb(summary)
' convert Notes TIMEDATE to a legible text string for replication time
ConvertTIMEDATEToText 0, 0, summary.ReplicationTime, sRepTime$, MAXALPHATIMEDATE, cbReturn%
entry(nLoop%).RepTime=Left$(sRepTime$, cbReturn%)
' get replication direction
Select Case summary.Direction
Case DIRECTION_NEVER
entry(nLoop%).Direction="Never Received"
Case DIRECTION_SEND
entry(nLoop%).Direction="Send"
Case DIRECTION_RECEIVE
entry(nLoop%).Direction="Receive"
End Select
' advance offset to next REPLHIST_SUMMARY struct
hLock&=hLock&+Lenb(summary)
Next
' as server/filenames are not part of the REPLHIST_SUMMARY struct, but rather at the end of the
' array of these structs, we'll need to grab this info one char at a time (for each entry we find) in the
' format: CN=ServerA/O=OrgA!!myfile.nsf/0CN=ServerB/O=OrgAA!!myfile.nsf/0, etc.
sHold$=""
sTemp$=String$(1, 0)
nLoop%=0
Do While nLoop% < lEntries&
CopyMemoryStr sTemp$, hLock&, 1
If sTemp$ = Chr$(0) Then
' parse out server and filename
nPos%=Instr(1, sHold$, "!!")
entry(nLoop%).ServerName=Left$(sHold$, nPos%-1)
entry(nLoop%).FileName=Right$(sHold$, Len(sHold$)-nPos%-1)
sHold$=""
nLoop%=nLoop% + 1
Else
' build the string one char at a time
sHold$=sHold$ & sTemp$
End If
' advance the offset
hLock& = hLock& + 1
Loop
' release the lock on the history summary handle once we're done with it
OSUnlockObject(hSummary&)
Redim sList(lEntries&-1)
For nLoop%=0 To lEntries&-1
' populate the array of entries to return to the caller
Set nm=New NotesName(entry(nLoop%).ServerName)
sList(nLoop%)=Trim$(nm.Abbreviated & " " & entry(nLoop%).FileName & " " & entry(nLoop%).RepTime & " (" & entry(nLoop%).Direction & ")")
Next
End If
End If
' free any open handles to the history summary and/or the db
If hSummary& <> 0 Then OSMemFree hSummary&
If hDb& <> 0 Then NSFDbClose hDb&
End If
End Function
Sub Click(Source As Button)
' This sample button calls the GetReplHistory function and displays a database's replication history
' sorted by server name in the format <server> <filename> <date> <time> (<direction>). For example:
' If errors were encountered by the Notes API calls in GetReplHistory, the
' OSLoadString API is used to determine the error string returned.
Dim session As New NotesSession
Dim db As NotesDatabase
Dim sList() As String
Dim nCt%, nReturn%
Dim lEntries&
Dim sMsg$, sBuffer$
;
Set db=session.GetDatabase("Comm1/Witte/de", "admin4.nsf")
;
' retrieve the history sorted by server name
nReturn%=GetReplHistory(db, sList, lEntries&)
If nReturn% = 0 Then
' no errors--build a string to show in a msgbox
sMsg$=""
For nCt%=0 To lEntries&-1
sMsg$=sMsg$ & sList(nCt%) & Chr(13) & Chr(10)
Next
' show the string
Msgbox sMsg$, 0, "Replication History for " & db.Title
Elseif nReturn=ERR_SPECIAL_ID Then
' no history found
Msgbox "There is no replication history for this database.", 32, "Replication History"
Else
' find out what the error string is from the API
sBuffer$=String$(256, 0)
OSLoadString 0, nReturn%, sBuffer$, 255
' errors found
Msgbox "Error found in retrieving history: " & sBuffer$, 48, "Replication History Error"
End If
End Sub