Imports System.Net.Dns Imports VERAG_PROG_ALLGEMEIN Imports System.Reflection Public Class Login Property userPrincipalName As String = "" Property BenutzeranmeldeName As String = "" Private Sub Login_Load(sender As Object, e As EventArgs) Handles MyBase.Load Dim LDAP As String = ReturnLDAP(Environment.UserDomainName) Class1.LoggedOnUser.FillWithLoggedOnUser(True, LDAP) Class1.DebugText = LDAP ' Class1.DebugText &= Environment.UserDomainName & vbCrLf 'Class1.DebugText &= ReturnLDAP(Environment.UserDomainName) & vbCrLf Class1.CheckDebug(True) Try userPrincipalName = System.DirectoryServices.AccountManagement.UserPrincipal.Current.UserPrincipalName Catch ex As Exception MsgBox("Login_Load: " & ex.Message) End Try BenutzeranmeldeName = Environment.UserDomainName & "\" & Environment.UserName ' MsgBox(userPrincipalName & vbCrLf & BenutzeranmeldeName) End Sub Private Function ReturnLDAP(ByVal DomainName As String) As String Select Case DomainName Case "IMEX" Return "LDAP://DC=IMEX,DC=LOCAL" Case "VERAGNEUHAUS" Return "LDAP://DC=VERAGNEUHAUS,DC=LOCAL" Case "VERAGOST" Return "LDAP://DC=VERAG,DC=OST,DC=DMN" End Select End Function Public Function LoadUSRID() Dim ds As New DataSet cSQL.SQL2DS("select * from [ADMIN].dbo.tblMitarbeiter where mit_aliasad_domain = '" & Environment.UserDomainName & "' AND mit_AliasAD_Username = '" & Environment.UserName & "'", ds) VERAG_PROG_ALLGEMEIN.cAllgemein.USRID = ds.Tables(0).Rows(0).Item("mit_id") VERAG_PROG_ALLGEMEIN.cAllgemein.LOAD_DATA() 'MsgBox(VERAG_PROG_ALLGEMEIN.cAllgemein.USRID) End Function 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) ' LoadUSRID() Catch ex As Exception 'MsgBox("Fehler beim Anmelden!") MsgBox("Loginfehler! Zeile 59" & vbCrLf & ex.Message & vbCrLf & userPrincipalName) 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 Dim debugtext As String = "" Try Class1.LoggedOnUser.FillWithLoggedOnUser(True) Class1.GroupUsers = uscntr_Benutzer.LoadAllGroupmembers() 'showusersinlist() For Each usr As cBenutzer In Class1.GroupUsers 'MsgBox(usr.msDSPrincipalName & vbCrLf & cSharedClasses.LoggedOnUser.msDSPrincipalName) If usr.msDSPrincipalName.ToString = Class1.LoggedOnUser.msDSPrincipalName.ToString Then ' MsgBox("Treffer!") Class1.LoggedOnUserRights = cBerechtigungen.ReadAll(Class1.LoggedOnUser.BenutzeranmeldeName) debugtext &= usr.msDSPrincipalName.ToString & vbCrLf gefunden = True LoadUSRID() ShowMain() Me.Hide() Exit For End If Next If gefunden = True Then Exit Function Else Me.WindowState = Me.WindowState.Normal PanHilfe.Visible = True MsgBox(debugtext ) If txt = True Then lblInfo.Text = "Benutzer ist nicht berechtigt!" End If Catch ex As Exception MsgBox("Fehler Abfrage: " & ex.Message & debugtext) End Try 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 'Dim locDirectorySearcher3 As New DirectoryServices.DirectorySearcher(locDirectoryEntry, "msDS-PrincipalName=" & locUsername) 'Dim locSearchResult3 As DirectoryServices.SearchResult = locDirectorySearcher3.FindOne 'If locSearchResult3 IsNot Nothing Then ' Dim locUserEntry As New DirectoryServices.DirectoryEntry(locSearchResult3.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("GetUserGroupMembership: " & 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(Optional ByVal MessageActivated As Boolean = True) Dim main As New Main For Each right As cBerechtigungen In Class1.LoggedOnUserRights If right.Standort = "DokuAdmin" And right.Zugriff = "Y" Then Class1.LoggedOnUserisAdmin = True main.BenutzerToolStripMenuItem.Enabled = True main.NetzwerkeToolStripMenuItem.Enabled = True main.AllesSichernCSVToolStripMenuItem.Enabled = True Exit For Else main.BenutzerToolStripMenuItem.Enabled = False main.NetzwerkeToolStripMenuItem.Enabled = False main.AllesSichernCSVToolStripMenuItem.Enabled = False End If Next main.picAVISOMessenger.Enabled = MessageActivated main.Show() End Function End Class 'userPrincipalName