Get user by distinguished name using System.DirectoryServices.Protocols - vb.net

I have a pretty extensive application that has been built to provide SSO to several web applications via OID. The problem is that we have seen some users getting "orphaned" on a role for one of the applications. I have written a method that returns the distinguished name for all of the users with access to that role. To perform the cleanup, I am trying to make sure that the users returned in the previous step actually exist in OID. I have been using the System.DirectoryServices.Protocols.SearchRequest class when searching for users or roles, but it is not working for a distinguished name. Below is my method. It has been changed a couple of times to try different ways to make it work.
Public Function GetUserByDN(UserDN As String) As SearchResultEntry
Dim searchString As String = String.Format("baseDN={0}", UserDN)
Dim containerDN As String = Nothing
If _extranet Then
containerDN = "cn=users," & ConfigurationManager.AppSettings("Directory_ExternalDomain")
Else
containerDN = "cn=users," & ConfigurationManager.AppSettings("Directory_InternalDomain")
End If
Dim attributes(14) As String
attributes(0) = DIRECTORY_UNIQUE_ID
attributes(1) = DIRECTORY_FIRST_NAME
attributes(2) = DIRECTORY_LAST_NAME
attributes(3) = DIRECTORY_EMAIL_ADDRESS
attributes(4) = DIRECTORY_TELEPHONE
attributes(5) = DIRECTORY_STREET
attributes(6) = DIRECTORY_CITY
attributes(7) = DIRECTORY_STATE
attributes(8) = DIRECTORY_ZIP
attributes(9) = DIRECTORY_CUSTOMER_NAME
attributes(10) = DIRECTORY_ENABLED
attributes(11) = DIRECTORY_GIVEN_NAME ' this is the first name for a domain user
attributes(12) = DIRECTORY_KBIT_INDICATOR
attributes(13) = DIRECTORY_REQUESTING_BRANCH
attributes(14) = DIRECTORY_PWD_MUST_CHANGE
'Me.Connection.Bind()
Me.Bind()
Dim myRequest As New System.DirectoryServices.Protocols.SearchRequest(containerDN, UserDN, SearchScope.Base, attributes)
Dim myResponse As SearchResponse = Me.Connection.SendRequest(myRequest)
Dim results As SearchResultEntryCollection = myResponse.Entries
If results.Count >= 1 Then
Return results(0)
Else
Return Nothing
End If
End Function

It has taken a lot of research and asking questions else where to find the answer to this. It turns out that instead of looking in the users OU and searching for the user's DN, I should have just looked at the user's DN and just perform a simple LDAP query. Here is my final solution. I hope this helps the community.
Public Function GetUserByDN(UserDN As String) As SearchResultEntry
Dim ldapFilter As String = "(objectClass=person)"
Dim attributes(14) As String
attributes(0) = DIRECTORY_UNIQUE_ID
attributes(1) = DIRECTORY_FIRST_NAME
attributes(2) = DIRECTORY_LAST_NAME
attributes(3) = DIRECTORY_EMAIL_ADDRESS
attributes(4) = DIRECTORY_TELEPHONE
attributes(5) = DIRECTORY_STREET
attributes(6) = DIRECTORY_CITY
attributes(7) = DIRECTORY_STATE
attributes(8) = DIRECTORY_ZIP
attributes(9) = DIRECTORY_CUSTOMER_NAME
attributes(10) = DIRECTORY_ENABLED
attributes(11) = DIRECTORY_GIVEN_NAME
attributes(12) = DIRECTORY_KBIT_INDICATOR
attributes(13) = DIRECTORY_REQUESTING_BRANCH
attributes(14) = DIRECTORY_PWD_MUST_CHANGE
Me.Bind()
Dim myRequest As New SearchRequest(UserDN, ldapFilter, SearchScope.Base, attributes)
Dim myResponse As SearchResponse = Me.Connection.SendRequest(myRequest)
If myResponse.Entries.Count >= 1 Then
Return myResponse.Entries(0)
Else
Return Nothing
End If
End Function

Related

Setting a User Group with an Array using Active Directory Domain Services VB.net

I am trying to figure out how to set Users to an array of groups with Data I pulled from another user. I am in the process of creating a User Creation GUI and I am stuck because I am not sure if the data I have is an acceptable to pass through?
Currently I have the getGroups class which grabs the groups from a user that already exsists in AD. Which is represented in the code below:
Public Function getUserGroups(ByVal Username) As Array
Dim root As DirectoryEntry = New DirectoryEntry("L....")
Dim _objDirSearcher As DirectorySearcher = New DirectorySearcher(root)
_objDirSearcher.Filter = "(&(objectCategory=user)(name=" + Username.ToString() + "))"
_objDirSearcher.PropertiesToLoad.Add("memberOf")
Dim arr As Object = Nothing
Dim arrcol As Object() = Nothing
Try
'get all the user objects matching with the search pattern given
Dim _objResults As SearchResultCollection = _objDirSearcher.FindAll()
'loop with in each object
Dim _objResult As SearchResult
For Each _objResult In _objResults
'Check for properties available
If (Not _objResult Is Nothing) And _objResult.GetDirectoryEntry().Properties.Count > 0 Then
'verify for the mobile property not null
If Not _objResult.GetDirectoryEntry().Properties("memberOf").Value Is Nothing Then
If TypeOf _objResult.GetDirectoryEntry().Properties("memberOf").Value Is Object() Then
arr = CType(_objResult.GetDirectoryEntry().Properties("memberOf").Value, Object())
ElseIf TypeOf _objResult.GetDirectoryEntry().Properties("memberOf").Value Is Object Then
arr = CType(_objResult.GetDirectoryEntry().Properties("memberOf").Value, Object)
End If
Exit For
End If
End If
Next
Catch e As Exception
Return Nothing
End Try
Return arr
End Function
Then I have some code below to add ad user to group this is the part I am unclear if I did right. The Username variable will hold the newly created username and then pass the array of groups from the other user that is currently in format like "CN=group name, ou="test",DC=""...."
Private Sub adUserToGroup(ByVal user As String, ByVal listGroup As Array)
' sDomainName represents the location of your LDAP server
Dim sDomainName As String = "LDAP://ads.yourdomain.edu"
Dim adUserFolder As DirectoryEntry = New DirectoryEntry("LDAP://ads.yourdommain.edu/DC=ads,DC=yourdomain,DC=edu")
' This user is an active directory user and it will need access to write to the group you're trying to add to
adUserFolder.Username = "<insert user to authenticate as>"
adUserFolder.Password = "<insert password>"
Dim adSearch As New System.DirectoryServices.DirectorySearcher(adUserFolder)
For i = 0 To UBound(listGroup)
' bpell being the name of the user that you want to add.
listGroup(i).Properties("member").Add("CN=" + user + ",OU=Accounts,DC=ads,DC=mydomain,DC=edu")
listGroup(i).CommitChanges()
Next
End Sub
Does the code above look correct for what I need it to do. Should I revise it?
I figured it out, I had to break it apart and add the "Children" class to be able to find and access the group. I also made a for loop that strips the "DC" attributes from every string in the array because DC is already established in the LDAP path.
This is the final product. However I may initilize currentgroup out side the for loop as I feel like opening multiple sessions to add value to a group may cause issues.
Private Sub adUserToGroup(ByVal user As String, ByVal listGroup As Array)
Dim de As DirectoryEntry = New DirectoryEntry()
de.Path = "LDAP://domain.com/DC=Test,DC=COM"
de.AuthenticationType = AuthenticationTypes.Secure
de.Username = AuthUser
de.Password = AuthPass
Dim root As DirectoryEntries = de.Children
'1. Create user account
For i = 0 To UBound(listGroup)
Dim currentGroup As DirectoryEntry = de.Children.Find(listGroup(i), "group")
'Dim currentGroup As DirectoryEntry = de.find(listGroup(i))
currentGroup.Properties("member").Add("CN=" + user + ",OU=Employees,OU=Users,DC=test,DC=com")
currentGroup.CommitChanges()
Next
de.Close()
End Sub

Get complete host name

I want to know the full name of a remote page making an http call to my server. I am working with VB.NET and the page that is called is .ashx. At the moment I use this code snippet but I can only intercept the domain name but I don't know the exact page making the call. I've tried everything. Can you help me?
Dim _res As String = "" _hostaddress = context.Request.UserHostAddress Dim _header As NameValueCollection = context.Request.Headers _res = _header.GetValues("User-Agent").First()
Dim _res As String = "" _hostaddress = context.Request.UserHostAddress Dim _header As NameValueCollection = context.Request.Headers _res = _header.GetValues("User-Agent").First()

Checking Someone is a Member Of One of Many Groups Using Partial Group Name

I'm a bit stuck trying to work something into my code.
What I'm looking to do is to work out whether someone is a member of any one of a collection of groups. I'm not worried about which group specifically, I only want to know:
"Is user "X" a member of at least one of this collection of groups?"
The good news is, ALL these group names start in the same way:
Google-FullAccess
Google-RestrictedAccess
Google-MailOnly
Google-Enterprise etc.
Here's what I'm using to check for a specific group:
Dim ctx As DirectoryServices.AccountManagement.PrincipalContext = New DirectoryServices.AccountManagement.PrincipalContext(DirectoryServices.AccountManagement.ContextType.Domain, "net.mydomain.co.uk")
Dim user As DirectoryServices.AccountManagement.UserPrincipal = DirectoryServices.AccountManagement.UserPrincipal.FindByIdentity(ctx, tbxuserID.Text)
Dim googleFull As DirectoryServices.AccountManagement.GroupPrincipal = DirectoryServices.AccountManagement.GroupPrincipal.FindByIdentity(ctx, "Google-FullAccess")
If user.IsMemberOf(googleFull) Then
GoogleAccess = 1
GoTo Proceed
End If
I then repeat this block of code to check for the next group and so on.
Is there a way I can adapt this to check for any group starting with "Google-"? Here's what I'd like to do but obviously doesn't work:
Dim googleCheck As DirectoryServices.AccountManagement.GroupPrincipal = DirectoryServices.AccountManagement.GroupPrincipal.FindByIdentity(ctx, "Google-*")
Help much appreciated!
I found the solution! The following works for me (after working out and storing the DistinguishedName in a String variable from a previous query - I also declare GoogleCheck as a Boolean variable beforehand):
Dim rootEntry As DirectoryServices.DirectoryEntry = New DirectoryServices.DirectoryEntry("LDAP://DC=net,DC=mydomain,DC=co,DC=uk")
Dim srch As DirectoryServices.DirectorySearcher = New DirectoryServices.DirectorySearcher(rootEntry)
srch.SearchScope = DirectoryServices.SearchScope.Subtree
srch.Filter = "(&(CN=Google-*)(objectCategory=group)(member=" + DistinguishedName + "))"
Dim res = srch.FindOne()
If res IsNot Nothing Then
GoogleCheck = True
Else
GoogleCheck = False
End If

query an exchange distribution list

I'm trying to find some code that I can use in vb.net 4.0 to query the our exchange 2013 server. It will be housed on a web server and that server does not have outlook installed on it. Looks like I need to use EWS to do this but I've tried a lot of code snippets and still have not been able to figure this out. The distribution list i'm trying to query is in the public folders/Office Contacts. I've tried examples that use nesting to go through the public folder seen there is no deep traversal but I'm not doing something right there. I am not posting code because i'm not sure it would help. I was hoping someone has already done this and would give me some nuggest of info to get me started.
The examples I've found do not query the distribution list but rather add to it. It's not that I haven't tried... I've got hundreds of lines of code from different places that I've tried and tried to learn from.. but i'm not getting it done. Anyway.. help would be great.
Sorry about not posting any code.. I actually thought I deleted this post.. but i'll post the code that is now working for me. This code does a query to the public folder and then grabs some of the data about each contact in that contact list.
Public Sub MS()
Dim oTheListS As New List(Of TheList)
Dim service As New ExchangeService(ExchangeVersion.Exchange2010_SP1)
service.Credentials = New WebCredentials("userid", "password")
service.AutodiscoverUrl("email#address")
'Get Public Folder
Dim sf As SearchFilter = New SearchFilter.IsEqualTo(FolderSchema.DisplayName, "Office Contacts")
Dim rrRes As FindFoldersResults = service.FindFolders(WellKnownFolderName.PublicFoldersRoot, sf, New FolderView(1))
Dim OfficeContacts As Folder = rrRes.Folders(0)
'Find the Distribution List
Dim dlSearch As SearchFilter = New SearchFilter.IsEqualTo(ContactGroupSchema.DisplayName, "Merit Board")
Dim ivItemView As New ItemView(1)
Dim fiResults As FindItemsResults(Of Item) = OfficeContacts.FindItems(dlSearch, ivItemView)
If fiResults.Items.Count = 1 Then
'Enumeate Members
Dim cg As ContactGroup = DirectCast(fiResults.Items(0), ContactGroup)
cg.Load()
For Each gm As GroupMember In cg.Members
Dim o As New TheList
o = MS2(gm.AddressInformation.Address)
oTheListS.Add(o)
'Dim o As New TheList
'Dim ncCol As NameResolutionCollection = service.ResolveName(gm.AddressInformation.Address, ResolveNameSearchLocation.ContactsOnly, True)
'With o
' .Name = gm.AddressInformation.Name
' .Email = gm.AddressInformation.Address
'End With
'oTheListS.Add(o)
Next
End If
End Sub
Public Function MS2(pEmail As String) As TheList
Dim o As New TheList
Dim service As New ExchangeService(ExchangeVersion.Exchange2010_SP1)
service.Credentials = New WebCredentials("userid", "password")
service.AutodiscoverUrl("email#address")
Dim sf As SearchFilter = New SearchFilter.IsEqualTo(FolderSchema.DisplayName, "Office Contacts")
Dim rrRes As FindFoldersResults = service.FindFolders(WellKnownFolderName.PublicFoldersRoot, sf, New FolderView(1))
Dim OfficeContacts As Folder = rrRes.Folders(0)
'Find the Distribution List
Dim dlSearch As SearchFilter = New SearchFilter.IsEqualTo(ContactSchema.EmailAddress1, pEmail)
Dim ivItemView As New ItemView(1)
Dim fiResults As FindItemsResults(Of Item) = OfficeContacts.FindItems(dlSearch, ivItemView)
If fiResults.Items.Count = 1 Then
Dim con As Contact = fiResults.Items(0)
'Dim ncCol As NameResolutionCollection = service.ResolveName(gm.AddressInformation.Address, ResolveNameSearchLocation.ContactsOnly, True)
With o
If con.DisplayName IsNot Nothing Then
.Name = con.DisplayName
End If
Dim em As New EmailAddress
If con.EmailAddresses.TryGetValue(EmailAddressKey.EmailAddress1, em) = True Then
.Email = con.EmailAddresses(EmailAddressKey.EmailAddress1).ToString
End If
If con.JobTitle IsNot Nothing Then
.Title = con.JobTitle
End If
Dim phy As New PhysicalAddressEntry
If con.PhysicalAddresses.TryGetValue(PhysicalAddressKey.Business, phy) = True Then
.Address = con.PhysicalAddresses(PhysicalAddressKey.Business)
End If
If con.PhoneNumbers.TryGetValue(PhoneNumberKey.BusinessPhone, String.Empty) = True Then
.PhoneBusiness = con.PhoneNumbers(PhoneNumberKey.BusinessPhone)
End If
If con.PhoneNumbers.TryGetValue(PhoneNumberKey.MobilePhone, String.Empty) = True Then
.PhoneMobile = con.PhoneNumbers(PhoneNumberKey.MobilePhone)
End If
If con.CompanyName IsNot Nothing Then
.Comapny = con.CompanyName
End If
End With
End If
Return o
End Function
Public Class TheList
Public Property Name As String
Public Property Email As String
Public Property PhoneMobile As String
Public Property PhoneBusiness As String
Public Property Comapny As String
Public Property Title As String
Public Property Address As PhysicalAddressEntry
End Class
I just got it working so I haven't started to refine it yet.. but hopefully this will help someone else as I didn't find any code that did this

Trying to add an Image using FacebookMediaObject with Visual Basic on the Facebook ADS Api

I've been having a problem adding an AdGroup using the FacebookMediaObject in Visual Basic to create a new add using the Facebook ADS Api.
I understand not many people have access to it, but I hope someone here can shedd a light on it.
Dim objAuthorizer As Authorizer = New Authorizer
Dim objFB As FacebookClient = New FacebookClient(objAuthorizer.Session.AccessToken)
Dim objParametersTargeting As Object = New ExpandoObject()
Dim arrCountries() As String
ReDim arrCountries(0)
arrCountries(0) = "NL"
objParametersTargeting.countries = arrCountries
Dim objCreative As Object = New ExpandoObject()
objCreative.title = "Test Adgroup title"
objCreative.body = "Test Adgroup body"
objCreative.link_url = "www.test.com"
objCreative.image_file = "testcups.jpg"
Dim strFilename As String = "C:\Upload\testcups.jpg"
Dim objAdgroupParameters() As Object
ReDim objAdgroupParameters(0)
objAdgroupParameters(0) = New ExpandoObject()
objAdgroupParameters(0).campaign_id = "123456789"
objAdgroupParameters(0).name = "Test adgroup"
objAdgroupParameters(0).bid_type = 1
objAdgroupParameters(0).max_bid = 50
objAdgroupParameters(0).targeting = objParametersTargeting
objAdgroupParameters(0).creative = objCreative
Dim fbUplImage = New Facebook.FacebookMediaObject
fbUplImage.FileName = "testcups.jpg"
fbUplImage.ContentType = "image/png"
Dim objBytes As Byte() = System.IO.File.ReadAllBytes(strFilename)
fbUplImage.SetValue(objBytes)
Dim objParameters As Object = New ExpandoObject()
objParameters.method = "ads.createAdGroups"
objParameters.account_id = "123456789"
objParameters.adgroup_specs = objAdgroupParameters
objParameters.image = fbUplImage
Dim objResult As Object = objFB.Post(objParameters)
Of course the Account ID and the Campaign ID have to be valid ID's (which are valid ID's in my local source) and the file has to exist on your harddrive (which also is there on my local drive).
I keep getting the following results back:
{"updated_adgroups":[],"failed_adgroups":[{"spec_number":"0","errors":["Filesystem entity `/testcups.jpg' does not exist."]}]}
Anybody out there has any clue?
Thanks in advance,
Bas
Some extra info:
I found out (with a HTTP sniffer) that the Facebook C# SDK isn't making a Multipart Post requestout o
Have you tried switching "fbUplImage.ContentType = "image/png" to image/jpg?