Imports System.Reflection Public Class cBenutzer Property Name As String = "" Property userPrincipalName As String = "" Property Domäne As String = "" Property BenutzeranmeldeName As String = "" Property Nachname As String = "" Property Vorname As String = "" Property Mail As String = "" Property distinguishedName As String = "" Property cn As String = "" Property msDSPrincipalName As String = "" Property localdistinguishedName As String = "" Property suchname As String = "" Function FillWithLoggedOnUser(Optional ByVal dcabfrage As Boolean = False, Optional ByVal LDAPa As String = "") '"LDAP://DC=VERAG,DC=OST,DC=DMN") Try userPrincipalName = System.DirectoryServices.AccountManagement.UserPrincipal.Current.UserPrincipalName Name = System.DirectoryServices.AccountManagement.UserPrincipal.Current.Name Catch End Try Domäne = System.DirectoryServices.ActiveDirectory.Domain.GetCurrentDomain.ToString BenutzeranmeldeName = Environment.UserDomainName & "\" & Environment.UserName If dcabfrage = True Then 'Class1.DebugText = userPrincipalName & LDAPa FillFromDC(userPrincipalName, "userPrincipalName", LDAPa) End If End Function Function FillFromDC(ByVal searchname As String, Optional ByVal searchfilter As String = "distinguishedName", Optional ByVal LDAP As String = "LDAP://DC=VERAG,DC=OST,DC=DMN") Try localdistinguishedName = searchname suchname = searchname If searchname.Contains("ForeignSecurityPrincipals") Then 'MsgBox("!") Dim FSlocDirectoryEntry As New DirectoryServices.DirectoryEntry(LDAP) Dim FSsearcher As New DirectoryServices.DirectorySearcher With FSsearcher .SearchRoot = FSlocDirectoryEntry .Filter = searchfilter & "=" & searchname .PropertiesToLoad.Add("msDS-PrincipalName") End With Dim FSResult As DirectoryServices.SearchResult = FSsearcher.FindOne ' MsgBox(FSResult.Properties("msDS-PrincipalName").Count) searchname = FSResult.Properties("msDS-PrincipalName").Item(0) Dim DomainName As String = searchname.Substring(0, searchname.IndexOf("\")) ' MsgBox(DomainName) Select Case DomainName Case "IMEX" Me.Domäne = "imex.local" LDAP = "LDAP://DC=IMEX,DC=LOCAL" 'MsgBox("Me.Domäne = imex.local") Case "VERAGNEUHAUS" Me.Domäne = "VERAGNEUHAUS.local" LDAP = "LDAP://DC=VERAGNEUHAUS,DC=LOCAL" Case "VERAGOST" Me.Domäne = "verag.ost.dmn" End Select ' MsgBox(searchname) searchname = searchname.Substring((searchname.IndexOf("\") + 1), searchname.Length - searchname.IndexOf("\") - 1) searchfilter = "sAMAccountName" Else 'Me.Domäne = "verag.ost.dmn" End If If LDAP = "LDAP://DC=VERAG,DC=OST,DC=DMN" Then Me.Domäne = "verag.ost.dmn" ' MsgBox(searchname & vbCrLf & searchfilter & vbCrLf & Me.Domäne & vbCrLf & LDAP) Dim locDirectoryEntry As New DirectoryServices.DirectoryEntry(LDAP) ' Dim Searcher1 As New DirectoryServices.DirectorySearcher(locDirectoryEntry, searchfilter & "=" & searchname) Dim searcher As New DirectoryServices.DirectorySearcher With searcher .SearchRoot = locDirectoryEntry .Filter = searchfilter & "=" & searchname ' .ExtendedDN = True .PropertiesToLoad.Add("sn") .PropertiesToLoad.Add("givenName") .PropertiesToLoad.Add("mail") .PropertiesToLoad.Add("distinguishedName") .PropertiesToLoad.Add("cn") .PropertiesToLoad.Add("distinguishedName") .PropertiesToLoad.Add("msDS-PrincipalName") .PropertiesToLoad.Add("userPrincipalName") End With Dim Result As DirectoryServices.SearchResult = searcher.FindOne Me.Nachname = blablabla(Result, "sn") Me.Vorname = blablabla(Result, "givenName") Me.Mail = blablabla(Result, "mail") Me.distinguishedName = blablabla(Result, "distinguishedName") Me.cn = blablabla(Result, "cn") Me.Name = blablabla(Result, "cn") Me.BenutzeranmeldeName = blablabla(Result, "msDS-PrincipalName") Me.msDSPrincipalName = blablabla(Result, "msDS-PrincipalName") Me.userPrincipalName = blablabla(Result, "userPrincipalName") Catch ex As Exception MsgBox("FillFromDC: " & ex.Message) End Try End Function Function isDokuAdmin() As Boolean Dim ds As New DataSet SQL.SQL2DS("select * from TbL_Berechtigungen where Benutzeranmeldename = '" & Me.BenutzeranmeldeName & "' AND Standort = 'DokuAdmin'", ds) If ds.Tables(0).Rows.Count > 0 Then Return True Else Return False End If End Function Function blablabla(result As DirectoryServices.SearchResult, Prop As String) As String If result.Properties(Prop).Count = 0 Then Return "" Else Return result.Properties(Prop)(0) End If End Function Function emptyreturn(ByVal ding As String) If ding Is Nothing Then Return "" Else Return ding End If End Function End Class Public Class cBenutzergruppe Public Shared Function GetUsersInGroup(ByVal groupname As String, Optional ByVal LDAP As String = "LDAP://DC=VERAG,DC=OST,DC=DMN") As List(Of String) Dim Userlist As New List(Of String) Dim locDirectoryEntry As New DirectoryServices.DirectoryEntry(LDAP) Dim Searcher As New DirectoryServices.DirectorySearcher(locDirectoryEntry, "sAMAccountName=" & groupname) Dim Result As DirectoryServices.SearchResult = Searcher.FindOne If Result IsNot Nothing Then For Each User In Result.Properties("Member") Userlist.Add(User) Next End If Return Userlist End Function End Class Public Class cSharedClasses ' Public Shared LoggedOnUser As New cBenutzer End Class