Tipp vom 18.10.2006
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.RecordsetDim 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
|
Sie können hier bei vbarchiv.net für mich voten!
Tags: Active Directory Service Interface, ADSI, LDAP, Microsoft Visual Studio, VB 6.0, Visual Basic
Keine Kommentare »