Date As Long
Time As Long
End Type
Type ReplicaInfo
Date As Long
Time As Long
Flags As Integer
CutoffDays As Integer
CutoffDate(1) As Long
End Type
Const wAPIModule = "NNOTES" ' Windows/32
Declare Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _
( Byval P As String, hDB As Long) As Integer
Declare Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _
( Byval hDB As Long) As Integer
Declare Function NSFDbReplicaInfoGet Lib wAPIModule Alias "NSFDbReplicaInfoGet" _
( Byval H As Long, R As ReplicaInfo) As Integer
Declare Function NSFDbReplicaInfoSet Lib wAPIModule Alias "NSFDbReplicaInfoSet" _
( Byval H As Long, R As ReplicaInfo) As Integer
Declare Private Function OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" _
( Byval zP As Long, Byval S As String, Byval F As String, Byval N As String) As Integer
Declare Sub NEMDisplayError Lib "NNOTESWS" Alias "NEMDisplayError" _
( Byval E As Long)
Sub SetReplicaID(targetdb As NotesDatabase, Byval newID As Variant)
Const ButtonTitle = "Set Replica ID"
Const ErrorTitle = ButtonTitle & " - Error"
n$ = Typename(newID)
Select Case n$
Case "STRING" :
' nop
Case "NOTESDATABASE" :
newID = newID.ReplicaID
Case "DATE", "NOTESDATETIME" :
Dim doc As New NotesDocument(targetdb)
If n$ = "DATE" Then
doc.X = newID
Else
Set doc.X = newID
End If
E = Evaluate({@Text(X; "*")}, doc)
newID = E(0)
Case "NULL" :
newID = targetdb.ReplicaID
c! = Clng("&H" & Right$(newID,
c! = Fix(c!) + Fraction(c! + 0.17)
newID = Left$(newID,
Case Else :
Messagebox "Can't understand data type of replica ID", 16, ErrorTitle
Exit Sub
End Select
Dim T As TimeDate
p% = Instr(newID, ":")
If p% > 0 Then
newID = Right$(String(8, "0") & Left$(newID, p% - 1),
Else
newID = Right$(String(16, "0") & newID, 16)
End If
On Error Resume Next
T.Time = Clng("&H" & Left$(newID,
T.Date = Clng("&H" & Right$(newID,
On Error Goto 0
If (T.Time = 0 Or T.Date = 0) And Not newID = String(16, "0") Then
Messagebox "Can't understand new replica ID (bad hex)", 16, ErrorTitle
Exit Sub
End If
newID = Right$(String(7, "0") & Hex$(T.Time),
db$ = Space(1024)
With targetdb
OSPathNetConstruct 0, .Server, .FilePath, db$
End With
Dim hDB As Long
NSFDbOpen db$, hDB
If hDB = 0 Then
Messagebox "Can't open target database", 16, ErrorTitle
Exit Sub
End If
Dim R As ReplicaInfo
s% = NSFDbReplicaInfoGet(hDB, R)
If Not s% = 0 Then
NEMDisplayError s%
End If
oldID = Right$(String(7, "0") & Hex$(R.Time),
ok = (Messagebox("Old ID: " & oldID _
& Chr$(10) & "New ID: " & newID _
& Chr$(10) & " " _
& Chr$(10) & "Continue?" _
, 256 + 32 + 4, ButtonTitle) = 6)
If ok Then
R.Date = T.Date
R.Time = T.Time
s% = NSFDbReplicaInfoSet(hDB, R)
If s% = 0 Then
Messagebox "Replica ID was changed", 64, ButtonTitle
Else
NEMDisplayError s%
End If
End If
NSFDbClose hDB
End Sub[/syntax]To specify the new ID, use one of the following data types:
* String containing the new ID. For example: "8025612E:00456789". The colon in the middle is optional.
* Variant of type Date/Time to set the apparent creation date of the target database in the local time zone. For example: Now()
* NotesDateTime object to set the apparent creation date of the target database in some other time zone.
* NotesDatabase object. The target database becomes a replica of the database that you specify.
* Null (either the LotusScript keyword Null or a Variant variable with the value Null). The replica ID of the target database is changed slightly so that it no longer matches other replicas.