vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: HTML/Internet/Netzwerk · Netzwerk   |   VB-Versionen: VB618.10.06
Benutzer der gegenwärtigen Domäne auslesen

Dieser Tipp zeigt, wie sich die Benutzer und deren angelegten Daten in der gegenwärtigen Domäne aus dem LDAP, mittels ADSI, auslesen lassen

Autor:   Dennis HemkenBewertung:     [ Jetzt bewerten ]Views:  39.473 
gadgets.hemken.orgSystem:  WinXP, Win8, Win10, Win11 Beispielprojekt auf CD 

Mit dieser Funktion ist man in der Lage, alle Benutzer und deren angelegte Daten in der gegenwärtigen Domäne aus dem LDAP, mittels ADSI (ADSI = Active Directory Service Interface) auszulesen und in einem StringArray zurückzugeben. Eine andere Funktion, die sich ebenfalls mit dem Auslesen des LDAP beschäftigt, findet ihr hier:  Computer der gegenwärtigen Domäne auslesen.

Ergänzung: Diese beiden Funktionen können, so wie sie hier stehen, nur mit VB6 ausgeführt werden, da die Vorgängerversionen noch kein StringArray kennen.

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

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

Die Funktion arbeitet mit einem Übergabeparameter, der das Attribut beinhaltet, das ausgelesen werden soll.

Quellcode:

Public Function AllUsers(ByVal strAttr As String) As String()
  ' ###################################################################
  ' Hier sind noch einige Attribut-Beispiele
  ' strAttr = "name"  oder strAttr = "cn"   Vorname (Bsp: Peter)
  ' strAttr = "sn"                          Name (Bsp: Müller)
  ' strAttr = "samaccountName"              Kuerzel (Bsp: hede)
  ' strAttr = "telephoneNumber"             Telefon (Bsp: 0815/123)
  ' strAttr = "mail"                        Email (Bsp: asdfg@asdfg.de)
  ' strAttr = "title"                       Titel (Bsp: Dr.)
  ' strAttr = "homeDrive"                   Home-Verzeichnis (Bsp: H:)
  ' strAttr = "physicalDeliveryOfficeName"  Raumnummer (Bsp: C 120)
  ' strAttr = "company"                     Firma (Bsp: Firma GmbH)
  ' strAttr = "postalCode"                  PLZ (Bsp: 12345)
  ' strAttr = "st"                          Bundesland (Bsp: NRW)
  ' strAttr = "streetAddress"               Strasse (Bsp: Am Wald 9a)
  ' strAttr = "l"                           Stadt (Bsp: Köln)
  ' strAttr = "department"                  Abteilung (Bsp: IT)
  ' ###################################################################
  Dim conn As New ADODB.Connection
  Dim Rs As ADODB.Recordset
 
  Dim Root As IADs
  Dim Domain As IADs
 
  Dim strBase As String
  Dim strFilter As String
  Dim strDomain As String
 
  Dim strDepth As String
  Dim strQuery As String
  Dim strUser() As String
  Dim iElement As Integer
 
  ' Fehlerbehandlung aktivieren
  On Error GoTo ErrHandler
 
  ReDim strUser(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 Person und Klasse User setzen
  strFilter = "(&(objectCategory=person)(objectClass=user))"
 
  ' falls kein Attribut übergeben wurde, wird es auf ein
  ' beliebiges Standard gesetzt, Bsp: name
  If strAttr = "" Then 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)
 
  With Rs
    Do While Not .EOF
      On Error Resume Next
      If strUser(0) = "" Then
        iElement = 0
      Else
        iElement = iElement + 1
      End If
 
      ' das Array Redimensionieren
      ReDim Preserve strUser(iElement) As String
 
      ' Das ausgewählte Attribut (hier: "mail"->Funkstionsübergabe)
      ' in das Array schreiben
      strUser(iElement) = Rs.Fields(strAttr)
 
      .MoveNext
    Loop
  End With
 
  If Rs.State <> 0 Then Rs.Close
  If conn.State <> 0 Then conn.Close
 
ErrExit:
  ' Das StringArray zurückgeben
  AllUsers = strUser
 
  ' Objekte schließen und zerstören
  On Error Resume Next
  Rs.Close
  conn.Close
  Set Rs = Nothing
  Set conn = Nothing
  Set Root = Nothing
  Set Domain = Nothing
  Exit Function
 
ErrHandler:
  Resume ErrExit
End Function

Beispiel für den Auruf der Funktion:

Private Sub Command1_Click()
  Dim strA() As String
  Dim i As Long
 
  ' Funktionsaufruf mit dem Attribut "mail"
  strA = AllUsers("mail")
  If Not strA(0) = "" Then
    For i = 0 To UBound(strA)
      Debug.Print strA(i)
    Next
  End If
End Sub

Dieser Tipp wurde bereits 39.473 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (1 Beitrag)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel