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:
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.563 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||||||
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. |