Imports System.DirectoryServices Imports System.DirectoryServices.ActiveDirectory Imports System.DirectoryServices.AccountManagement Imports System.IO Public Class frmUserKonfig_AddUsers Private DT_ADD_USERS As DataTable ' Private DT_GROUPS_EXCLUSIVE As DataTable Private Sub frmUserKonfig_AddUsers_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing Try Dim Filename As String = String.Format("{0}-UserLayout.xml", GridViewUsers.Name) Dim XMLPath = System.IO.Path.Combine(Application.UserAppDataPath(), Filename) GridViewUsers.SaveLayoutToXml(XMLPath) Catch ex As Exception LOGGER.Error(ex) MsgBox("Error in SaveGrid_Layout:" & vbNewLine & ex.Message) End Try End Sub Private Sub formUserConfig_AddUsers_Load(sender As Object, e As EventArgs) Handles MyBase.Load Try Cursor = Cursors.WaitCursor Dim dt As New DataTable Dim colBoolean As DataColumn = New DataColumn("Select") colBoolean.DataType = System.Type.GetType("System.Boolean") colBoolean.DefaultValue = False dt.Columns.Add(colBoolean) dt.Columns.Add("Username") dt.Columns.Add("Prename") dt.Columns.Add("Surname") dt.Columns.Add("Email") Dim colInt32 As DataColumn = New DataColumn("ID") colInt32.DataType = System.Type.GetType("System.Int32") dt.Columns.Add(colInt32) colInt32.AutoIncrement = True DT_ADD_USERS = dt 'Dim sql = "SELECT * FROM TBPMO_AD_GROUP_EXCLUSIVE" 'DT_GROUPS_EXCLUSIVE = ClassDatabase.Return_Datatable(sql) GetGroups(USER_USERNAME) Catch ex As Exception LOGGER.Error(ex) MsgBox("Error in Load Groups:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Try Dim Filename As String = String.Format("{0}-UserLayout.xml", GridViewUsers.Name) Dim XMLPath = System.IO.Path.Combine(Application.UserAppDataPath(), Filename) If File.Exists(XMLPath) Then GridViewUsers.RestoreLayoutFromXml(XMLPath) 'grvwGrid.ClearGrouping() GridViewUsers.ClearSelection() End If Catch ex As Exception LOGGER.Error(ex) MsgBox("Error in Load Grid_Layout:" & vbNewLine & ex.Message) End Try Cursor = Cursors.Default End Sub Function GetActiveDirectoryGroups() As List(Of String) 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 Return groups Catch ex As Exception LOGGER.Error(ex) MsgBox("Error in GetActiveDirectoryGroups:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return Nothing End Try 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 Dim group As String = lbGroups.SelectedItem Dim users As List(Of UserPrincipal) = GetUsersForGroup(group) DT_ADD_USERS.Clear() For Each user In users Dim newUserRow As DataRow = DT_ADD_USERS.NewRow Try Dim userldap As UserPrincipal = user Dim PRENAME As String = userldap.GivenName Dim NAME As String = userldap.Surname Dim USERNAME As String = userldap.SamAccountName Try newUserRow("Username") = userldap.SamAccountName Catch ex As Exception LOGGER.Error(ex) newUserRow("Username") = user.ToString End Try Dim email As String = userldap.EmailAddress newUserRow("Prename") = PRENAME newUserRow("Surname") = NAME newUserRow("Email") = email Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Read User LDAP-Configurations: " & vbNewLine) End Try DT_ADD_USERS.Rows.Add(newUserRow) TBAD_UsersBindingSource.DataSource = DT_ADD_USERS Next End Sub Private Sub btnAddUsers_Click(sender As Object, e As EventArgs) Handles btnAddUsers.Click 'Dim items As CheckedListBox.CheckedItemCollection = clbUsers.CheckedItems Dim usersAdded As Integer = 0 'If items.Count = 0 Then ' MsgBox("Keine Benutzer ausgewählt!", MsgBoxStyle.Information) ' Exit Sub 'End If For Each row As DataRow In DT_ADD_USERS.Rows If row.Item(0) = CBool(True) Then Dim USERNAME As String = row.Item(1) Dim PRENAME As String Try PRENAME = row.Item(2) Catch ex As Exception LOGGER.Error(ex) PRENAME = "" End Try Dim NAME As String = row.Item(3) Try NAME = row.Item(3) Catch ex As Exception LOGGER.Error(ex) NAME = "" End Try Dim email As String Try email = row.Item(4) Catch ex As Exception LOGGER.Error(ex) email = "" End Try Dim SQL If Not UserExists(USERNAME) Then SQL = "INSERT INTO TBDD_USER(PRENAME, NAME, USERNAME, EMAIL, ADDED_WHO) VALUES('" & PRENAME & "', '" & NAME & "', '" & USERNAME & "','" & email & "','" & USER_USERNAME & "')" If ClassDatabase.Execute_non_Query(SQL, False) = True Then Dim ID = ClassDatabase.Execute_Scalar("SELECT MAX(GUID) FROM TBDD_USER", CONNECTION_STRING, "btnAddUsers_Click") Dim msg = String.Format(">> USER {0}, {1} - {2} ADDED TO CONFIGURATION", NAME, PRENAME, USERNAME) LOGGER.Info(msg) SQL = String.Format("INSERT INTO TBDD_USER_MODULES (USER_ID,MODULE_ID) VALUES ({0},(SELECT GUID FROM TBDD_MODULES WHERE SHORT_NAME = 'PM'))", ID) If ClassDatabase.Execute_non_Query(SQL, False) = False Then MsgBox("Attention: could not add user to module! - Please check the log.", MsgBoxStyle.Exclamation) End If usersAdded = usersAdded + 1 End If Else SQL = String.Format("UPDATE TBDD_USER SET PRENAME = '{0}', NAME = '{1}', EMAIL = '{2}' WHERE UPPER(USERNAME) = UPPER('{3}')", PRENAME, NAME, email, USERNAME) If ClassDatabase.Execute_non_Query(SQL, False) = True Then usersAdded = usersAdded + 1 End If End If End If Next 'For Each item As UserPrincipal In items ' Dim user As UserPrincipal = item ' Dim PRENAME As String = user.GivenName ' Dim NAME As String = user.Surname ' Dim USERNAME As String = user.SamAccountName ' Dim email As String = user.EmailAddress ' Dim SQL 'Next MsgBox(usersAdded & " Benutzer hinzugefügt/upgedatet!", MsgBoxStyle.Information) 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, CONNECTION_STRING, "UserExists") = Nothing Then Return False Else Return True End If Catch ex As Exception LOGGER.Error(ex) 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 DT_ADD_USERS.Rows row.Item(0) = CBool(True) Next End Sub Private Sub tbSelectNone_Click(sender As Object, e As EventArgs) Handles tbSelectNone.Click For Each row As DataRow In DT_ADD_USERS.Rows row.Item(0) = CBool(False) Next End Sub 'Private Sub clbUsers_SelectedIndexChanged(sender As Object, e As EventArgs) ' ToolTipController1.HideHint() ' Dim userstring As String = clbUsers.SelectedItem.ToString ' Dim userldap As UserPrincipal = clbUsers.SelectedItem ' Dim PRENAME As String = userldap.GivenName ' Dim NAME As String = userldap.Surname ' Dim USERNAME As String = userldap.SamAccountName ' Dim email As String = userldap.EmailAddress ' ToolTipController1.ShowHint("Used ldap paramters:", userstring & USERNAME & vbNewLine & email, DevExpress.Utils.ToolTipLocation.RightCenter) 'End Sub Private Sub RBCheck2_CheckedChanged(sender As Object, e As EventArgs) Handles RBCheck2.CheckedChanged If RBCheck2.Checked Then GetGroups(USER_USERNAME) End If End Sub Public Sub GetGroups(ByVal samAccountName As String) Try 'If IsNothing(DT_GROUPS_EXCLUSIVE) Then ' Exit Sub 'End If Cursor = Cursors.WaitCursor lbGroups.Items.Clear() Dim domainConnection = New DirectoryEntry() domainConnection.AuthenticationType = System.DirectoryServices.AuthenticationTypes.Secure Dim samSearcher = New DirectorySearcher() samSearcher.SearchRoot = domainConnection samSearcher.Filter = "(samAccountName=" & samAccountName & ")" samSearcher.PropertiesToLoad.Add("displayName") Dim samResult = samSearcher.FindOne() If samResult IsNot Nothing Then Dim theUser = samResult.GetDirectoryEntry() theUser.RefreshCache(New String() {"tokenGroups"}) For Each resultBytes As Byte() In theUser.Properties("tokenGroups") Dim SID = New System.Security.Principal.SecurityIdentifier(resultBytes, 0) Dim sidSearcher = New DirectorySearcher() sidSearcher.SearchRoot = domainConnection sidSearcher.Filter = "(objectSid=" & SID.Value & ")" sidSearcher.PropertiesToLoad.Add("name") Dim sidResult = sidSearcher.FindOne() If sidResult IsNot Nothing Then Dim groupname = CStr(sidResult.Properties("name")(0)) 'If Not IsNothing(DT_GROUPS_EXCLUSIVE) Then ' If DT_GROUPS_EXCLUSIVE.Rows.Count > 0 Then ' For Each GROUP_EXCL As DataRow In DT_GROUPS_EXCLUSIVE.Rows ' If GROUP_EXCL.Item("GROUP_NAME").ToString.ToUpper = groupname.ToUpper Then ' lbGroups.Items.Add(groupname) ' End If ' Next ' Else If Not groupname.StartsWith("WinRMR") And Not groupname.StartsWith("Gäst") And Not groupname.StartsWith("Druck") And Not groupname.StartsWith("Sicherungs") And Not groupname.StartsWith("Replikations") And Not groupname.StartsWith("Netzwerkskon") _ And Not groupname.StartsWith("Leistungs") And Not groupname.StartsWith("Distributed COM") And Not groupname.StartsWith("IIS_") And Not groupname.StartsWith("Kryptografie") And Not groupname.StartsWith("Ereignis") And Not groupname.StartsWith("Zertifikat") _ And Not groupname.StartsWith("RDS-") And Not groupname.StartsWith("Hyper-V") And Not groupname.StartsWith("Zugriffssteuerungs") And Not groupname.StartsWith("Remoteverwaltungs") And Not groupname.StartsWith("Domänencomput") And Not groupname.StartsWith("Domänen-Gäste") _ And Not groupname.StartsWith("Richtlinien-Ersteller") And Not groupname.StartsWith("SQLAccess") And Not groupname.StartsWith("RAS- und IAS-Server") And Not groupname.StartsWith("Server-Operatore") And Not groupname.StartsWith("Konten-Oper") And Not groupname.StartsWith("Prä-Windows") _ And Not groupname.StartsWith("Einstellungen eingehender") And Not groupname.StartsWith("Windows-Auth") And Not groupname.StartsWith("Terminalserver-Liz") And Not groupname.StartsWith("Zulässige") And Not groupname.StartsWith("Abgelehnte") And Not groupname.StartsWith("Schreibgeschützte Domänen") _ And Not groupname.StartsWith("Klonbare") And Not groupname.StartsWith("PrivUser") And Not groupname.StartsWith("Protected User") And Not groupname.StartsWith("Dns") And Not groupname.StartsWith("DHCP") And Not groupname.StartsWith("IIS_IUSR") And Not groupname.StartsWith("Richtlinien-Ersteller") _ And Not groupname.StartsWith("Abgelehnte RODC-Kenn") And Not groupname.StartsWith("Reporting") Then ' Console.WriteLine(CStr(sidResult.Properties("name")(0))) lbGroups.Items.Add(groupname) End If ' End If 'End If End If Next resultBytes lblgroup_refresh() End If Catch ex As Exception LOGGER.Error(ex) MsgBox("Error in GetGroups:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Cursor = Cursors.Default End Sub Private Sub RBCheck1_CheckedChanged(sender As Object, e As EventArgs) Handles RBCheck1.CheckedChanged If RBCheck1.Checked Then Try Cursor = Cursors.WaitCursor Dim groups = GetActiveDirectoryGroups() lbGroups.Items.Clear() If Not IsNothing(groups) Then For Each group In groups 'If Not IsNothing(DT_GROUPS_EXCLUSIVE) Then ' If DT_GROUPS_EXCLUSIVE.Rows.Count > 0 Then ' For Each GROUP_EXCL As DataRow In DT_GROUPS_EXCLUSIVE.Rows ' If GROUP_EXCL.Item("GROUP_NAME").ToString.ToUpper = group.ToUpper Then ' lbGroups.Items.Add(group) ' End If ' Next ' Else lbGroups.Items.Add(group) ' End If 'End If Next lblgroup_refresh() End If Catch ex As Exception LOGGER.Error(ex) MsgBox("Error in Load Groups:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Cursor = Cursors.Default End If End Sub Sub lblgroup_refresh() 'If Not IsNothing(DT_GROUPS_EXCLUSIVE) Then ' If DT_GROUPS_EXCLUSIVE.Rows.Count > 0 Then ' lbllimited.Text = String.Format("AD-Groups are limited through configuration to '{0}' group(s)!", DT_GROUPS_EXCLUSIVE.Rows.Count) ' lbllimited.Visible = True ' Else ' lbllimited.Visible = False ' End If 'Else lbllimited.Visible = False 'End If End Sub End Class