411 lines
20 KiB
VB.net
411 lines
20 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
|
|
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
|
|
Try
|
|
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
|
|
If Not g.ToString.StartsWith("WinRMR") And Not g.ToString.StartsWith("Priv") And Not g.ToString.StartsWith("Gäst") And Not g.ToString.StartsWith("Druck") And Not g.ToString.StartsWith("Sicherungs") And Not g.ToString.StartsWith("Replikations") And Not g.ToString.StartsWith("Netzwerkskon") _
|
|
And Not g.ToString.StartsWith("Reporting") And Not g.ToString.StartsWith("Leistungs") And Not g.ToString.StartsWith("Distributed COM") And Not g.ToString.StartsWith("IIS_") And Not g.ToString.StartsWith("Kryptografie") And Not g.ToString.StartsWith("Ereignis") And Not g.ToString.StartsWith("Zertifikat") _
|
|
And Not g.ToString.StartsWith("RDS-") And Not g.ToString.StartsWith("Hyper-V") And Not g.ToString.StartsWith("Zugriffssteuerungs") And Not g.ToString.StartsWith("Remoteverwaltungs") And Not g.ToString.StartsWith("Domänencomput") And Not g.ToString.StartsWith("Domänen-Gäste") _
|
|
And Not g.ToString.StartsWith("Richtlinien-Ersteller") And Not g.ToString.StartsWith("RAS- und IAS-Server") And Not g.ToString.StartsWith("Server-Operatore") And Not g.ToString.StartsWith("Konten-Oper") And Not g.ToString.StartsWith("Prä-Windows") _
|
|
And Not g.ToString.StartsWith("SQLAcce") And Not g.ToString.StartsWith("Einstellungen eingehender") And Not g.ToString.StartsWith("Windows-Auth") And Not g.ToString.StartsWith("Terminalserver-Liz") And Not g.ToString.StartsWith("Zulässige") And Not g.ToString.StartsWith("Abgelehnte") And Not g.ToString.StartsWith("Schreibgeschützte Domänen") _
|
|
And Not g.ToString.StartsWith("Klonbare") And Not g.ToString.StartsWith("Protected User") And Not g.ToString.StartsWith("Dns") And Not g.ToString.StartsWith("DHCP") And Not g.ToString.StartsWith("IIS_IUSR") And Not g.ToString.StartsWith("Richtlinien-Ersteller") _
|
|
And Not g.ToString.StartsWith("Abgelehnte RODC-Kenn") Then
|
|
groups.Add(g.ToString)
|
|
End If
|
|
End If
|
|
Next
|
|
Me.Cursor = Cursors.Default
|
|
Return groups
|
|
Catch ex As Exception
|
|
MsgBox("Error in GetActiveDirectoryGroups:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
|
|
Me.Cursor = Cursors.Default
|
|
Return Nothing
|
|
End Try
|
|
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 UserPrincipal) = GetUsersForGroup(group)
|
|
MyDataset.TBAD_Users.Clear()
|
|
For Each user In users
|
|
Dim newUserRow As MyDataset.TBAD_UsersRow
|
|
newUserRow = MyDataset.TBAD_Users.NewTBAD_UsersRow
|
|
Try
|
|
Dim userldap As UserPrincipal = user
|
|
Dim PRENAME As String = userldap.GivenName
|
|
Dim NAME As String = userldap.Surname
|
|
Dim USERNAME As String = userldap.SamAccountName
|
|
Dim _name = userldap.DisplayName
|
|
Dim _name1 = userldap.Name
|
|
Dim _name3 = userldap.Name
|
|
Try
|
|
newUserRow.Username = userldap.SamAccountName
|
|
Catch ex As Exception
|
|
newUserRow.Username = user.ToString
|
|
End Try
|
|
Dim email As String
|
|
Try
|
|
email = userldap.EmailAddress
|
|
Catch ex As Exception
|
|
email = ""
|
|
End Try
|
|
newUserRow.Prename = PRENAME
|
|
newUserRow.Surname = NAME
|
|
newUserRow.Email = email
|
|
Catch ex As Exception
|
|
ClassLogger.Add("Unexpected Error in Read User LDAP-Configurations: " & vbNewLine)
|
|
End Try
|
|
MyDataset.TBAD_Users.Rows.Add(newUserRow)
|
|
Next
|
|
Me.Cursor = Cursors.Default
|
|
|
|
End Sub
|
|
|
|
Private Sub btnAddUsers_Click(sender As Object, e As EventArgs) Handles btnAddUsers.Click
|
|
Try
|
|
Dim usersAdded As Integer = 0
|
|
|
|
For Each row As DataRow In MyDataset.TBAD_Users.Rows
|
|
If CBool(row.Item(0)) = CBool(True) Then
|
|
Dim USERNAME As String = row.Item(1)
|
|
|
|
Dim PRENAME As String = row.Item(2)
|
|
Dim NAME As String = row.Item(3)
|
|
Dim email As String
|
|
Try
|
|
email = row.Item(4)
|
|
Catch ex As Exception
|
|
email = ""
|
|
End Try
|
|
Dim SQL
|
|
If Not UserExists(USERNAME) Then
|
|
SQL = "INSERT INTO TBDD_USER(PRENAME, NAME, USERNAME, EMAIL, MODULE_GI,LANGUAGE) VALUES('" & PRENAME & "', '" & NAME & "', '" & USERNAME & "','" & email & "'," & 1 & ",'" & USER_LANGUAGE & "')"
|
|
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
|
|
End If
|
|
|
|
Next
|
|
|
|
If USER_LANGUAGE = "de-DE" Then
|
|
If usersAdded = 1 Then
|
|
MsgBox(usersAdded & " neuer Benutzer hinzugefügt", MsgBoxStyle.Information)
|
|
Else
|
|
MsgBox(usersAdded & " neue Benutzer hinzugefügt", MsgBoxStyle.Information)
|
|
End If
|
|
Else
|
|
If usersAdded = 1 Then
|
|
MsgBox(usersAdded & " new user added", MsgBoxStyle.Information)
|
|
Else
|
|
MsgBox(usersAdded & " new users added", MsgBoxStyle.Information)
|
|
End If
|
|
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 Each Row As DataRow In MyDataset.TBAD_Users.Rows
|
|
Row.Item(0) = True
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub tbSelectNone_Click(sender As Object, e As EventArgs) Handles tbSelectNone.Click
|
|
For Each Row As DataRow In MyDataset.TBAD_Users.Rows
|
|
Row.Item(0) = False
|
|
Next
|
|
End Sub
|
|
|
|
|
|
|
|
'Private Sub clbUsers_MouseClick(sender As Object, e As MouseEventArgs)
|
|
' 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 |