REPLFLG_NEVER_REPLICATE

Option Public
Option Declare
 
%Include "LSERR.LSS"
 
Const REPLFLG_NEVER_REPLICATE = &h0100
 
Type TIMEDATE
Innard1 As Long
Innard2 As Long
End Type
 
Type DBREPLICAINFO
ID As TIMEDATE
flags As Integer
CutoffInterval As Integer
Cutoff As TIMEDATE
End Type
 
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 W32_NSFDbReplicaInfoGet _
Lib "nnotes.dll" Alias "NSFDbReplicaInfoGet" _
(ByVal hDB As Long, retReplicationInfo As DBREPLICAINFO) As Integer
Declare Function W32_NSFDbReplicaInfoSet _
Lib "nnotes.dll" Alias "NSFDbReplicaInfoSet" _
(ByVal hDB As Long, retReplicationInfo As DBREPLICAINFO) As Integer
 
 
Class NotesReplicationSettings
Private hDb As Long
Private retReplicationInfo As DBREPLICAINFO
Private prvdb As NotesDatabase
Private flgDBExist As Integer
 
Sub Delete
If hDb <> 0 Then Call W32_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
If inpNotesDatabase Is Nothing Then
Error 14104, "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
rc = W32_NSFDbOpen(sDatabase,Me.hDb)
If rc <> 0 Then
Me.flgDBExist = False
End If
rc = W32_NSFDbReplicaInfoGet(Me.hDb, Me.retReplicationInfo)
If rc <> 0 Then
Me.flgDBExist = False
End If
Me.flgDBExist = True
End Sub
 
Private Function DBExist As Integer
DBExist = Me.flgDBExist
End Function
 
Public Function NeverReplicate(sFlag As Boolean) As Boolean
Dim puActivity As Long
Dim rc As Integer
If Not Me.flgDBExist Then
Error 14104, "Database not opened"
NeverReplicate = False
Exit Function
End If
If sFlag Then
Me.retReplicationInfo.flags =_
(Me.retReplicationInfo.flags _
OR REPLFLG_NEVER_REPLICATE)
Else
Me.retReplicationInfo.flags =_
(Me.retReplicationInfo.flags _
And Not REPLFLG_NEVER_REPLICATE)
End If
rc = W32_NSFDbReplicaInfoSet(Me.hDb, Me.retReplicationInfo)
If rc <> 0 Then
Me.flgDBExist = False
End If
End Function
 
Public Property Get ReplicationFlags As String
ReplicationFlags =  Me.retReplicationInfo.flags
End Property
End Class

Sample:

Sub Click(Source As Button)
Const REPLFLG_DISABLE = &h4
Dim session As New NotesSession
Dim db As NotesDatabase
Dim rep As NotesReplication
Set db = session.CurrentDatabase
Dim rs As New NotesReplicationSettings(db)
Call rs.NeverReplicate(False)
End Sub