Active Directory - AD Group member Add/Remove, Other useful snippets for AD

FindFocusedControl

    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


SetADProperty

    Public Shared Sub SetADProperty(ByVal de As DirectoryEntry,

       ByVal pName As String, ByVal pValue As String)

        'First make sure the property value isnt "nothing"

        de.Properties(pName).Value = pValue

        de.CommitChanges()

    End Sub


IsInGroup

    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

FindEntry

    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

FindEntries

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

DeleteUserFromGroup

    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

AddUserToGroup


    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


btnAddGroups_Click

    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


GetUserGroups

    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


RecursiveGetGroups

    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


RemoveMemberToGroup

    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  


Authenticate to AD and check Group Membership

Example is based on the FindEntry. Modified to test group membership. Not Recursive at this point. I highlighted the area that you can put a custom group in. If you just want authentication, remove out the code for groups

Essentially, to validate a user log in, you query the domain [for their own record] using the credentials provided. If the creds provided do not work, you can safely assume a bad user/pass combonation

Private Function GetUserGroups(ByVal sAMAccountName As String, ByVal sPassword As String) As Boolean

        Try

            Using RootDE As New DirectoryEntry

                RootDE.Username = "DOMAIN\" & sAMAccountName

                RootDE.Password = sPassword

                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

                        Return False

                    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(","))

                            If GroupName = "GRP-CTCRightFaxLookup" Then Return True

                            ' RecursiveGetGroups(Searcher, GroupList, GroupName)

                        Next

                        ' Return GroupList

                    End If

                End Using

            End Using

        Catch ex As Exception

        End Try

        Return False

    End Function


Combobox convenience

FillComboBox


  Sub FillComboBox(cmbBox As ComboBox)
        Try
            If cmbBox.Items.Count > 0 Then cmbBox.Items.Clear()
            Dim sLines As String = My.Computer.FileSystem.ReadAllText(Environment.GetEnvironmentVariable("APPDATA") & "\ChadRocks\chadrocks_combolist.txt")
            For Each sLine In Split(sLines, vbCrLf)
                If Len(sLine) > 0 And Not cmbBox.Items.Contains(sLine) Then
                    cmbBox.Items.Add(sLine)
                End If
            Next
        Catch
        End Try
    End Sub

SaveEntry


    Sub SaveEntry(text As String)
        If My.Computer.FileSystem.DirectoryExists(Environment.GetEnvironmentVariable("APPDATA") & "\ChadRocks") Then
        Else
            My.Computer.FileSystem.CreateDirectory(Environment.GetEnvironmentVariable("APPDATA") & "\ChadRocks")
        End If

        txtFilter.Items.Add(text)
    End Sub

SaveComboBox


  Sub SaveComboBox(cmbBox As ComboBox)
        Debug.Print("Saving")
        'My.Computer.FileSystem.ReadAllText(Environment.GetEnvironmentVariable("APPDATA") & "\CrouseHospitalFaxCompanion\combolist.txt")
        If My.Computer.FileSystem.DirectoryExists(Environment.GetEnvironmentVariable("APPDATA") & "\ChadRocks") Then
        Else
            My.Computer.FileSystem.CreateDirectory(Environment.GetEnvironmentVariable("APPDATA") & "\ChadRocks")
        End If
        Dim sTxt As String = ""
        For Each sLine In cmbBox.Items
            sTxt = sTxt & sLine & vbCrLf
        Next
        My.Computer.FileSystem.WriteAllText(Environment.GetEnvironmentVariable("APPDATA") & "\ChadRocks\ChadRocks_combolist.txt", sTxt, False)
    End Sub



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

GetCNfromsAMAccountName


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

GetDomainLessUsername


    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

GetsUsernameFRomCN


    Function GetsUsernameFRomCN(sName As String) As String

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

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

    End Function

Another way To add and remove AD groups. A simpler approach

    Private Sub RemoveMemberToGroup(ByVal bindString As String, ByVal newMember As String)

       

        Dim ent As New DirectoryEntry("LDAP://FULL DN to Group", "domain\username", "password")

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

        ent.CommitChanges()

  

    End Sub

   

    Function AddUserToGroup(ByVal newMember As String, ByVal bindString As String) As String

        Dim ent As New DirectoryEntry("LDAP://FULL DN to Group", "domain\username", "password")

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

        ent.CommitChanges()

    End Function