Imports System.Net.Dns Public Class Login Property userPrincipalName As String = "" Property BenutzeranmeldeName As String = "" Private Sub Login_Load(sender As Object, e As EventArgs) Handles MyBase.Load cSharedClasses.LoggedOnUser.FillWithLoggedOnUser(True) Class1.CheckDebug() Try userPrincipalName = System.DirectoryServices.AccountManagement.UserPrincipal.Current.UserPrincipalName Catch End Try BenutzeranmeldeName = Environment.UserDomainName & "\" & Environment.UserName ' MsgBox(userPrincipalName & vbCrLf & BenutzeranmeldeName) End Sub Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick lblInfo.Text = "" Login() ' Timer1.Enabled = False End Sub Public Sub Login() Timer1.Enabled = False Try Abfrage(userPrincipalName) Catch MsgBox("Fehler beim Anmelden!") PasswortabfrageLogin.Show() End Try End Sub Public Function Abfrage(user As String, Optional ByVal txt As Boolean = False) Dim locGroups As List(Of String) = GetUserGroupMembership(user) Dim gefunden As Boolean = False For Each group As String In locGroups If group = "CN=SG_Doku_User_FULL" Then Class1.LoggedOnUser.FillWithLoggedOnUser(True) Class1.LoggedOnUserRights = cBerechtigungen.ReadAll(Class1.LoggedOnUser.BenutzeranmeldeName) gefunden = True 'Main.Show() Class1.GroupUsers = uscntr_Benutzer.LoadAllGroupmembers() showusersinlist() ShowMain() Me.Hide() End If Next If gefunden = True Then Exit Function Else Me.WindowState = Me.WindowState.Normal PanHilfe.Visible = True If txt = True Then lblInfo.Text = "Benutzer ist nicht berechtigt!" End If End Function Function showusersinlist() Dim stringi As String = "" For Each ben As cBenutzer In Class1.GroupUsers stringi &= ben.BenutzeranmeldeName & ", " & ben.distinguishedName & vbCrLf Next MsgBox(stringi) End Function Public Function ValidateADUser(ByVal Username As String, ByVal Password As String, Optional ByVal Standort As String = "VeragSub") As Boolean Dim LDAP As String = "" Select Case Standort Case "VeragSub" LDAP = "LDAP://DC=VERAG,DC=OST,DC=DMN" Case "IMEX" LDAP = "LDAP://DC=IMEX,DC=LOCAL" End Select 'Find valid user in Active Directory Dim Success As Boolean = False Dim Entry As New System.DirectoryServices.DirectoryEntry(LDAP, Username, Password, DirectoryServices.AuthenticationTypes.Secure) Dim Searcher As New System.DirectoryServices.DirectorySearcher(Entry) Searcher.SearchScope = DirectoryServices.SearchScope.OneLevel Try Dim Results As System.DirectoryServices.SearchResult = Searcher.FindOne Success = Not (Results Is Nothing) Catch ex As Exception Success = False End Try Return Success End Function Friend Function GetUserGroupMembership(ByVal locUsername As String) As List(Of String) Dim locResult As New List(Of String) Try Dim locDirectoryEntry As New DirectoryServices.DirectoryEntry("LDAP://DC=VERAG,DC=OST,DC=DMN") ' ActiveDirectory-Pfad anpassen Dim locDirectorySearcher As New DirectoryServices.DirectorySearcher(locDirectoryEntry, "sAMAccountName=" & locUsername) Dim locSearchResult As DirectoryServices.SearchResult = locDirectorySearcher.FindOne If locSearchResult IsNot Nothing Then Dim locUserEntry As New DirectoryServices.DirectoryEntry(locSearchResult.Path) Dim locGroups As Object = locUserEntry.Invoke("Groups") For Each locGroupObj As Object In DirectCast(locGroups, IEnumerable) Dim locGroupEntry As New DirectoryServices.DirectoryEntry(locGroupObj) locResult.Add(locGroupEntry.Name) Next Else Debug.WriteLine("User nicht gefunden!") End If Dim locDirectorySearcher2 As New DirectoryServices.DirectorySearcher(locDirectoryEntry, "userPrincipalName=" & locUsername) Dim locSearchResult2 As DirectoryServices.SearchResult = locDirectorySearcher2.FindOne If locSearchResult2 IsNot Nothing Then Dim locUserEntry As New DirectoryServices.DirectoryEntry(locSearchResult2.Path) Dim locGroups As Object = locUserEntry.Invoke("Groups") For Each locGroupObj As Object In DirectCast(locGroups, IEnumerable) Dim locGroupEntry As New DirectoryServices.DirectoryEntry(locGroupObj) locResult.Add(locGroupEntry.Name) Next Else Debug.WriteLine("User nicht gefunden!") End If Catch ex As Exception MessageBox.Show(ex.Message, "GetUserGroupMembership", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try Return locResult End Function Private Sub btnLogin_Click(sender As Object, e As EventArgs) Handles btnLogin.Click If ValidateADUser(txtUser.Text, txtPassword.Text) Then Abfrage(txtUser.Text, True) Else lblInfo.Text = "Benutzername / Passwort falsch" End If End Sub Private Sub txtPassword_KeyDown(sender As Object, e As KeyEventArgs) Handles txtPassword.KeyDown If e.KeyCode = Keys.KeyCode.Enter Then btnLogin.PerformClick() End If End Sub Function getLDAPPAth(ByVal DomainName As String) As String Select Case DomainName Case "VERAGOST" Case "VERAG-NCTS" Case "" End Select End Function Function ShowMain() Dim main As New Main For Each right As cBerechtigungen In Class1.LoggedOnUserRights If right.Standort = "DokuAdmin" And right.Zugriff = "Y" Then main.BenutzerToolStripMenuItem.Enabled = True : Exit For Else main.BenutzerToolStripMenuItem.Enabled = False End If Next main.Show() End Function End Class 'userPrincipalName