AD Group member Add/Remove, Other useful snippets for AD

    Function FindFocussedControl(ByVal ctr As Control) As Control

        Dim container As ContainerControl = TryCast(ctr, ContainerControl)

        Do While (container IsNot Nothing)

            ctr = container.ActiveControl

            container = TryCast(ctr, ContainerControl)

        Loop

        Return ctr

    End Function


    Public Function IsInGroup(ByVal GroupName As String) As Boolean

        Dim MyIdentity As System.Security.Principal.WindowsIdentity = System.Security.Principal.WindowsIdentity.GetCurrent()

        Dim MyPrincipal As System.Security.Principal.WindowsPrincipal = New System.Security.Principal.WindowsPrincipal(MyIdentity)

        Return MyPrincipal.IsInRole(GroupName)

    End Function

    Function FindEntry(ByVal filter As String, Optional ByVal SearchRoot As String = "") As DirectoryEntry

        Dim ds As New DirectorySearcher

        If SearchRoot <> "" Then ds.SearchRoot = New DirectoryEntry(SearchRoot)

        ds.Filter = filter

        ds.SearchScope = SearchScope.Subtree

        ds.CacheResults = False

        Dim sr = ds.FindOne

        If sr Is Nothing Then Return Nothing

        Return sr.GetDirectoryEntry

        'Dim ent = FindEntry("(&(CN=[groupname])(objectClass=group))")

        'Dim dn = ent.Properties("distinguishedName").Value

    End Function

'Dim ent = FindEntry("(&(CN=[groupname])(objectClass=group))")

    'Dim dn = ent.Properties("distinguishedName").Value


Function FindEntries(ByVal filter As String, Optional ByVal SearchRoot As String = "") As SearchResultCollection

        Dim ds As New DirectorySearcher

        If SearchRoot <> "" Then ds.SearchRoot = New DirectoryEntry(SearchRoot)

        ds.Filter = filter

        ds.SearchScope = SearchScope.Subtree

        ds.CacheResults = False

        Dim sr = ds.FindAll

        If sr Is Nothing Then Return Nothing

        Return sr

        'Dim ent = FindEntry("(&(CN=[groupname])(objectClass=group))")

        'Dim dn = ent.Properties("distinguishedName").Value


    End Function

Example of FindEntries

        For Each oDir As SearchResult In FindEntries("(&(&(& (mailnickname=*)  (objectCategory=group)(managedBy=" & IIf(bShowAll, "*", GetCNfromsAMAccountName(IIf(Len(sUserToOverride) > 0, sUserToOverride, Me.Text))) & "))))")

            Debug.Print(oDir.Properties("name").Item(0).ToString & "  " & oDir.Properties("managedBy").Item(0).ToString)

            cmbListofDLs.Items.Add(oDir.Properties("name").Item(0).ToString)

            ToolStripStatusLabel1.Text = aFunArray(count Mod 4)

            'Threading.Thread.Sleep(50)

            count += 1

            If bCancel Then Exit For

        Next

