Hier gelistet ist der Source Code zu der Prozedur Organisationseinheiten (OU) einer Active Directory Struktur ermitteln.
Das ganze ist eingebettet in ein VB6 Formular als ein eigener Menüpunkt.
Const ADS_SCOPE_SUBTREE = 2
Const ADS_CHASE_REFERRALS_EXTERNAL = 64
' diesen Domänencontroller abfragen:
Kontrollfeld.Text = ""
ldap = "LDAP://" & Domain.Text 'wird aus dem Feld Domain übernommen
Query = "objectCategory='organizationalUnit'"
' Verbindung einrichten:
Set Connection = CreateObject("ADODB.Connection")
Connection.Provider = "ADsDSOObject"
Connection.Open "Active Directory Provider"
' SQL-Befehl initialisieren:
Set Command = CreateObject("ADODB.Command")
Set Command.ActiveConnection = Connection
Command.CommandText = "select AdsPath from_
'" & ldap & "' where " & Query &_
" ORDER BY whenCreated DESC"
Command.Properties("Page Size") = 10000
Command.Properties("Timeout") = 30
Command.Properties("searchscope") =_
ADS_SCOPE_SUBTREE
Command.Properties("Chase referrals") =_
ADS_CHASE_REFERRALS_EXTERNAL
Command.Properties("Cache Results") = False
Set rs = Command.Execute
' Ergebnis anzeigen
If Not rs.EOF Then
i = 1
tmp = rs.getString
Kontrollfeld.Refresh
Form1.Refresh
While (InStr(1, tmp, Chr(13))) <> 0
laenge = Len(tmp)
komma = InStr(1, tmp, Chr(13))
OUString(i) = Mid(tmp, 1, komma - 1)
Kontrollfeld.Text = Kontrollfeld.Text_
& OUString(i) & vbCrLf
ListeOU.AddItem OUString(i)
rest = laenge - komma
tmp = Right(tmp, rest)
i = i + 1
Kontrollfeld.Refresh
Form1.Refresh
Wend
Else
Kontrollfeld.Text = Kontrollfeld.Text & "Keine Ergebnisse..."
End If
Die Ausführung bestimmter Tools erfordert spezielle Rechte (administrativer Art). Ich übernehme keinerlei Gewähleistung für evtl. auftretende Schäden. Sie benutzen das Tool auf eigene Gefahr. Bitte sichern Sie zuvor Ihre Daten! Ich übernehme keine Gewähr !!! Falls Fragen sein sollten sendet mir bitte eine Mail an: webmaster@whiteberry.de
