Tous les serveurs d'un cluster

[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