MS18042016

This commit is contained in:
SchreiberM
2016-04-19 08:29:57 +02:00
parent b0a74d2e94
commit 034718d22e
37 changed files with 4334 additions and 1746 deletions

View File

@@ -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