Page 1 sur 1
Tous les serveurs d'un cluster
Publié:
01 Oct 2010 à 11:42par Michael DELIQUE
- Code : Tout sélectionner
Function AllServerInCluster(wName As String, wnbClusterName As Boolean) As Variant
'si wnbClusteurName = true, wName contient le nom du cluster ou faire la recherche.
'si wnbClusteurName = false, wName contient le nom d'un serveur dont on veux tout les serveur du meme clusteur
Dim nmServer As NotesName
Dim lstServer List As String
Dim DBNAB As NotesDatabase
Dim vwSearch As NotesView
Dim Doc As NotesDocument
Dim ClusterName As String
Dim Navigator As NotesViewNavigator
Dim Entry As NotesViewEntry
Dim i As Integer
On Error Goto ErreurHandle
lstServer(0)=""
AllServerInCluster = lstServer
If Trim(wName) ="" Then
If wnbClusterName = True Then
Error 9999,"wName Empty (Cluster Name)"
Else
Error 9999,"wName Empty (Server Name)"
End If
Exit Function
End If
If session Is Nothing Or DB Is Nothing Then
Set session = New notesSession
Set DB = Session.CurrentDatabase
End If
'connexion au names
Set DBNAB = DBOpenNAB(DB.Server,True)
If DBNAB Is Nothing Then
Error 9999,"Names.nsf Not Found"
Exit Function
End If
ClusterName = ""
If wnbClusterName = False Then
'va chercher la fiche du server dans lenames pour récupéré le nom du cluster auquel il est rattaché
Set nmServer = New NotesName(wName)
Set vwSearch = DBNAB.GetView("($Servers)")
If vwSearch Is Nothing Then
Error 9999,"vwSearch '($Servers)' is Nothing"
Exit Function
End If
Set Doc = vwSearch.GetDocumentByKey(nmServer.Canonical,True)
If Not Doc Is Nothing Then
ClusterName = Trim(Doc.GetItemValue("ClusterName")(0))
Set Doc = Nothing
End If
Set vwSearch = Nothing
Set nmServer = Nothing
Else
ClusterName = Trim(wName)
End If
'si pas de cluster fin
If ClusterName = "" Then
Erase lstServer
Exit Function
End If
'connexion a la vue des cluster dans le names et récupération
Set vwSearch = DBNAB.GetView("(Clusters)")
If vwSearch Is Nothing Then
Error 9999,"vwSearch '(Clusters)' is Nothing"
Exit Function
End If
Set Navigator = vwSearch.CreateViewNavFromCategory( ClusterName)
If Navigator Is Nothing Then
Set vwSearch = Nothing
Erase lstServer
Exit Function
End If
i=0
'parcour la vue sur la cétégorie du cluster
Set entry = Navigator.GetFirstDocument()
While Not Entry Is Nothing
Set Doc = Entry.Document
If Not doc Is Nothing Then
Set nmServer = New notesName(Doc.GetItemValue("ServerName")(0))
Set Doc = Nothing
lstServer(i) = nmServer.Canonical
i=i+1
Set nmServer = Nothing
End If
Set Entry = Navigator.GetNextDocument(Entry)
Wend
Set Navigator = Nothing
Set vwSearch = Nothing
AllServerInCluster = lstServer
Erase lstServer
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Erase lstServer
lstServer(0)=""
AllServerInCluster = lstServer
Erase lstServer
Exit Function
End Function