MS18042016
This commit is contained in:
@@ -69,13 +69,6 @@ Public Class frmUserKonfig_AddUsers
|
||||
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
|
||||
@@ -171,17 +164,31 @@ Public Class frmUserKonfig_AddUsers
|
||||
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
|
||||
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)
|
||||
|
||||
@@ -244,16 +251,16 @@ Public Class frmUserKonfig_AddUsers
|
||||
|
||||
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 ctx As PrincipalContext = New PrincipalContext(ContextType.Domain)
|
||||
Dim group As GroupPrincipal = GroupPrincipal.FindByIdentity(ctx, g)
|
||||
|
||||
'Dim u = group.GetMembers(True)
|
||||
Dim u = group.GetMembers(True)
|
||||
|
||||
'For Each user In u
|
||||
' If user.GetType().Name = "UserPrincipal" Then
|
||||
' users.Add(user)
|
||||
' End If
|
||||
'Next
|
||||
For Each user In u
|
||||
If user.GetType().Name = "UserPrincipal" Then
|
||||
users.Add(user)
|
||||
End If
|
||||
Next
|
||||
|
||||
Return users
|
||||
End Function
|
||||
@@ -261,20 +268,29 @@ Public Class frmUserKonfig_AddUsers
|
||||
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
|
||||
|
||||
Dim users As List(Of UserPrincipal) = GetUsersForGroup(group)
|
||||
MyDataset.TBAD_Users.Clear()
|
||||
For Each user In users
|
||||
If user.EndsWith("/") Or user.EndsWith("\") Then
|
||||
user = user.Replace("/", "")
|
||||
user = user.Replace("\", "")
|
||||
End If
|
||||
clbUsers.Items.Add(user)
|
||||
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
|
||||
Try
|
||||
newUserRow.Username = userldap.SamAccountName
|
||||
Catch ex As Exception
|
||||
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
|
||||
ClassLogger.Add("Unexpected Error in Read User LDAP-Configurations: " & vbNewLine)
|
||||
End Try
|
||||
MyDataset.TBAD_Users.Rows.Add(newUserRow)
|
||||
Next
|
||||
Me.Cursor = Cursors.Default
|
||||
|
||||
@@ -282,30 +298,23 @@ Public Class frmUserKonfig_AddUsers
|
||||
|
||||
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 row As DataRow In MyDataset.TBAD_Users.Rows
|
||||
If row.Item(0) = CBool(True) Then
|
||||
Dim USERNAME As String = row.Item(1)
|
||||
|
||||
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 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 = 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)
|
||||
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
|
||||
@@ -315,14 +324,9 @@ Public Class frmUserKonfig_AddUsers
|
||||
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
|
||||
@@ -354,48 +358,36 @@ Public Class frmUserKonfig_AddUsers
|
||||
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)
|
||||
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 i = 0 To clbUsers.Items.Count - 1
|
||||
clbUsers.SetItemChecked(i, False)
|
||||
For Each Row As DataRow In MyDataset.TBAD_Users.Rows
|
||||
Row.Item(0) = 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
|
||||
|
||||
|
||||
'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
|
||||
|
||||
' 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
|
||||
Reference in New Issue
Block a user