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 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
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
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
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
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
tempstr = result.Properties("telephoneNumber")(0).ToString()
If (Left(tempstr, 1) = "+") Then
tempstr = tempstr.TrimStart("+")End If
dr(1) = tempstr
tempstr = result.Properties("physicalDeliveryOfficeName")(0).ToString()