Computer der gegenwärtigen Domäne auslesen Alle Namen der Computer der gegenwärtigen Domäne (LDAP) auslesen
Autor:   Dennis Hemken	Bewertung:	Views:  25.839
gadgets.hemken.org	System:  WinXP, Win8, Win10, Win11	Beispielprojekt auf CD

Mit dieser Funktion ist man in der Lage, alle Computer in der gegenwärtigen Domäne aus dem LDAP, mittels ADSI (ADSI = Active Directory Service Interface) auszulesen und in einem StringArray zurückzugeben.

Um diese Funktion auszuführen, müssen folgende Verweise eingefügt werden:

• Microsoft ActiveX Data Objects 2.5 Libary
• Active DS Type Libary

Quellcode:

Public Function AllComputers() As String()
  Dim conn As New Connection
  Dim rs As Recordset
 
  Dim Root As IADs
  Dim Domain As IADs
 
  Dim strBase As String
  Dim strFilter As String
  Dim strDomain As String
 
  Dim strAttr As String
  Dim strDepth As String
  Dim strQuery As String
  Dim strPC() As String
  Dim nElement As Integer
 
  On Error GoTo ErrHandler
 
  ReDim strPC(0) As String
 
  ' Pfad der gegenwärtigen Domäne (LDAP) einholen
  Set Root = GetObject("LDAP://rootDSE")
  strDomain = Root.Get("defaultNamingContext")
  Set Domain = GetObject("LDAP://" & strDomain)
 
  ' LDAP Base DN setzen
  strBase = "<" & Domain.ADsPath & ">"
 
  ' Filter auf die Kategorie Computer setzen
  strFilter = "(&(objectCategory=Computer))"
 
  ' Attribut setzen
  strAttr = "name"
 
  ' Suchtiefe setzen
  strDepth = "subTree"
 
  ' Abfrage zusammen setzen
  strQuery = strBase & ";" & strFilter & ";" & strAttr & ";" & strDepth
 
  ' Verbindung öffnen
  conn.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject"
 
  ' Query ausführen
  Set rs = conn.Execute(strQuery)
 
  Do While Not rs.EOF
    If strPC(0) = "" Then
      nElement = 0
    Else
      nElement = nElement + 1
    End If
 
    ' das Array Redimensionieren
    ReDim Preserve strPC(nElement) As String
 
    ' Den Computernamen in das Array schreiben
    strPC(nElement) = rs("name")
    rs.MoveNext
  Loop
 
  ' Das StringArray zurückgeben
  AllComputers = strPC
 
  If rs.State <> 0 Then rs.Close
  If conn.State <> 0 Then conn.Close
 
' Error Handling
ErrHandler:
  On Error Resume Next
  AllComputers = strPC
  Set rs = Nothing
  Set conn = Nothing
  Set Root = Nothing
  Set Domain = Nothing
End Function

Beispiel für den Auruf der Funktion:

Private Sub Command1_Click()
  Dim strA() As String
  Dim lI As Long
 
  strA = AllComputers    
  If Not strA(0) = "" Then
    For lI = 0 To UBound(strA)
      Debug.Print strA(lI)
    Next
  End If
End Sub

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.