Lotus Notes — рабочий инструмент программиста.

Обсуждения программирования на Lotus Notes/Domino

Delete BES State Databases

leave a comment »

Option Declare ‘ Declarations
Const msgBoxOptions = 4 + 32 + 256
‘ yes = IDYES
Const yes = 6 Sub Click(Source As Button)
‘ posted to http://www.openntf.org/projects/codebin/codebin.nsf/CodeByDate/3307822D17936284862575000058210D
‘ written by Mike Mortin, 20081015 Dim ui As New NotesUIWorkspace
Dim uidoc As NotesuiDocument
Dim db() As NotesDatabase
Dim user As String, serverList() As String, msg As String
Dim index As Long, numDbs As Long
Dim deleteDbs As Boolean ‘ set up
Set uidoc = ui.CurrentDocument
user = uidoc.FieldGetText("firstname") & " " & uidoc.FieldGetText("lastname")
deleteDbs = False ‘ get the server names
If 0 Then
‘ hard code the server names
Redim serverList(0 To 2)
serverList(0) = "BES01/SVR/CA"
serverList(1) = "BES02/SVR/CA"
serverList(2) = "BES03/SVR/CA"
‘ load from a group
Dim s As New NotesSession
Dim doc As NotesDocument
Dim key(0) As Variant
key(0) = "BlackBerryServers" ‘ <— put the group name that contains your BlackBerry servers
Set doc = GetDocFromDb(s.CurrentDatabase, "Groups", key, True)
Redim serverList(Lbound(doc.Members) To Ubound(doc.Members))
For index = Lbound(doc.Members) To Ubound(doc.Members)
serverList(index) = doc.Members(index)
End If ‘ grab each database
Redim db(Lbound(serverList) To Ubound(serverList))
For index = Lbound(serverList) To Ubound(serverList)
Set db(index) = GetDbByTitle(serverList(index), user)
If Not db(index) Is Nothing Then numDbs = numDbs + 1
Next If numDbs = 0 Then
‘ tell admin that there are no state dbs found
Messagebox("No State database for " & user & " were found.")
If numDbs = 1 Then
‘ find the active Db
For index = Lbound(serverList) To Ubound(serverList)
If Not db(index) Is Nothing Then Exit For
Next ‘ let the admin know which server the db was found on and prompt to delete
msg = "State database for " & user & " only found on " & db(index).Server & ". Do you want to delete this file?"
‘ prompt to delete all replicas
msg = "Are you sure you want to delete the " & numDbs & " state databases for " & user & "?"
End If If Messagebox(msg, msgBoxOptions) = yes Then deleteDbs = True
End If ‘ delete the dbs
If deleteDbs Then
For index = Lbound(serverList) To Ubound(serverList)
If Not db(index) Is Nothing Then db(index).Remove
End If
End Sub Function GetDbByTitle(serverName As String,userName As String) As NotesDatabase
On Error Goto ExitSub
Dim server As NotesDbDirectory
Dim db1 As NotesDatabase, db2 As NotesDatabase ‘ Find db on server
Set server = New NotesDbDirectory(serverName)
Set db1 = server.GetFirstDatabase(DATABASE)
While Not (db1 Is Nothing)
If userName = db1.Title Then
If db2 Is Nothing Then
Set db2 = db1
Msgbox "Duplicate db title found on "& serverName
Exit Function
End If
End If
Set db1 = server.GetNextDatabase
Wend ExitSub: Set GetDbByTitle = db2
Exit Function
End Function

Original source : http://www.openntf.org/projects/codebin/codebin.ns…


Written by lotusnotes

Январь 28, 2009 в 1:49

Опубликовано в Lotus Notes

Добавить комментарий

Please log in using one of these methods to post your comment:

Логотип WordPress.com

Для комментария используется ваша учётная запись WordPress.com. Выход / Изменить )

Фотография Twitter

Для комментария используется ваша учётная запись Twitter. Выход / Изменить )

Фотография Facebook

Для комментария используется ваша учётная запись Facebook. Выход / Изменить )

Google+ photo

Для комментария используется ваша учётная запись Google+. Выход / Изменить )

Connecting to %s

%d такие блоггеры, как: