I am looking to determine if a computer is a member of an AD group or even getting all computers that are members of an AD group using VB.net. I have found several examples for checking to see if a user is a member of a group but none for checking for computers. I was hoping to convert this function to search for a computer in the group but I was unsuccessful. Any assistance would be appreciated. Thank you in advance.
Function IsInGroup(GroupName) 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
Try something like this
Function IsInGroup(PCName As String, groupName As String) As Boolean
Dim vUsuario As New NTAccount(PCName & "$")
Dim sid As SecurityIdentifier = vUsuario.Translate(GetType(SecurityIdentifier))
Using vRootDSE As New DirectoryEntry("LDAP://rootDSE")
Using vSearcher As New DirectorySearcher(New DirectoryEntry("LDAP://" + CStr(vRootDSE.Properties("defaultNamingContext")(0))), "(objectSID=" & sid.ToString() & ")", New String() {"memberOf"}, SearchScope.Subtree)
Dim src As SearchResultCollection = vSearcher.FindAll()
Dim memberOf As ResultPropertyValueCollection = src(0).Properties("memberOf")
For i As Integer = 0 To memberOf.Count - 1
'Debug.Print(memberOf(i).ToString())
' I don't really like this approach, but it's quick to write ;)
If memberOf(i).ToString().Contains("=" & groupName & ",") Then
Return True
End If
Next
End Using
End Using
Return False
End Function
If you're looking for the CURRENT PC then it's a bit easier.
Function Is_CurrentPC_InADGroup(groupName As String) As Boolean
if groupName = "" then Return True
Using context = New PrincipalContext(ContextType.Domain, Environment.GetEnvironmentVariable("USERDOMAIN"))
Dim principal = ComputerPrincipal.FindByIdentity(context, Environment.MachineName)
Dim groups = principal.GetGroups()
For Each group In groups
If group.ToString = groupName Then Return True
Next
End Using
Return False
End Function
Related
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
I have a list of CommissionStatement objects which i created. I need to create a new list which only holds the duplicates found in this list based on 3 properties: Firm; Provider; and Total (ie each of these 3 have to be the same in 2 or more objects for it to be recognized as a duplicate)
Object is a simple object of strings at the moment.
Private Class CommissionStatement
Property Provider As String
Property Firm As String
Property Source As String
Property Media As String
Property Total As String
Property Received As String
End Class
I have a list of all CommissionStatments as follows:
Dim fileLocation As String = importText.Text
Dim csvText As String = My.Computer.FileSystem.ReadAllText(fileLocation).Replace(", ", " ")
Dim providerString As String = ""
Dim allStatements = New List(Of CommissionStatement)
Dim countIndex As Integer = 0, maxIndex As Integer = csvText.Split(vbLf).Length
For Each line As String In csvText.Split(vbLf)
'' Remove the top row
countIndex += 1
If countIndex = 1 Then
Continue For
End If
statementProgress.Value = ((countIndex / maxIndex) * 100)
'' Build the New commissionStatement object and add it to the allStatements list
If Not line = "" Then
Dim commissionStatement = New CommissionStatement
With commissionStatement
.Provider = line.Split(",")(0)
.Firm = line.Split(",")(1)
.Source = line.Split(",")(2)
.Media = line.Split(",")(3)
.Total = line.Split(",")(4)
End With
providerString &= commissionStatement.Provider & ","
allStatements.Add(commissionStatement)
End If
Next
First post on StackOverflow so sorry if its not very clear! The duplicate list needs to also be a list of CommissionStatements which contain the duplicates from the allStatements list based on Firm Provider and Total
Your best bet is to use a lambda expression. The function below should do what you ask.
Private Function GetDuplicateCommisionStatements(tempStatement As CommissionStatement) As List(Of CommissionStatement)
Return allStatements.FindAll(Function(x) x.Firm = tempStatement.Firm And x.Provider = tempStatement.Provider And x.Total = tempStatement.Total)
End Function
And use it like this..
duplicatelist = GetDuplicateCommisionStatements(testCommisionStatement)
using your own object names of course.
Incidentally, you could shorten the sub using the With statement like below
Private Function GetDuplicateCommisionStatements(tempStatement As CommissionStatement) As List(Of CommissionStatement)
With tempStatement
Return allStatements.FindAll(Function(x) x.Firm = .Firm And x.Provider = .Provider And x.Total = .Total)
End With
End Function
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
Function checkIsAuthorized(ByVal users As String) As Boolean
Dim UserJobCode As String = dcChris.getJobCode(users)
Dim values As String = My.Settings.canResendJobcode
Dim usersCode As String() = values.Split(",")
Return usersCode.Contains(UserJobCode)
'If usersCode.Contains(UserJobCode) Then
' canResend = True
' Return True
'End If
'canResend = False
'Return False
End Function
The commented portion of the function works, I was just trying to make the code more efficient with the return statement. But it does not return a bool because the global is still reading false. Doing it the old way worked.
Any ideas?
Dim canResend As Boolean
Function checkIsAuthorized(ByVal users As String) As Boolean
Dim UserJobCode As String = dcChris.getJobCode(users)
Dim values As String = My.Settings.canResendJobcode
Dim usersCode As String() = values.Split(",")
Return usersCode.Contains(UserJobCode)
End Function
This is what I settled on. It works great for my needs. Thanks everyone.
I've seen some questions similar to this on here, but none of them seem to help me. I don't really care what API is used, be it Google, Yahoo!, The Weather Channel, or any other. I've got code that will get the high and low of the current day, based on the location given by the user, but I can't seem to get the hourly predictions for temperature or weather condition, which is what I'm really looking for. I don't really care for wind speeds, humidity, or the "feels like" temperature, though I'll add them if I can figure out how to. I'm trying to get data that will look something like what is here. (www.weather.com/...)
I'm pretty new to parsing XML so that may be part of my problem, too. Thanks in advance for any help. I greatly appreciate it.
I have something you might enjoy:
<Runtime.CompilerServices.Extension()>
Module Weather
Public Structure WeatherInfo_Forecast
Dim DayOfWeek As String
Dim low As Double
Dim high As Double
Dim icon As String
End Structure
Public Structure WeatherInfo_Wind
Dim direction As String
Dim speed As Double
Dim unit As String
End Structure
Public Structure WeatherInfo_Typed
Dim Failed As Boolean
Dim errormessage As Exception
Dim location As String
Dim forcast_date As DateTime
Dim checked_time_date As DateTime
Dim humidity As Double
Dim highf As Double
Dim lowf As Double
Dim highc As Double
Dim lowc As Double
Dim currenttempC As Double
Dim currenttempF As Double
Dim predicted_icon As String
Dim current_icon As String
Dim current_condition As String
Dim predicted_condition As IEnumerable(Of WeatherInfo_Forecast)
Dim wind_condition As WeatherInfo_Wind
Dim day As String
End Structure
<Runtime.CompilerServices.Extension()> _
Public Function ToC(ByVal F As Double) As Double
Return ((F - 32) / 9) * 5
End Function
<Runtime.CompilerServices.Extension()> _
Public Function TryParseAsDouble(ByVal s As String) As Double
Dim rv As Double
If Double.TryParse(s, rv) = False Then rv = Double.NaN
Return rv
End Function
<Runtime.CompilerServices.Extension()> _
Public Function TryParseAsDate(ByVal s As String) As DateTime
Dim rv As DateTime
If DateTime.TryParse(s, rv) = False Then rv = Nothing
Return rv
End Function
Private Function ParseHumidity(ByVal s As String) As Double
If Not s Is Nothing Then
Dim humRegEx As New System.Text.RegularExpressions.Regex("Humidity: (?<Value>\d+)\w*\%")
Dim m = humRegEx.Match(s)
If m.Length = 0 Then Return Double.NaN
Return Double.Parse(m.Groups("Value").Value)
End If
End Function
Private Function ParseWind(ByVal s As String) As WeatherInfo_Wind
Dim rv As New WeatherInfo_Wind
If Not s Is Nothing Then
Dim humRegEx As New System.Text.RegularExpressions.Regex("Wind\:\s+(?<Direction>[NEWSnews]{1,2})\s+at\s+(?<speed>(?<value>\d+)\s(?<units>\w+)){1}")
Dim m = humRegEx.Match(s)
rv.speed = Double.NaN
If m.Length = 0 Then Return rv
With rv
.direction = m.Groups("Direction").Value
If Double.TryParse(m.Groups("value").Value, .speed) = False Then .speed = Double.NaN
.unit = m.Groups("units").Value
End With
End If
Return rv
End Function
<DebuggerHidden()>
Public Function Grab_Weather(ByVal Location As String) As WeatherInfo_Typed
Dim GrabWeather As New WeatherInfo_Typed
With GrabWeather
.Failed = True
Try
Dim xml As XDocument = XDocument.Load("http://www.google.com/ig/api?weather=" & Location)
Dim xp = xml.<problem_cause>
If xp.Any Then Return GrabWeather
.location = xml...<city>.#data
.forcast_date = xml...<forecast_date>.#data.TryParseAsDate
.checked_time_date = xml...<current_date_time>.#data.TryParseAsDate
.humidity = ParseHumidity(xml...<humidity>.#data)
.highf = xml...<high>.#data.TryParseAsDouble
.lowf = xml...<low>.#data.TryParseAsDouble
.highc = GrabWeather.highf.ToC
.lowc = GrabWeather.highc.ToC
.currenttempC = xml...<temp_c>.#data.TryParseAsDouble
.currenttempF = xml...<temp_f>.#data.TryParseAsDouble
'.current_icon = "http://www.google.com" & xml...<icon>.#data
'.predicted_icon = "http://www.google.com" & xml...<high>.#data
.current_condition = xml...<condition>.#data
.predicted_condition = From f In xml...<forecast_conditions> _
Select New WeatherInfo_Forecast With { _
.DayOfWeek = f.<day_of_week>.Value, _
.high = f.<high>.#data.TryParseAsDouble, _
.low = f.<low>.#data.TryParseAsDouble}
'.icon = "http://www.google.com" & f.<icon>.#data}
.wind_condition = ParseWind(xml...<wind_condition>.#data)
.day = xml...<day_of_week>.#data
.Failed = False
Return GrabWeather
Catch ex As Exception
.errormessage = ex
Return GrabWeather
End Try
End With
End Function
End Module
I finally found what I was looking for from Weather Underground. They have three APIs, and, starting with the middle one, gives hourly forecasts for 36 hours. You get English and Metric predicted statistics for temperature, "feels like" temperature, dew point, wind speed, and wind direction. There's also wind chill and heat index, but every result for both in English and Metric was -9998, so I'm pretty sure those results are a bit off! Also there are qpf, snow, pop, and mslp. Unfortunately qpf and snow have not results and I'm not sure what pop and mslp are. All results are available in JSON and XML. They have some image requests, too, but I haven't looked into them yet.
Update:
Link Updated