ivirusyx
Jun 19, 2012, updated at 08:39:00 (UTC)
view7132
view5
0
Goto Top

Visual Basic 2010 - Alle Gruppen aus der Active Directory auflisten, aber wie?

GermansolvedQuestionVisual StudioDevelopment
Hallo liebe Administratoren,
ich versuche mich mal wieder am programmieren und versuche aus Beispielen im Internet zu lernen.

Ich habe mir diesmal zur Aufgabe gesetzt mit der Active Directory zu arbeiten und diese in einem ersten Schritt zu durchsuchen. Ich habe es schon fertig gebracht mit "DirectorySearcher" eine Telefon-Nummer anhand von Vor- und Nachnamen zu finden. Oder herauszufinden ob eine EmployeeID schon vergeben ist, etc...

Nun versuche ich sämtliche Gruppen in unserer Domäne zu suchen und diese dann in einer ListBox aufzulisten. Ich habe folgenden Code gefunden, jedoch kriege ich ihn nicht zu meinen wünschen umgewandelt und verstehe ihn nicht ganz.
Wenn ich ihn so wie unten angegeben ausführe, dann klappt es tadellos, jedoch setze ich die "For Each group As String..." Befehlszeilen in einen Button_Click dann kriege ich einen "NullReferenceException" Fehler.

Was macht eigentlich der "Debug.Print"-Befehl? Wie kann ich den Code so umschreiben dass er mir alle Gruppen in eine ListBox schreibt?

Ich brauche nicht unbedingt eine direkte Lösung, aber einen Hinweis in die richtige Richtung wäre nett, am besten aber auf Deutsch... face-smile

Und dann versuche ich den nächsten Schritt: Nur die "Global Groups" raus filtern....

Danke für eure Hilfe und euren Rat.

MFG
iVirus


Imports System.DirectoryServices

Public Class Form1

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    For Each group As String In GetGroups()
        Debug.Print(group)
    Next
End Sub

Public Function GetGroups() As List(Of String)
    Dim objADAM As DirectoryEntry                   ' Binding object.  
    Dim objGroupEntry As DirectoryEntry             ' Group Results.  
    Dim objSearchADAM As DirectorySearcher          ' Search object.  
    Dim objSearchResults As SearchResultCollection  ' Results collection.  
    Dim strPath As String                           ' Binding path.  
    Dim result As New List(Of String)

    ' Construct the binding string.          
    strPath = "LDAP://stefanserver.stefannet.local" 'Change to your ADserver  

    ' Get the AD LDS object.  
    Try
        objADAM = New DirectoryEntry(strPath)
        objADAM.RefreshCache()
    Catch e As Exception
        Throw e
    End Try

    ' Get search object, specify filter and scope,  
    ' perform search.  
    Try
        objSearchADAM = New DirectorySearcher(objADAM)
        objSearchADAM.Filter = "(&(objectClass=group))"  
        objSearchADAM.SearchScope = SearchScope.Subtree
        objSearchResults = objSearchADAM.FindAll()
    Catch e As Exception
        Throw e
    End Try

    ' Enumerate groups  
    Try
        If objSearchResults.Count <> 0 Then
            Dim objResult As SearchResult
            For Each objResult In objSearchResults
                objGroupEntry = objResult.GetDirectoryEntry
                result.Add(objGroupEntry.Name)
            Next objResult
        Else
            Throw New Exception("No groups found")  
        End If
    Catch e As Exception
        Throw New Exception(e.Message)
    End Try

    Return Nothing
End Function
End Class
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 186679

Url: https://administrator.de/contentid/186679

Printed on: April 25, 2024 at 08:04 o'clock

5 Comments
Latest comment
Goto Top
Member: DerWoWusste
DerWoWusste Jun 19, 2012 at 08:45:45 (UTC)
Goto Top
Ich hätte da ein schönes VBscript, was Du als Gruppen.hta speichern kannst. Teste mal
<Html>
<Head>
<Title>List Group Members</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_members.Style.Width = 500
    	Set objRootDSE = GetObject("LDAP://RootDSE")  
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")  
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)  
		EnumerateGroups strBaseConnString
		Show_Group_Selection
	End Sub
 
	Sub Clear_Members
		For intListProgress = 1 To lst_members.Length
	   		lst_members.Remove 0
	   	Next
	End Sub
 
	Sub EnumerateGroups(strDNSDomain)
		Const ADS_SCOPE_SUBTREE = 2
		Const adVarChar = 200
		Const MaxCharacters = 255
		
		Set objConnection = CreateObject("ADODB.Connection")  
		Set objCommand =   CreateObject("ADODB.Command")  
		objConnection.Provider = "ADsDSOObject"  
		objConnection.Open "Active Directory Provider"  
		Set objCommand.ActiveConnection = objConnection
		
		objCommand.Properties("Page Size") = 1000  
		objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE   
		
		objCommand.CommandText = "SELECT Name, distinguishedName FROM 'LDAP://" & strDNSDomain & "' WHERE objectClass='group'"  
		Set objRecordSet = objCommand.Execute
		
		Set objDataList = CreateObject("ADOR.Recordset")  
		objDataList.Fields.Append "name", adVarChar, MaxCharacters  
		objDataList.Fields.Append "distinguishedName", adVarChar, MaxCharacters  
		objDataList.Open
		
		While Not objRecordSet.EOF
		    objDataList.AddNew
		    objDataList("name") = objRecordSet.Fields("name").Value  
		    objDataList("distinguishedName") = objRecordSet.Fields("distinguishedName").Value  
		    objDataList.Update
			objRecordSet.MoveNext
		Wend
		objRecordSet.Close
		objDataList.Sort = "name"  
		objDataList.MoveFirst
		While Not objDataList.EOF
			Set objActiveOption = Document.CreateElement("OPTION")  
    		objActiveOption.Text = objDataList.Fields("name").Value  
	    	objActiveOption.Value = objDataList.Fields("distinguishedName").Value  
	    	lst_GroupFilter.Add objActiveOption
	    	objDataList.MoveNext
		Wend
		objDataList.Close
	End Sub
 
	Sub Show_Group_Selection
		span_GroupFilter.InnerHTML = lst_GroupFilter.Value
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Const adVarChar = 200
		Const MaxCharacters = 255

		Clear_Members

		Set objGroup = GetObject("LDAP://" & lst_groupfilter.Value)  
		Set objDataList = CreateObject("ADOR.Recordset")  
		objDataList.Fields.Append "name", adVarChar, MaxCharacters  
		objDataList.Fields.Append "distinguishedName", adVarChar, MaxCharacters  
		objDataList.Open
		
		For Each objObject In objGroup.Members
		    objDataList.AddNew
		    objDataList("name") = objObject.cn  
		    objDataList("distinguishedName") = objObject.distinguishedName  
		    objDataList.Update
		Next
		objDataList.Sort = "name"  
		If Not objDataList.BOF Then objDataList.MoveFirst
		While Not objDataList.EOF
			Set objMember = Document.CreateElement("OPTION")  
    		objMember.Text = objDataList.Fields("name").Value  
	    	objMember.Value = objDataList.Fields("distinguishedName").Value  
	    	lst_members.Add objMember
	    	objDataList.MoveNext
		Wend
		objDataList.Close
	End Sub
	
	Sub ExporT_To_TXT
	    If Mid(document.location, 6, 3) = "///" Then  
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)  
	    Else
	    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)  
	    End If
		strFileName = Left(strHTAPath, InStrRev(strHTAPath, "\")) & lst_GroupFilter.Item(lst_GroupFilter.SelectedIndex).Text & ".txt"  
		strFileName = InputBox("Enter file name to save as:", "Save As", strFileName)  
		If strFileName <> "" Then  
			Set objFSO = CreateObject("Scripting.FileSystemObject")  
			Set objFile = objFSO.CreateTextFile(strFileName, True)
			objFile.WriteLine "Group Distinguished Name: " & lst_groupfilter.Value  
			For Each objOption In lst_members
				objFile.WriteLine objOption.Text
			Next
			objFile.Close
			MsgBox "File saved."  
		End If
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>  
	<table height="90%" width= "90%" border="0" align="center">  
		<tr>
			<td align="center" colspan="2">  
				<h2>List Group Members</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Group Filter:</b>
			</td>
			<td>
			    <select size='1' name='lst_GroupFilter'  onChange='vbs:Show_Group_Selection'>  
				</select>
			</td>
		</tr>
		<tr>
			<td colspan=2>
				<b>Group Selected:</b>&nbsp&nbsp&nbsp<span id='span_GroupFilter'></span>  
			</td>
		</tr>		<tr>
			<td>
				<b>Members:</b>
			</td>
			<td>
			    <select size='8' name='lst_members'>  
				</select>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">  
		<tr align="center">  
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>  
			</td>
			<td>
				<button name="btn_export" id="btn_export" accessKey="E" onclick="vbs:Export_To_TXT"><u>E</u>xport to TXT</button>  
			</td>
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>  
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Quelle: RobSampson @experts-exchange.com
Mitglied: 76109
76109 Jun 19, 2012 at 08:55:28 (UTC)
Goto Top
Hallo iVirus!

Debug.Print ist eine Ausgabe in das Direkt-Fenster (Ansicht: Direktfenster) und ist sinnvoll, um z.B. eine Text-Block-Ausgabe anzusehen. Im Prinzip wie eine MsgBox-Ausgabe

Eine 'For Each'-Aufzählung funktioniert nur mit Objecten oder Arrays (As Object, As Variant)...

Gruß Dieter
Member: iVirusYx
iVirusYx Jun 19, 2012 updated at 09:25:59 (UTC)
Goto Top
Ich habe den Fehler selber gefunden face-smile
Der Programmierer der den Code veröffentlichen hat, der hat einen Fehler drin der das ganze ruiniert.

Und zwar schreibt er:
Return Nothing

Und es müsste sein:
Return result

Danke an Didi, ich hatte im Direkt-Fenster auch einen "NullReferenceException"-Fehler und war dann nachlesen was das heißt face-smile
Das Script gibt mir jetzt alle Gruppen zurück wie ich es wollte.

Hier ist die zusammen-geschnittene Kurzform ohne Fehlererkennung (Achtung! Really Dirty Code ahead! Werden den gleich aufräumen)

    Public Function GetAllGroups() As List(Of String)
        Dim entry As DirectoryEntry = New DirectoryEntry("LDAP://youdomain")  
        Dim search As New DirectorySearcher(entry)
        Dim objSearchResults As SearchResultCollection
        Dim objGroupEntry As DirectoryEntry
        Dim result As New List(Of String)

        search.Filter = "(&(objectClass=group))"  
        search.SearchScope = SearchScope.Subtree
        objSearchResults = search.FindAll()


        Dim objResult As SearchResult
        For Each objResult In objSearchResults
            objGroupEntry = objResult.GetDirectoryEntry
            result.Add(objGroupEntry.Name)
        Next objResult

        Return result
    End Function

    Private Sub frmForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        For Each group As String In GetAllGroups()
            Debug.Print(group)
        Next
    End Sub

Um nun das Ganze auf Knopfdruck in eine ListBox zu schreiben braucht man also nur folgenden Code:

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        
        For Each group As String In GetAllGroups()
            ListBox1.Items.Add(group)
        Next

    End Sub
Member: jan99
jan99 Mar 17, 2020 at 15:13:08 (UTC)
Goto Top
Moin!

ich habe mir den Code ohne Fehler auch gerade gezogen und es wird auch das aufgelistet, was ich such.

Aber eines stimmt mich nachdenklich. Es werden genau 1000 Gruppen ermittelt. Irgendwie kann ich mir aber nicht vorstellen, dass es genau 1000 sind.

Wie ist mit der Problematik umzugehen?

Gruß Jan
Member: DerWoWusste
DerWoWusste Mar 17, 2020 at 17:29:12 (UTC)
Goto Top
Erstelle eine weitere Gruppe. Werden danach 1001 gefunden?
GermansolvedQuestionVisual StudioDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments