RecordOrganizer/app/DD-Record-Organiser/frmUserKonfig_AddUsers.vb

Imports System.DirectoryServices
Imports System.DirectoryServices.ActiveDirectory
Imports System.DirectoryServices.AccountManagement

Public Class frmUserKonfig_AddUsers

    Private Sub formUserConfig_AddUsers_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Try
            Cursor = Cursors.WaitCursor
            GetGroups(Environment.UserName)
           
        Catch ex As Exception
            MsgBox("Error in Load Groups:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
        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
            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)

        clbUsers.Items.Clear()
        For Each user In users
            clbUsers.Items.Add(user)
        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 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
            If Not UserExists(USERNAME) Then
                SQL = "INSERT INTO TBDD_USER(PRENAME, NAME, USERNAME, EMAIL, MODULE_RECORD_ORG,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_RECORD_ORG = 1 WHERE UPPER(USERNAME) = UPPER('" & USERNAME & "')"
                If ClassDatabase.Execute_non_Query(SQL) = True Then
                    usersAdded = usersAdded + 1
                End If
            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

    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) = 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
        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(Environment.UserName)
        End If
    End Sub
    Public Sub GetGroups(ByVal samAccountName As String)
        Try
            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 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
                Next resultBytes
            End If
        Catch ex As Exception
            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
                        lbGroups.Items.Add(group)
                    Next
                End If
            Catch ex As Exception
                MsgBox("Error in Load Groups:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
            End Try
            Cursor = Cursors.Default
        End If
    End Sub
End Class