Option Declare

' Declarations
'%INCLUDE "LsConst.LSS"
' msgBoxOptions = MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2
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"
Else
' 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)
Next
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.")
Else
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?"
Else
' 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
Next
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
Else
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