Tjek af klient replication history for en given database

Hej,

Vi har i Postopen på nogle databaser et kald til en agent som automatisk repliker deres database. Hvis de ikke har gjort det i x antal dage får de en besked om at de skal oprette en ny replika.

Her er koden - håber du kan blive inspireret:

Initialize:
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Set db = session.CurrentDatabase   
    Dim purgeinterval As Long
    Dim msgstr As String, strList As String, sbjstr As String
    Dim dspName As String, strAcctUser As String
    Dim valuelist As Variant
    Dim sName As String
    purgeinterval = 10
    sName = db.Server
   
    np$ = Space(1024)
'  Declaring space for the path of notes   
    OSPathNetConstruct 0, db.Server, db.FilePath, np$
   
    Dim hDB As Long
    Dim dt2 As Long
    Dim T As Long
    Dim rc%
    Dim tod As Long
    Dim hS As Long
    Dim init As Long
    Dim time_delta As Long
    Dim repdate As Long
    Dim repage As Long
    Dim repinfo As RepInfoClass
    Dim turnoffrep As Integer
   
   
    dt2 = 3888000
    NSFDbOpen np$, hDB
    If hDB = 0 Then Exit Sub
   
    tod = Today()
   
    NSFDbGetReplHistorySummary hDB, 2, hS, nE&
    If Not hS = 0 Then
        p& = OSLockObject(hS)
       
        For i& = p& To p&  Step 30                       
           
            dt$ = Space(80)
            ConvertTIMEDATEToText 0, 0, i&, dt$, 80, nd%
            dt$ = Left$(dt$, nd%)
            repdate = Cdat(dt$)
            Peek a%, i& + 8, 2
            Peek f%, i& + 10, 2
            Peek d%, i& + 12, 2
            Select Case d%
            Case 0 : dn$ = "Never"
            Case 1 : dn$ = "Send"
            Case 2 : dn$ = "Receive"
            Case Else : dn$ = "Unknown (" & Cstr(d%) & ")"
            End Select
            Peek o&, i& + 14, 4
            Peek ns%, i& + 18, 2
            Peek nf%, i& + 20, 2
            sv$ = Space(ns%)
           
'determine replica age
            RepAge = tod-repdate + 1               
            ConvertTIMEDATEToText 0, 0, i&, dt$, 80, nd%
           
            If repage > purgeinterval Then
'            If repage > 1 Then              'for testing purposes ONLY
                Set Repinfo = New RepInfoClass(db)
                turnoffrep = repinfo.SetDisableReplica(REPLFLG_DISABLE)
                Messagebox "You last replicated on " & dt$ & Chr(13)_
                & "WARNING!  Your local copy has been identified as" & Chr(13)_
                & "being out of date and will not replicate back to the server. " &)
           
            Else
                Call db.Replicate( sName )
            End If
        Next
        OSUnlockObject hS
        OSMemFree hS
    End If
   
    NSFDbClose hDB
------------
Declaration:

Const wAPIModule = "NNOTES"  ' Windows/32

Const CLASS_ABOUT = &H0002
Const CLASS_USING = &H0100
Const REPLFLG_DISABLE = 4
Const INFO_CLASS = 3
Const CLASS_DEFAULT = &H8000

Type TIMEDATE
    Innards1 As Long
    Innards2 As Long
End Type


Type dbReplicaInfo
    id As timeDate
    flags As Integer
    cutoffInterval As Integer
    cutoff As timeDate
End Type

Declare Function ConvertTIMEDATEToText Lib wAPIModule Alias "ConvertTIMEDATEToText" _
(  Byval zI As Long, Byval zT As Long, Byval T As Long, Byval S As String, Byval nS As Integer, nT As Integer) As Integer

Declare Function ConvertTextToTIMEDATE Lib wAPIModule Alias "ConvertTextToTIMEDATE" _
(  Byval zI As Long, Byval zT As Long, pS As Long, Byval nS As Integer, Byval T As Long) As Integer

Declare Private Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _
(  Byval P As String, hDB As Long) As Integer
Declare Private Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _
(  Byval hDB As Long) As Integer

Declare Private Function NSFDbGetReplHistorySummary Lib wAPIModule Alias "NSFDbGetReplHistorySummary" _
(  Byval hDB As Long, Byval F As Long, hS As Long, N As Long) As Integer

Declare Private Function OSMemFree Lib wAPIModule Alias "OSMemFree" _
(  Byval hM As Long) As Integer
Declare Private Function OSLockObject Lib wAPIModule Alias "OSLockObject" _
(  Byval hM As Long) As Long
Declare Private Sub OSUnlockObject Lib wAPIModule Alias "OSUnlockObject" _
(  Byval hM As Long)

Declare Private Function OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" _
(  Byval zP As Long, Byval S As String, Byval F As String, Byval P As String) As Integer

Declare Function NSFDbReplicaInfoGet Lib wAPIModule  Alias "NSFDbReplicaInfoGet"_
(Byval hdb As Long, retBuf As dbReplicaInfo) As Integer

Declare Function NSFDbReplicaInfoSet Lib WAPIModule Alias "NSFDbReplicaInfoSet"_
(Byval hdb As Long, inpBuf As dbReplicaInfo) As Integer

Declare Private Sub Peek Lib "MSVCRT" Alias "memcpy" _
(  D As Any, Byval P As Long, Byval N As Long)
Declare Private Sub PeekString Lib "MSVCRT" Alias "memcpy" _
(  Byval D As String, Byval P As Long, Byval N As Long)

Declare Private Sub PokeString Lib "MSVCRT" Alias "memcpy" _
(  Byval D As Long, Byval S As String, Byval N As Long)

Class  RepInfoClass
   
    Private hDb As Long
    Private retReplicationInfo As DBREPLICAINFO
    Private prvdb As NotesDatabase
    Private flgDBExist As Integer
   
    Sub Delete
        If hDb <> 0 Then Call NSFDbClose(hDb)
    End Sub
   
    Sub New (inpNotesDatabase As NotesDatabase)
       
        Dim sDatabase As String
        Dim uaesession As New notessession
        Dim rc As Integer
       
        Me.flgDBExist = False
       
'Get a valid NotesDatabase to the specified database
        If inpNotesDatabase Is Nothing Then
            Error 14104, "NotesUserActivity: Database Object is invalid"
            Exit Sub
        End If
       
        Set prvdb = New NotesDatabase(inpNotesDatabase.Server, inpNotesDatabase.FilePath)
       
        If (prvdb.Server = "") Or (uaesession.IsOnServer) Then
            sdatabase = prvdb.filepath
        Else
            sdatabase = prvdb.server + "!!" + prvdb.filepath
        End If
       
'Open the target database
        rc = NSFDbOpen(sDatabase,Me.hDb)
        If rc <> 0 Then
            Me.flgDBExist = False
        End If
       
'Set the Replica information
        rc = NSFDbReplicaInfoGet(Me.hDb, Me.retReplicationInfo)
        If rc <> 0 Then
            Me.flgDBExist = False
        End If
        Me.flgDBExist = True
    End Sub 'End of open sub
   
    Public Function DBExist As Integer
        DBExist = Me.flgDBExist
    End Function
   
    Public Function Parent As NotesDatabase
        Set Parent = prvdb
    End Function
   
    Public Function SetDisableReplica(sFlag As Integer) As Integer
       
        Dim puActivity As Long
       
        If Not Me.flgDBExist Then
            Error 14104, "Notes DB not opened"
            SetDisableReplica = False
            Exit Function
        End If
'*** this is where the replication flag is set to not to replicate
       
        Me.retReplicationInfo.flags = &H4
        rc = NSFDbReplicaInfoSet(Me.hDb,Me.retReplicationInfo)
        If rc <> 0 Then
            Me.flgDBExist = False
        End If
       
    End Function
End Class

Det var ellers noget af en gang kode.... :-) Det lyder som en rigtig god kontrol at have.

Jeg har fundet en work-around hvor der på serveren, hver dag, oprettes et profildokument med dagsdato.
Når man så laver et tjek på dette dok og hvilken dato der står så viser den hvornår der sidst var sket en replikering.
Det ville jo være så nemt hvis der var en funktion der hed getReplicaDate, getReplicaHistory eller sådan noget.

Tak for svaret.
MvHans