SetReplicaID
Publié: 02 Août 2005 à 13:34[syntax="ls"]Type TimeDate
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,
) / 100
c! = Fix(c!) + Fraction(c! + 0.17)
newID = Left$(newID, & Right$(String(7, "0") & Hex$(100 * c!),
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), & Right$(String(8, "0") & Mid$(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), & ":" & Right$(String(7, "0") & Hex$(T.Date),
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), & ":" & Right$(String(7, "0") & Hex$(R.Date),
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.
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,
) / 100
c! = Fix(c!) + Fraction(c! + 0.17)
newID = Left$(newID,
& Right$(String(7, "0") & Hex$(100 * c!),
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),
& Right$(String(8, "0") & Mid$(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),
& ":" & Right$(String(7, "0") & Hex$(T.Date),
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),
& ":" & Right$(String(7, "0") & Hex$(R.Date),
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.