End Example

    Private Sub AddMemberToGroup(ByVal bindString As String,

                                      ByVal newMember As String)

        Try

            Debug.Print("Bind: " & "LDAP://" & bindString)

            Debug.Print("newMember: " & newMember)

            Dim ent As New DirectoryEntry("LDAP://" & bindString)

            ent.UsePropertyCache = True

            ent.RefreshCache()

            'ent.Options.SecurityMasks = SecurityMasks.Dacl

            ent.Properties("member").Add(newMember)

            ent.CommitChanges()

        Catch e As Exception

            Console.WriteLine("An error occurred.")

            Console.WriteLine("{0}", e.Message)

            Return

        End Try

    End Sub


    Function DeleteUserFromGroup(ByVal UserName As String, ByVal GroupName As String) As String

        Dim str As New String("LDAP://" & GroupName)

        Dim usergroup As DirectoryEntry = New DirectoryEntry(str)

        usergroup.Invoke("Remove", New Object() {UserName})

        usergroup.CommitChanges()

    End Function


    Function AddUserToGroup(ByVal UserName As String, ByVal GroupName As String) As String

        Dim str As New String("LDAP://" & GroupName)

        Dim usergroup As DirectoryEntry = New DirectoryEntry(str, "domain\user", "password")

        usergroup.Invoke("Add", UserName)

        usergroup.CommitChanges()

    End Function


    Private Sub btnAddGroups_Click(sender As Object, e As EventArgs) Handles btnAddGroups.Click

        Dim sCN As String = ""

        Dim ent = FindEntry("(&(sAMAccountName=" & txtDestination.Text & ")(objectClass=user))")

        sCN = ent.Properties("distinguishedName").Value

        For Each lvItemChecked As ListViewItem In lstSource.Items

            If lvItemChecked.Checked Then

                Debug.Print("Adding: '" & lvItemChecked.Text & "'   to  '" & sCN & "'")

                toolStrip.ForeColor = Color.Green

                toolStrip.Text = "Adding: '" & lvItemChecked.Text & "'   to  '" & sCN & "'"

                Application.DoEvents()

                AddMemberToGroup(lvItemChecked.Text, sCN)

                'AddUserToGroup(sCN, lvItemChecked.Text)

            End If

        Next

        'toolStrip.ForeColor = Color.Black

    End Sub


    Private Function GetUserGroups(ByVal sAMAccountName As String) As List(Of String)

        Try

            Using RootDE As New DirectoryEntry

                Using Searcher As New DirectorySearcher(RootDE)

                    Searcher.Filter = "(&(sAMAccountType=805306368)(sAMAccountName=" & sAMAccountName & "))"

                    Searcher.PropertiesToLoad.Add("memberOf")

                    Dim UserSearchResult As SearchResult = Searcher.FindOne

                    If UserSearchResult Is Nothing Then

                        Throw New ApplicationException("No user with username " & sAMAccountName & " could be found in the domain")

                        Return Nothing

                    Else

                        Dim GroupList As New List(Of String)

                        For Each Group In UserSearchResult.Properties("memberOf")

                            Dim GroupName As String = CStr(Group).Remove(0, 3)

                            GroupName = GroupName.Remove(GroupName.IndexOf(","))

                            RecursiveGetGroups(Searcher, GroupList, GroupName)

                        Next

                        Return GroupList

                    End If

                End Using

            End Using

        Catch ex As Exception

            toolStrip.ForeColor = Color.Red

            toolStrip.Text = "ERROR: " & ex.Message.ToString

        End Try

    End Function


    Private Sub RecursiveGetGroups(ByVal SearcherObject As DirectorySearcher, ByVal CurrentList As List(Of String), ByVal GroupName As String)

        If Not CurrentList.Contains(GroupName) Then

            '*********************************************

            CurrentList.Add(GroupName)

            'Debug.Print("Adding dn=" & dn)

            'CurrentList.Add(dn)

            Return

            '*********************************************

            SearcherObject.Filter = "(&(objectClass=Group)(CN=" & GroupName & "))"

            Dim GroupSearchResult As SearchResult = SearcherObject.FindOne

            If Not GroupSearchResult Is Nothing Then

                For Each Group In GroupSearchResult.Properties("memberOf")

                    Dim ParentGroupName As String = CStr(Group).Remove(0, 3)

                    ParentGroupName = ParentGroupName.Remove(ParentGroupName.IndexOf(","))

                    RecursiveGetGroups(SearcherObject, CurrentList, ParentGroupName)

                Next

            End If

        End If

    End Sub


    Private Sub RemoveMemberToGroup(ByVal bindString As String,

                                       ByVal newMember As String)

        Try

            Dim ent As New DirectoryEntry("LDAP://" & bindString)

            ent.Properties("member").Remove(newMember)

            ent.CommitChanges()

        Catch e As Exception

            Console.WriteLine("An error occurred.")

            Console.WriteLine("{0}", e.Message)

            Return

        End Try

    End Sub



Dim directory As DirectoryEntry = New DirectoryEntry("LDAP://MyDirectory")
Dim filter As String = "(sAMAccountName=acctname)"
Dim findUser As DirectorySearcher = New DirectorySearcher(directory, filter)
Dim results As SearchResultCollection = findUser.FindAll
For Each result As SearchResult In results
    For Each prop As DictionaryEntry In result.Properties
        For Each individualValue As Object In prop.Value
            Console.WriteLine("{0}={1}"}, _
                              prop.Key, _
                              individualValue)
        Next
    Next
Next  


Fill Combobox fast with a Adapter fill

Sub sublateDataFromSQLCLUSTER()

        'http://vb.net-informations.com/dataset/bind-combobox.htm

        '

        '

        Dim connetionString As String = Nothing

        Dim connection As SqlConnection

        Dim command As SqlCommand

        Dim adapter As New SqlDataAdapter()

        Dim ds As New DataSet()

        Dim ds2 As New DataSet()

        Dim i As Integer = 0

        Dim sql As String = Nothing

        connetionString = "Data Source=server;Initial Catalog=master;Trusted_Connection=true;" 'User ID=userid;Password=yourpassword"

        sql = "select sAMAccountName from ADData order by sAMAccountName"

        connection = New SqlConnection(connetionString)

        Try

            connection.Open()

            command = New SqlCommand(sql, connection)

            adapter.SelectCommand = command

            adapter.Fill(ds)

            adapter.Fill(ds2)

            adapter.Dispose()

            command.Dispose()

            connection.Close()

            cmbSource.DataSource = ds.Tables(0)

            cmbSource.ValueMember = "sAMAccountName"

            cmbDestination.DataSource = ds2.Tables(0)

            cmbDestination.ValueMember = "sAMAccountName"

            'ComboBox1.DisplayMember = "au_lname"

        Catch ex As Exception

            MessageBox.Show("Can not open connection ! ")

        End Try

    End Sub

Function GetCNfromsAMAccountName(sName As String) As String

        Debug.Print(sName)

        Dim oDirOwner As DirectoryEntry = FindEntry("(&(sAMAccountName=" & sName & ") (objectCategory=*))")

        Return oDirOwner.Properties("distinguishedName").Item(0).ToString

    End Function


    Function GetDomainLessUsername(sName As String) As String

        Dim oDirOwner As DirectoryEntry = FindEntry("(& (sAMAccountName=" & Replace(sName, Environment.UserDomainName & "\", "") & "))")

        Return oDirOwner.Properties("sAMAccountName").Item(0).ToString

    End Function


    Function GetsUsernameFRomCN(sName As String) As String

        Dim oDirOwner As DirectoryEntry = FindEntry("(&(distinguishedName=" & sName & ") (objectCategory=*))")

        Return oDirOwner.Properties("sAMAccountName").Item(0).ToString

    End Function