401 lines
18 KiB
VB.net
401 lines
18 KiB
VB.net
Imports System.DirectoryServices
|
|
Imports System.DirectoryServices.ActiveDirectory
|
|
Imports System.DirectoryServices.AccountManagement
|
|
|
|
Public Class frmUserKonfig_AddUsers
|
|
Public Function GetAllADGroups() As List(Of String)
|
|
Try
|
|
Dim enTry As DirectoryEntry = New DirectoryEntry("LDAP://" & Environment.UserDomainName) 'digitaldata.local
|
|
Dim mySearcher As DirectorySearcher = New DirectorySearcher(enTry)
|
|
mySearcher.Filter = ("(&(objectClass=group))")
|
|
Dim result As New List(Of String)
|
|
For Each resEnt As SearchResult In mySearcher.FindAll()
|
|
Dim myEntry As DirectoryEntry = resEnt.GetDirectoryEntry
|
|
Dim groupName As String = myEntry.Name.Replace("CN=", "")
|
|
If Not groupName.StartsWith("WinRMR") Or Not groupName.StartsWith("Gäst") Or Not groupName.StartsWith("Druck") Or Not groupName.StartsWith("Sicherungs") Or Not groupName.StartsWith("Replikations") Or Not groupName.StartsWith("Netzwerkskon") _
|
|
Or Not groupName.StartsWith("Leistungs") Or Not groupName.StartsWith("Distributed COM") Or Not groupName.StartsWith("IIS_") Or Not groupName.StartsWith("Kryptografie") Or Not groupName.StartsWith("Ereignis") Or Not groupName.StartsWith("Zertifikat") _
|
|
Or Not groupName.StartsWith("RDS-") Or Not groupName.StartsWith("Hyper-V") Or Not groupName.StartsWith("Zugriffssteuerungs") Or Not groupName.StartsWith("Remoteverwaltungs") Or Not groupName.StartsWith("Domänencomput") Or Not groupName.StartsWith("Domänen-Gäste") _
|
|
Or Not groupName.StartsWith("Richtlinien-Ersteller") Or Not groupName.StartsWith("RAS- und IAS-Server") Or Not groupName.StartsWith("Server-Operatore") Or Not groupName.StartsWith("Konten-Oper") Or Not groupName.StartsWith("Prä-Windows") _
|
|
Or Not groupName.StartsWith("Einstellungen eingehender") Or Not groupName.StartsWith("Windows-Auth") Or Not groupName.StartsWith("Terminalserver-Liz") Or Not groupName.StartsWith("Zulässige") Or Not groupName.StartsWith("Abgelehnte") Or Not groupName.StartsWith("Schreibgeschützte Domänen") _
|
|
Or Not groupName.StartsWith("Klonbare") Or Not groupName.StartsWith("Protected User") Or Not groupName.StartsWith("Dns") Or Not groupName.StartsWith("DHCP") Or Not groupName.StartsWith("IIS_IUSR") Or Not groupName.StartsWith("Richtlinien-Ersteller") _
|
|
Or Not groupName.StartsWith("Abgelehnte RODC-Kenn") Then
|
|
Dim users As List(Of String) = GetGroupUsers(groupName)
|
|
If Not IsNothing(users) Then
|
|
result.Add(groupName)
|
|
End If
|
|
End If
|
|
|
|
|
|
|
|
'MsgBox(myEntry.Name)
|
|
'Dim MyLVI As ListViewItem = ListView2.Items.Add(Rc(myEntry.Name))
|
|
'MyLVI.SubItems.Add("Global Secutiry Group")
|
|
'MyLVI.SubItems.Add(Replace(myEntry.Parent.Path, "LDAP://", ""))
|
|
'MyLVI.ImageKey = "ad_icon_group"
|
|
Next
|
|
|
|
'Dim sPath As String = "LDAP://digitaldata.local"
|
|
'Dim myDirectory As New DirectoryEntry(sPath)
|
|
'Dim mySearcher1 As New DirectorySearcher(myDirectory)
|
|
'Dim mySearchResultColl As SearchResultCollection
|
|
'Dim mySearchResult As SearchResult
|
|
'Dim result As New List(Of String)
|
|
'Dim objGroupEntry As DirectoryEntry
|
|
|
|
'mySearcher1.Filter = "(&(objectClass=Group))"
|
|
'mySearchResultColl = mySearcher1.FindAll()
|
|
|
|
'If (mySearchResultColl.Count <> 0) Then
|
|
' For Each mySearchResult In mySearchResultColl
|
|
' objGroupEntry = mySearchResult.GetDirectoryEntry()
|
|
' result.Add(objGroupEntry.Name)
|
|
' Next
|
|
'End If
|
|
|
|
Return result
|
|
|
|
Catch ex As System.Exception
|
|
Return Nothing
|
|
End Try
|
|
End Function
|
|
Private Sub formUserConfig_AddUsers_Load(sender As Object, e As EventArgs) Handles MyBase.Load
|
|
Try
|
|
Me.Cursor = Cursors.WaitCursor
|
|
Dim groups As List(Of String) = GetAllADGroups()
|
|
|
|
' Sort alphabetically.
|
|
groups.Sort()
|
|
Me.Cursor = Cursors.Default
|
|
For Each group In groups
|
|
lbGroups.Items.Add(group)
|
|
Next
|
|
|
|
'Dim groups As List(Of String) = GetActiveDirectoryGroups()
|
|
|
|
'For Each group In groups
|
|
' lbGroups.Items.Add(group)
|
|
'Next
|
|
|
|
Catch ex As Exception
|
|
MsgBox("Error in Load Groups: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
Me.Cursor = Cursors.Default
|
|
End Sub
|
|
Public Function GetUsername_FromDisplayname(ByVal strUserString As String)
|
|
Try
|
|
Dim enTry As DirectoryEntry = New DirectoryEntry("LDAP://" & Environment.UserDomainName) 'digitaldata.local
|
|
Dim mySearcher As DirectorySearcher = New DirectorySearcher(enTry)
|
|
mySearcher.Filter = ("(&(objectCategory=person)(objectClass=user)(cn=" & strUserString & "))")
|
|
'Retrieve results
|
|
Dim dsResult As SearchResult = mySearcher.FindOne
|
|
|
|
If dsResult Is Nothing Then
|
|
'No results returned
|
|
Return ""
|
|
End If
|
|
'For Each Str As DictionaryEntry In dsResult.Properties
|
|
' Console.WriteLine(Str.Key.ToString & " - " & Str.Value.ToString)
|
|
'Next
|
|
Dim usrname = dsResult.Properties("samaccountname")(0)
|
|
Return usrname
|
|
Catch ex As Exception
|
|
ClassLogger.Add("Error in GetUsername_FromDisplayname: " & ex.Message, True)
|
|
Return ""
|
|
End Try
|
|
|
|
|
|
End Function
|
|
Public Function GetProperty_LDAP(ByVal strUserString As String, _property As String)
|
|
Try
|
|
Dim enTry As DirectoryEntry = New DirectoryEntry("LDAP://" & Environment.UserDomainName) 'digitaldata.local
|
|
Dim mySearcher As DirectorySearcher = New DirectorySearcher(enTry)
|
|
mySearcher.Filter = ("(&(objectCategory=person)(objectClass=user)(cn=" & strUserString & "))")
|
|
'Retrieve results
|
|
Dim dsResult As SearchResult = mySearcher.FindOne
|
|
|
|
If dsResult Is Nothing Then
|
|
'No results returned
|
|
Return ""
|
|
End If
|
|
'For Each Str As DictionaryEntry In dsResult.Properties
|
|
' Console.WriteLine(Str.Key.ToString & " - " & Str.Value.ToString)
|
|
'Next
|
|
Dim usrname = dsResult.Properties(_property)(0)
|
|
Return usrname
|
|
Catch ex As Exception
|
|
ClassLogger.Add("Error in GetProperty_LDAP: " & ex.Message, True)
|
|
Return ""
|
|
End Try
|
|
|
|
|
|
End Function
|
|
|
|
Public Function GetEmail_FromDisplayname(ByVal strUserString As String)
|
|
Try
|
|
Dim enTry As DirectoryEntry = New DirectoryEntry("LDAP://" & Environment.UserDomainName) 'digitaldata.local
|
|
Dim mySearcher As DirectorySearcher = New DirectorySearcher(enTry)
|
|
mySearcher.Filter = ("(&(objectCategory=person)(objectClass=user)(cn=" & strUserString & "))")
|
|
'Retrieve results
|
|
Dim dsResult As SearchResult = mySearcher.FindOne
|
|
|
|
If dsResult Is Nothing Then
|
|
'No results returned
|
|
Return ""
|
|
End If
|
|
'For Each Str As DictionaryEntry In dsResult.Properties
|
|
' Console.WriteLine(Str.Key.ToString & " - " & Str.Value.ToString)
|
|
'Next
|
|
Dim email = dsResult.Properties("mail")(0)
|
|
Return email
|
|
Catch ex As Exception
|
|
ClassLogger.Add("Error in GetEmail_FromDisplayname: " & ex.Message, True)
|
|
Return ""
|
|
End Try
|
|
|
|
|
|
End Function
|
|
Public Shared Function FindEmailsFromSamAccountName(ByVal samAccountName As String) As String
|
|
|
|
Dim ctx As New PrincipalContext(ContextType.Domain)
|
|
|
|
Dim qbeUser As New UserPrincipal(ctx)
|
|
qbeUser.SamAccountName = samAccountName
|
|
qbeUser.Enabled = True
|
|
|
|
Dim srch As New PrincipalSearcher(qbeUser)
|
|
For Each foundUser In srch.FindAll
|
|
Dim up As UserPrincipal = CType(foundUser, UserPrincipal)
|
|
Return up.EmailAddress
|
|
Next
|
|
Return ""
|
|
End Function
|
|
Function GetActiveDirectoryGroups() As List(Of String)
|
|
Me.Cursor = Cursors.WaitCursor
|
|
Dim groups As List(Of String) = New List(Of String)
|
|
Dim ctx As PrincipalContext = New PrincipalContext(ContextType.Domain)
|
|
Dim group As GroupPrincipal = New GroupPrincipal(ctx)
|
|
Dim srch As PrincipalSearcher = New PrincipalSearcher(group)
|
|
For Each g In srch.FindAll()
|
|
If GetUsersForGroup(g.ToString()).Count <> 0 Then
|
|
groups.Add(g.ToString)
|
|
End If
|
|
Next
|
|
|
|
Return groups
|
|
End Function
|
|
Public Function GetGroupUsers(ByVal strGroupName As String)
|
|
|
|
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
'
|
|
' Returns all the users of a specific group
|
|
' Each user on seperate line in the string
|
|
' The group name being passed is not case sensitive
|
|
'
|
|
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
Dim dsDirectorySearcher As New DirectorySearcher
|
|
Dim strUsers As String
|
|
Dim intEqualsIndex As Integer
|
|
Dim intCommaIndex As Integer
|
|
Dim result As New List(Of String)
|
|
|
|
'Filter by group name
|
|
With dsDirectorySearcher
|
|
.Filter = "sAMAccountName=" & strGroupName
|
|
.PropertiesToLoad.Add("member")
|
|
|
|
Try
|
|
'Retrieve results
|
|
Dim dsResult As SearchResult = .FindOne
|
|
Dim intCounter As Integer
|
|
|
|
If dsResult Is Nothing Then
|
|
'No results returned
|
|
Return Nothing
|
|
End If
|
|
Dim d = dsResult.Properties("member").Count
|
|
For intCounter = 0 To dsResult.Properties("member").Count - 1
|
|
strUsers = dsResult.Properties("member")(intCounter).ToString
|
|
If LogErrorsOnly = False Then ClassLogger.Add(">> Usermember-String for Group: " & strUsers.ToString, False)
|
|
'Get index of equals and comma
|
|
intEqualsIndex = strUsers.IndexOf("=", 1)
|
|
intCommaIndex = strUsers.IndexOf(",", 1)
|
|
|
|
If intEqualsIndex = -1 Then
|
|
Return Nothing
|
|
End If
|
|
'Console.WriteLine(strUsers)
|
|
'Extract name from string and append to List
|
|
result.Add(strUsers.Substring((intEqualsIndex + 1), (intCommaIndex - intEqualsIndex) - 1))
|
|
|
|
Next intCounter
|
|
|
|
Catch ex As Exception
|
|
MessageBox.Show("Error in GetGroupUsers Function" & vbNewLine & vbNewLine _
|
|
& ex.Message, "Active Directory Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
|
|
|
End Try
|
|
|
|
End With
|
|
|
|
Return result
|
|
|
|
End Function
|
|
|
|
Function GetUsersForGroup(g As String) As List(Of UserPrincipal)
|
|
Dim users As List(Of UserPrincipal) = New List(Of UserPrincipal)
|
|
'Dim ctx As PrincipalContext = New PrincipalContext(ContextType.Domain)
|
|
'Dim group As GroupPrincipal = GroupPrincipal.FindByIdentity(ctx, g)
|
|
|
|
'Dim u = group.GetMembers(True)
|
|
|
|
'For Each user In u
|
|
' If user.GetType().Name = "UserPrincipal" Then
|
|
' users.Add(user)
|
|
' End If
|
|
'Next
|
|
|
|
Return users
|
|
End Function
|
|
|
|
Private Sub lbGroups_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lbGroups.SelectedIndexChanged
|
|
Me.Cursor = Cursors.WaitCursor
|
|
Dim group As String = lbGroups.SelectedItem
|
|
Dim users As List(Of String) = GetGroupUsers(group)
|
|
|
|
clbUsers.Items.Clear()
|
|
If users Is Nothing Then
|
|
Me.Cursor = Cursors.Default
|
|
Exit Sub
|
|
End If
|
|
|
|
For Each user In users
|
|
If user.EndsWith("/") Or user.EndsWith("\") Then
|
|
user = user.Replace("/", "")
|
|
user = user.Replace("\", "")
|
|
End If
|
|
clbUsers.Items.Add(user)
|
|
Next
|
|
Me.Cursor = Cursors.Default
|
|
|
|
End Sub
|
|
|
|
Private Sub btnAddUsers_Click(sender As Object, e As EventArgs) Handles btnAddUsers.Click
|
|
Try
|
|
Dim items As CheckedListBox.CheckedItemCollection = clbUsers.CheckedItems
|
|
Dim usersAdded As Integer = 0
|
|
|
|
If items.Count = 0 Then
|
|
MsgBox("Keine Benutzer ausgewählt")
|
|
Exit Sub
|
|
End If
|
|
|
|
For Each item In items
|
|
Dim ctx As PrincipalContext = New PrincipalContext(ContextType.Domain)
|
|
Dim usr As UserPrincipal = UserPrincipal.FindByIdentity(ctx, IdentityType.Name, item.ToString)
|
|
If Not IsNothing(usr) Then
|
|
'Dim user As String = item.ToString
|
|
'Dim PRENAME As String = GetProperty_LDAP(user, "givenName")
|
|
'Dim NAME As String = GetProperty_LDAP(user, "sn")
|
|
'Dim email As String = GetProperty_LDAP(user, "mail")
|
|
'Dim USERNAME As String = GetProperty_LDAP(user, "samaccountname")
|
|
Dim PRENAME As String = usr.GivenName
|
|
Dim NAME As String = usr.Surname
|
|
Dim USERNAME As String = usr.SamAccountName
|
|
Dim email As String = usr.EmailAddress
|
|
Dim SQL
|
|
If Not UserExists(USERNAME) Then
|
|
SQL = String.Format("INSERT INTO TBDD_USER(PRENAME, NAME, USERNAME, EMAIL, MODULE_GI,ADDED_WHO) VALUES('{0}', '{1}', '{2}','{3}',1,'{4}')", PRENAME, NAME, USERNAME, email, Environment.UserName)
|
|
If ClassDatabase.Execute_non_Query(SQL) = True Then
|
|
usersAdded = usersAdded + 1
|
|
End If
|
|
Else
|
|
SQL = "UPDATE TBDD_USER SET MODULE_GI = 1 WHERE UPPER(USERNAME) = UPPER('" & USERNAME & "')"
|
|
If ClassDatabase.Execute_non_Query(SQL) = True Then
|
|
usersAdded = usersAdded + 1
|
|
End If
|
|
End If
|
|
Else
|
|
MsgBox("Für den User '" & item.ToString & "' konnte kein Userprincipal aus der LDAP erstellt werden!", MsgBoxStyle.Information)
|
|
End If
|
|
|
|
|
|
|
|
Next
|
|
|
|
If usersAdded = 1 Then
|
|
MsgBox(usersAdded & " neuer Benutzer hinzugefügt", MsgBoxStyle.Information)
|
|
Else
|
|
MsgBox(usersAdded & " neue Benutzer hinzugefügt", MsgBoxStyle.Information)
|
|
End If
|
|
Catch ex As Exception
|
|
MsgBox("Error in Adding Users from LDAP: " & vbNewLine & ex.Message)
|
|
End Try
|
|
|
|
|
|
End Sub
|
|
|
|
Private Function UserExists(username As String) As Boolean
|
|
Try
|
|
Dim SQL = "SELECT GUID FROM TBDD_USER WHERE UPPER(USERNAME) = UPPER('" & username & "')"
|
|
If ClassDatabase.Execute_Scalar(SQL, MyConnectionString) = Nothing Then
|
|
Return False
|
|
Else
|
|
Return True
|
|
End If
|
|
Catch ex As Exception
|
|
MsgBox("Error in UserExists: " & vbNewLine & ex.Message)
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
Private Sub btnCancel_Click(sender As Object, e As EventArgs) Handles btnCancel.Click
|
|
Me.Close()
|
|
End Sub
|
|
|
|
Private Sub tbSelectEverything_Click(sender As Object, e As EventArgs) Handles tbSelectEverything.Click
|
|
For i = 0 To clbUsers.Items.Count - 1
|
|
clbUsers.SetItemChecked(i, True)
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub tbSelectNone_Click(sender As Object, e As EventArgs) Handles tbSelectNone.Click
|
|
For i = 0 To clbUsers.Items.Count - 1
|
|
clbUsers.SetItemChecked(i, False)
|
|
Next
|
|
End Sub
|
|
|
|
'Private Sub clbUsers_SelectedIndexChanged(sender As Object, e As EventArgs) Handles clbUsers.SelectedIndexChanged
|
|
' Me.Cursor = Cursors.WaitCursor
|
|
' Dim user As String = clbUsers.SelectedItem
|
|
' Dim usrname = GetProperty_LDAP(user, "samaccountname")
|
|
' If Not IsNothing(usrname) Then
|
|
' MsgBox(usrname)
|
|
' End If
|
|
|
|
' Dim email = GetProperty_LDAP(user, "mail")
|
|
' If Not IsNothing(email) Then
|
|
' MsgBox(email)
|
|
' End If
|
|
'End Sub
|
|
|
|
Private Sub clbUsers_MouseClick(sender As Object, e As MouseEventArgs) Handles clbUsers.MouseClick
|
|
Try
|
|
ToolTipController1.HideHint()
|
|
Dim userstring As String = clbUsers.SelectedItem.ToString
|
|
Dim ctx As PrincipalContext = New PrincipalContext(ContextType.Domain)
|
|
Dim usr As UserPrincipal = UserPrincipal.FindByIdentity(ctx, IdentityType.Name, userstring)
|
|
If Not IsNothing(usr) Then
|
|
Dim PRENAME As String = usr.GivenName
|
|
Dim NAME As String = usr.Surname
|
|
Dim USERNAME As String = usr.SamAccountName
|
|
Dim email As String = usr.EmailAddress
|
|
ToolTipController1.ShowHint("SamAccountName: " & USERNAME & vbNewLine & "GivenName: " & PRENAME & vbNewLine & "Surname: " & NAME & vbNewLine & "EmailAddress: " & email, "Preview LDAP-Parameter:", DevExpress.Utils.ToolTipLocation.RightCenter)
|
|
End If
|
|
ctx.Dispose()
|
|
Catch ex As Exception
|
|
MsgBox("Error in getting Userinfo LDAP:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
End Try
|
|
|
|
End Sub
|
|
End Class |