In this function we'll run a query against Active Directory to obtain
properties for the current account logged onto our application. First we'll
specify an array of the properties we want to retrieve from AD, then pass it to
our GetADsObject method (later in this article), and set authentication to AD in
order to run and retrieve information from our query.
Private Const _FILTER As String = "(&(ObjectClass={0})(sAMAccountName={1}))"
Private Const _FOREST = 5 'Default for a Forest objectClass
Private Const _DOMAINCHILD = 13 'Default for a Domain objectClass
Private Const _UNIVERSAL_SECURITY = -2147483640
Private Const _GLOBAL_SECURITY = -2147483646
Dim sLoadProps As String() = {"givenName", "sn", "StreetAddress", "l", _
"PostalCode", "co", "telephonenumber", "mail"}
Dim loginUser As String = "MyUser"
Dim userInfo As DirectoryEntry = GetADsObject("person", loginUser, sLoadProps, False)
If Not userInfo Is Nothing Then
'set authentication info for using ADs, feel free to create
'a function for authenticating to AD.
userInfo.AuthenticationType = AuthenticationTypes.Delegation
userInfo.Username = "username"
userInfo.Password = "password"
With userInfo
'Get properties
Dim fName As String = CheckForNothing(.Properties("GivenName").Value)
Dim lName As String = CheckForNothing(.Properties("sn").Value)
Dim sStreet As String = CheckForNothing(.Properties("StreetAddress").Value)
Dim sCity As String = CheckForNothing(.Properties("l").Value)
Dim sPostalCode As String = CheckForNothing(.Properties("PostalCode").Value)
Dim sCountry As String = CheckForNothing(.Properties("co").Value)
Dim sTelephone As String = CheckForNothing(.Properties("telephonenumber").Value)
Dim sUserName As String = LoginID
Dim sMail As String = CheckForNothing(.Properties("mail").Value)
'Update ADs properties
.Properties("GivenName").Value = FirstName
.Properties("sn").Value = LastName
.Properties("StreetAddress").Value = Street
.Properties("l").Value = City
.Properties("PostalCode").Value = PostalCode
.Properties("co").Value = countryName
.Properties("c").Value = countryCode
.Properties("telephonenumber").Value = Telephone
.Properties("mail").Value = Email
'Save changes
.CommitChanges()
End With
End If
::
::
::
::
::
'function to make sure we check for null.
Private Function CheckForNothing(ByVal value As Object) As String
If value Is Nothing Then
Return ""
Else
Return value.ToString
End If
End Function
Obtaining Group Membership for a User
In the next block of code we'll pass our user information and obtain the
group membership for the user account:
Dim sLoadProps As String() = {"memberOf"}
'Get Directory Entry object
Dim userInfo As DirectoryEntry = GetADsObject("person", loginUser, sLoadProps, False)
If Not userInfo Is Nothing Then
'set authentication info for using ADs, feel free to create
'a function for authenticating to AD.
userInfo.AuthenticationType = AuthenticationTypes.Delegation
userInfo.Username = "username"
userInfo.Password = "password"
Dim iCount As Integer = userInfo.Properties("MemberOf").Count
If iCount > 0 Then
'Retrive group membership from Windows ADs and add to arraylist
For i = 0 To iCount - 1
Dim gADs As String = userInfo.Properties("MemberOf").Item(i)
Dim myGroup As String = Left(gADs, (InStr(gADs, ",") - 1))
arrGroup.Add(myGroup.Replace("CN=", ""))
Next
End If
End If
Creating New Groups in AD
In the next method we'll create a new group within Active Directory:
Dim groupName As String = "MyGroup"
Dim Description As String = "MyGroup Description"
Dim strNameContext As String = root.Get("DefaultNamingContext")
Dim ADsContainer As New DirectoryEntry("LDAP://CN=users," + strNameContext)'set authentication info for using ADs, feel free to create
'a function for authenticating to AD.
ADsContainer.AuthenticationType = AuthenticationTypes.Delegation
ADsContainer.Username = "username"
ADsContainer.Password = "password"
Dim newGroup As DirectoryEntry = ADsContainer.Children.Add("CN=" + groupName, "group")
With newGroup
.Properties("saMAccountname").Value = groupName
.Properties("groupType").Value = _UNIVERSAL_SECURITY
.Properties("Description").Value = Description
.CommitChanges()
End With
Updating an AD Group
In this next method we'll update properties for a group. We can rename the
group, or change description.
Dim groupName As String = "MyGroup"
Dim sLoadProps As String() = {"name", "Description"}
'Get group object in ADs
Dim grp As DirectoryEntry = GetADsObject("group", groupName, sLoadProps, True)
If Not grp Is Nothing Then
'set authentication info for using ADs, feel free to create
'a function for authenticating to AD.
grp.AuthenticationType = AuthenticationTypes.Delegation
grp.Username = "username"
grp.Password = "password"
With grp
If LCase(groupName) <> LCase(newGroupName) Then
.Rename("CN=" + newGroupName)
End If
.Properties("Description").Value = Description
'Save change
.CommitChanges()
End With
End If
Deleting an AD Group
Now we'll delete the newly created group from AD.
Dim groupName As String = "MyGroup"
Dim sLoadProps As String() = {"name", "Description"}
'Get group object in ADs
Dim grp As DirectoryEntry = GetADsObject("group", groupName, sLoadProps, True)
If Not grp Is Nothing Then
'set authentication info for using ADs, feel free to create
'a function for authenticating to AD.
grp.AuthenticationType = AuthenticationTypes.Delegation
grp.Username = "username"
grp.Password = "password"
grp.DeleteTree()
grp.CommitChanges()
End If
Adding a User to a Group
We've gone over users and groups, now lets add a user to a group.
'Get object in ADs
Dim usr As DirectoryEntry = GetADsObject("person", loginUser, sUserProps, False)
Dim grp As DirectoryEntry = GetADsObject("group", groupName, sLoadProps, True)
If Not grp Is Nothing And Not usr Is Nothing Then
'set authentication info for using ADs, feel free to create
'a function for authenticating to AD.
usr.AuthenticationType = AuthenticationTypes.Delegation
usr.Username = "username"
usr.Password = "password"
grp.AuthenticationType = AuthenticationTypes.Delegation
grp.Username = "username"
grp.Password = "password"
If Not IsMember(usr, grp) Then
Dim strDisName As String = usr.Properties("distinguishedName").Value
grp.Properties("Member").Add(strDisName)
grp.CommitChanges()
End If
End If
Removing a User from an AD Group
Now remove the user from the group that the account was added to.
Dim loginUser As String = Right(loginID, Len(loginID) - InStr(loginID, "\"))
Dim sUserProps As String() = {"name", "distinguishedName"}
Dim groupName As String = RoleName
Dim sLoadProps As String() = {"member"}
'Get user & group object in ADs
Dim usr As DirectoryEntry = GetADsObject("person", loginUser, sUserProps, False)
Dim grp As DirectoryEntry = GetADsObject("group", groupName, sLoadProps, True)
If Not grp Is Nothing And Not usr Is Nothing Then
'set authentication info for using ADs, feel free to create
'a function for authenticating to AD.
usr.AuthenticationType = AuthenticationTypes.Delegation
usr.Username = "username"
usr.Password = "password"
grp.AuthenticationType = AuthenticationTypes.Delegation
grp.Username = "username"
grp.Password = "password"
If IsMember(usr, grp) Then
Dim strDisName As String = usr.Properties("distinguishedName").Value
grp.Properties("member").Remove(strDisName)
grp.CommitChanges()
End If
End If
GetADsObject Function
The following function accepts the type of object (ADsType) you wish to query
in AD, the name of the object, for example the user account, an array of
properties, and a Boolean value for specifying whether or not to query an LDAP
path or the Global Catalog for your AD.
Private Function GetADsObject(ByVal ADsType As String, ByVal ADsName As String, _
ByVal LoadProps As String(), ByVal LDAP As Boolean) As DirectoryEntry
Dim ADsFilter As String = String.Format(_FILTER, ADsType, ADsName)
Dim strRootForest As String
'Get RootDomain for your AD forest.
If LDAP Then
strRootForest = "LDAP://" & ADsRoot.get("rootDomainNamingContext") Else
strRootForest = "GC://" & ADsRoot.get("rootDomainNamingContext") End If
Dim root As New DirectoryEntry(strRootForest)
root.AuthenticationType = AuthenticationTypes.Delegation
root.Username = "username"
root.Password = "password"
Dim searcher As New System.DirectoryServices.DirectorySearcher(root)
searcher.SearchScope = SearchScope.Subtree
searcher.ReferralChasing = ReferralChasingOption.All
searcher.PropertiesToLoad.AddRange(LoadProps)
searcher.Filter = ADsFilter
Dim search As SearchResult = searcher.FindOne()
Dim ADsObject As DirectoryEntry = search.GetDirectoryEntry
Return ADsObject
End Function
By: Patrick Santry, Microsoft MVP (ASP/ASP.NET), developer of this site, author of books on Web technologies, and member of the DotNetNuke core development team. If you're interested in the services provided by Patrick, visit his company Website at Santry.com.