Imports System.Collections.Generic
Imports System.DirectoryServices
Imports System.DirectoryServices.ActiveDirectory
Imports System.Security.Permissions
Imports System.ComponentModel
Imports System.Security
Imports System.Text

<DirectoryServicesPermissionAttribute(SecurityAction.LinkDemand, Unrestricted:=True)> _
<DirectoryServicesPermissionAttribute(SecurityAction.InheritanceDemand, Unrestricted:=True)> _
<DirectoryServicesPermissionAttribute(SecurityAction.Assert, Unrestricted:=True)> _
Public Class ActiveDirectory

    Private user As String
    Private pass As String

    Public Enum LogonType As Integer
        LOGON32_LOGON_INTERACTIVE = 2
        LOGON32_LOGON_NETWORK = 3
        LOGON32_LOGON_BATCH = 4
        LOGON32_LOGON_SERVICE = 5
        LOGON32_LOGON_UNLOCK = 7
        LOGON32_LOGON_NETWORK_CLEARTEXT = 8
        LOGON32_LOGON_NEW_CREDENTIALS = 9
    End Enum

    Public Structure __TrustInformation
        Public SourceName As String
        Public TargetName As String
        Public TrustDirection As String
        Public TrustType As String
    End Structure

    Public Structure __Domain
        Public DomainMode As String
        Public TrustRelationships As List(Of __TrustInformation)
    End Structure

    Public Structure __ReplicationOperationInformationFailures
        Public ConsecutiveFailureCount As String
        Public FirstFailureTime As String
        Public LastErrorCode As String
        Public LastErrorMessage As String
        Public SourceServer As String
    End Structure

    Public Structure __ReplicationOperationInformation
        Public CurrentOperation
        Public OperationStartTime
        Public PendingOperations
        Public Failures As List(Of __ReplicationOperationInformationFailures)
    End Structure

    Public Structure __DomainController
        Public CurrentTime As String
        Public DomainName As String
        Public ForestName As String
        Public HighestCommittedUsn As String
        Public InboundConnections As String
        Public IPAddress As String
        Public Name As String
        Public OSVersion As String
        Public OutboundConnections As String
        Public Partitions As String
        Public Roles As String
        Public SiteName As String
        Public SyncFromAllServersCallback As String
        Public IsGlobalCatalog As String
        Public ReplicationOperationInformation As __ReplicationOperationInformation
    End Structure

    Public Structure __Object
        Public Name As String
        Public Description As String
        Public DistinguishedName As String
    End Structure

    Public Structure __Group
        Public Name As String
        Public Description As String
        Public DistinguishedName As String
        Public Members As List(Of __Object)
    End Structure

    Public Property Username() As String
        Get
            Return user
        End Get
        Set(ByVal value As String)
            user = value
        End Set
    End Property

    Public Property Password() As String
        Get
            Return pass
        End Get
        Set(ByVal value As String)
            pass = value
        End Set
    End Property

    Public ReadOnly Property ClassName() As String
        Get
            Return "ActiveDirectory"
        End Get
    End Property

    Private Declare Auto Function LogonUser Lib "advapi32.dll" (ByVal lpszUsername As String, _
                                                                ByVal lpszDomain As String, _
                                                                ByVal lpszPassword As String, _
                                                                ByVal dwLogonType As LogonType, _
                                                                ByVal dwLogonProvider As Integer, _
                                                                ByRef phToken As IntPtr _
                                                            ) As Integer

    Private Declare Auto Function CloseHandle Lib "kernel32.dll" (ByVal hObject As IntPtr) As Boolean

    Public Sub New()
        user = ""
        pass = ""
    End Sub

    Public Sub New(ByVal username As String, ByVal password As String)
        user = username
        pass = password
    End Sub

    Public Function AddDoaminUserToGroup(ByVal LocalSystemName As String, _
                                         ByVal DOMAIN As String, _
                                         ByVal DomainUserName As String, _
                                         ByVal AddToLocalGroup As String _
                                         ) As Boolean

        Try
            Dim LocalSystem As New DirectoryEntry("WinNT://" & LocalSystemName & ",computer")
            Dim DomainName As New DirectoryEntry("WinNT://" & DOMAIN)
            Dim DOMUSR As DirectoryEntry = DomainName.Children.Find(DomainUserName, "user")
            Dim LocalGroup As DirectoryEntry = LocalSystem.Children.Find("Test", "group")
            LocalGroup.Invoke("Add", New Object() {DOMUSR.Path.ToString})
            Return True
        Catch ex As Exception
            Return False
        End Try

    End Function

    ''' <summary>
    ''' Authenticates the user.
    ''' </summary>
    ''' <param name="domain">The domain.</param>
    ''' <param name="username">The username.</param>
    ''' <param name="password">The password.</param>
    ''' <returns></returns>
    Public Shared Function AuthenticateUser(ByVal domain As String, ByVal username As String, ByVal password As String) As Boolean
        Dim pwd As New SecureString()
        Dim bAuth As Boolean = False
        Dim entry As DirectoryEntry = Nothing
        For Each c As Char In password
            pwd.AppendChar(c)
        Next
        pwd.MakeReadOnly()
        Dim pPwd As IntPtr = System.Runtime.InteropServices.Marshal.SecureStringToBSTR(pwd)
        Try
            entry = New DirectoryEntry(String.Concat("LDAP://", domain), username, System.Runtime.InteropServices.Marshal.PtrToStringBSTR(pPwd))
            Dim nativeObject As Object = entry.NativeObject
            bAuth = True
        Catch ex As Exception
            bAuth = False
        Finally
            entry.Close()
            entry.Dispose()
        End Try
        Return bAuth
    End Function

    Public Function UserHasLevels() As String()
        Dim Result As New System.Collections.Generic.List(Of String)
        For Each Value As Integer In System.Enum.GetValues(GetType(Security.Principal.WindowsBuiltInRole))
            If CType(My.User.CurrentPrincipal, Security.Principal.WindowsPrincipal).IsInRole( _
               CType(Value, Security.Principal.WindowsBuiltInRole)) Then
                Result.Add(CType(Value, Security.Principal.WindowsBuiltInRole).ToString())
            End If
        Next
        Return Result.ToArray()
    End Function

    ''' <summary>
    ''' Gets the duplicate keys.
    ''' </summary>
    ''' <param name="property">The property.</param>
    ''' <param name="LoadedDE">The loaded DE.</param>
    ''' <param name="name">The name.</param>
    ''' <param name="domain">The domain.</param>
    ''' <returns></returns>
    Public Function GetDuplicateKeys(ByVal [property] As String, _
                                     Optional ByVal LoadedDE As DirectoryEntry = Nothing, _
                                     Optional ByVal name As String = "", _
                                     Optional ByVal domain As String = "" _
                                     ) As ArrayList

        Dim retval As New ArrayList
        Dim res As DirectoryEntry
        If LoadedDE Is Nothing Then
            Dim r As New DirectoryEntry("LDAP://" + domain + "/", user, pass, AuthenticationTypes.Delegation)
            Dim srv As New DirectorySearcher(r)
            srv.Filter = "(name=" + name + ")"
            res = srv.FindOne.GetDirectoryEntry
        Else
            res = LoadedDE
        End If
        If res IsNot Nothing Then
            If IsArray(res.Properties([property]).Value) Then
                If TypeOf (res.Properties([property]).Value) Is System.Byte() Then
                    Dim proplist() As Byte = res.Properties([property]).Value
                    Dim converted As New StringBuilder
                    For Each tmp As Byte In proplist
                        converted.Append(tmp)
                    Next
                    retval.Add(converted.ToString)
                Else
                    Dim proplist() As Object = res.Properties([property]).Value
                    For Each tmp As String In proplist
                        retval.Add(tmp)
                    Next
                End If
            Else
                retval.Add(Convert.ToString(res.Properties([property]).Value))
            End If
        End If
        Return retval
    End Function

    ''' <summary>
    ''' Gets an Active Directory object.
    ''' </summary>
    ''' <param name="name">The name.</param>
    ''' <param name="domain">The domain.</param>
    ''' <returns></returns>
    Public Function GetObject(ByVal name As String, ByVal domain As String) As SortedList(Of String, ArrayList)
        Dim retval As New SortedList(Of String, ArrayList)
        Dim r As New DirectoryEntry("LDAP://" + domain, user, pass, AuthenticationTypes.Delegation)
        Dim srv As New DirectorySearcher(r)
        srv.Filter = "(name=" + name + ")"
        Dim res As SearchResult = srv.FindOne
        If res IsNot Nothing Then
            Dim resv As DirectoryEntry = res.GetDirectoryEntry
            For Each tmp As String In resv.Properties.PropertyNames
                Dim itemvalue As ArrayList = GetDuplicateKeys(tmp, resv)
                retval.Add(tmp, itemvalue)
            Next
        End If
        Return retval
    End Function

    ''' <summary>
    ''' Gets the directory entry.
    ''' </summary>
    ''' <param name="name">The name.</param>
    ''' <param name="domain">The domain.</param>
    ''' <returns></returns>
    Public Function GetDirectoryEntry(ByVal name As String, ByVal domain As String) As DirectoryEntry
        Dim r As New DirectoryEntry("LDAP://" + domain, user, pass, AuthenticationTypes.Delegation)
        Dim srv As New DirectorySearcher(r)
        srv.Filter = "(name=" + name + ")"
        Dim res As SearchResult = srv.FindOne
        Return res.GetDirectoryEntry
    End Function

    Public Function GetDirectoryEntry(ByVal distinguishedname As String) As DirectoryEntry
        Dim r As New DirectoryEntry(distinguishedname, user, pass, AuthenticationTypes.Delegation)
        Dim srv As New DirectorySearcher(r)
        Dim res As SearchResult = srv.FindOne
        Return res.GetDirectoryEntry
    End Function

    ''' <summary>
    ''' Gets the property value.
    ''' </summary>
    ''' <param name="property">The property.</param>
    ''' <param name="LoadedDE">The loaded DE.</param>
    ''' <param name="objectname">The objectname.</param>
    ''' <param name="domain">The domain.</param>
    ''' <returns></returns>
    Public Function GetPropertyValue(ByVal [property] As String, _
                                     Optional ByVal LoadedDE As DirectoryEntry = Nothing, _
                                     Optional ByVal objectname As String = "", _
                                     Optional ByVal domain As String = "") As ArrayList

        Dim obj As DirectoryEntry
        If LoadedDE Is Nothing Then
            obj = GetDirectoryEntry(objectname, domain)
        Else
            obj = LoadedDE
        End If
        Dim retval As ArrayList = GetDuplicateKeys([property], obj)
        Return retval
    End Function

    ''' <summary>
    ''' Gets the group.
    ''' </summary>
    ''' <param name="GroupDSN">The group DSN.</param>
    ''' <param name="IncludeMembers">if set to <c>true</c> [include members].</param>
    ''' <returns></returns>
    Public Function GetGroup(ByVal GroupDSN As String, Optional ByVal IncludeMembers As Boolean = False) As __Group
        Dim retval As __Group
        Dim r As New DirectoryEntry(GroupDSN, user, pass, AuthenticationTypes.Delegation)
        retval.Name = GetGroupDetails(GroupDSN, r).Name
        retval.Description = GetGroupDetails(GroupDSN, r).Description
        retval.DistinguishedName = GetGroupDetails(GroupDSN, r).DistinguishedName
        Dim g As __Object
        g.DistinguishedName = retval.DistinguishedName
        g.Name = retval.Name
        g.Description = retval.Description
        If IncludeMembers Then
            retval.Members = GetGroupMembers(g)
        Else
            retval.Members = Nothing
        End If
        Return retval
    End Function

    ''' <summary>
    ''' Gets the members.
    ''' </summary>
    ''' <param name="searchpath">The searchpath.</param>
    ''' <returns></returns>
    Public Function GetMembers(ByVal searchpath As String) As List(Of __Object)
        Dim retval As New List(Of __Object)
        Try
            Dim r As New DirectoryEntry(searchpath, user, pass, AuthenticationTypes.Delegation)
            For Each tmp As DirectoryEntry In r.Children
                Dim x As __Object = GetGroupDetails(tmp.Path, tmp)
                retval.Add(x)
            Next
        Catch ex As Exception

        End Try
        Return retval
    End Function

    ''' <summary>
    ''' Gets the group members.
    ''' </summary>
    ''' <param name="Group">The group.</param>
    ''' <returns></returns>
    Public Function GetGroupMembers(ByVal Group As __Object) As List(Of __Object)
        Dim retval As New List(Of __Object)
        Dim start As Integer
        Dim len As Integer
        Dim ende As Integer
        Dim dom As String = ""
        Try
            start = Group.DistinguishedName.IndexOf("/") + 2
            len = Group.DistinguishedName.Length
            ende = Group.DistinguishedName.LastIndexOf("/")
            dom = Group.DistinguishedName.Substring(start, ende - start)
        Catch ex As Exception
            dom = ""
        End Try
        Dim r As New DirectoryEntry(Group.DistinguishedName, user, pass, AuthenticationTypes.Delegation)
        Dim isGroup As Boolean = False
        Dim isOU As Boolean = False
        For Each tmp As String In GetDuplicateKeys("objectClass", r)
            If tmp = "group" Then isGroup = True
            If tmp = "top" Then isOU = True
        Next
        'groups
        If isGroup Then
            For Each tmp As String In r.Properties("member").Value
                If dom = "" Then
                    retval.Add(GetGroupDetails("LDAP://" & dom & "/" & tmp))
                Else
                    retval.Add(GetGroupDetails("LDAP://" & tmp))
                End If
            Next
            'organizational units
        ElseIf isOU Then
            For Each tmp As __Object In GetMembers(Group.DistinguishedName)
                retval.Add(GetGroupDetails(tmp.DistinguishedName))
            Next
        End If
        Return retval
    End Function

    ''' <summary>
    ''' Gets the group details.
    ''' </summary>
    ''' <param name="groupcn">The groupcn.</param>
    ''' <param name="LoadedDE">The loaded DE.</param>
    ''' <returns></returns>
    Public Function GetGroupDetails(ByVal groupcn As String, Optional ByVal LoadedDE As DirectoryEntry = Nothing) As __Object
        Dim retval As __Object
        Dim r As DirectoryEntry
        Try
            If LoadedDE Is Nothing Then
                r = New DirectoryEntry(groupcn, user, pass, AuthenticationTypes.Delegation)
            Else
                r = LoadedDE
            End If
            retval.Name = r.Name.Split("=")(1)
            retval.DistinguishedName = r.Path
            retval.Description = r.Properties("Description").Value
        Catch ex As Exception
            retval.Name = ex.Message
            retval.DistinguishedName = groupcn
            retval.Description = ""
        End Try
        Return retval
    End Function

    'TODO: Rewrite Procedure...
    Public Sub DumpForest(ByVal dmn As String, ByVal tabs As Integer, Optional ByVal getproperties As Boolean = False, Optional ByVal recursiv As Boolean = True, Optional ByVal printpartitions As Boolean = False)
        Dim dc As New DirectoryContext(DirectoryContextType.Domain, dmn)
        Dim fr As Domain = Domain.GetDomain(dc)
        Dim nw As New Net.NetworkInformation.Ping
        Console.Write(Space(tabs) + fr.Name + " (" + fr.Children.Count.ToString + " Childs) " + nw.Send(fr.Name).RoundtripTime.ToString + " ms ping time" + vbNewLine)
        If getproperties Then
            Dim PropertiesToSkip As New List(Of String)
            PropertiesToSkip.Add("uSNCreated")
            PropertiesToSkip.Add("dSASignature")
            PropertiesToSkip.Add("repsTo")
            PropertiesToSkip.Add("repsFrom")
            PropertiesToSkip.Add("uSNChanged")
            PropertiesToSkip.Add("objectGUID")
            PropertiesToSkip.Add("replUpToDateVector")
            PropertiesToSkip.Add("creationTime")
            PropertiesToSkip.Add("forceLogoff")
            PropertiesToSkip.Add("lockoutDuration")
            PropertiesToSkip.Add("lockOutObservationWindow")
            PropertiesToSkip.Add("maxPwdAge")
            PropertiesToSkip.Add("minPwdAge")
            PropertiesToSkip.Add("modifiedCountAtLastProm")
            PropertiesToSkip.Add("objectSid")
            PropertiesToSkip.Add("modifiedCount")
            PropertiesToSkip.Add("auditingPolicy")
            PropertiesToSkip.Add("wellKnownObjects")
            PropertiesToSkip.Add("nTSecurityDescriptor")
            Dim de As DirectoryEntry = fr.GetDirectoryEntry
            For Each tmp As String In de.Properties.PropertyNames
                If Not PropertiesToSkip.Contains(tmp) Then
                    If de.Properties(tmp).Count > 1 Then
                        Console.Write(Space(tabs + 2) + tmp + " : " + vbNewLine)
                        For k As Integer = 0 To de.Properties(tmp).Count - 1
                            Console.Write(Space(tabs + 4) + de.Properties(tmp).Item(k).ToString + vbNewLine)
                        Next
                    Else
                        Console.Write(Space(tabs + 2) + tmp + " : " + de.Properties(tmp).Value.ToString + vbNewLine)
                    End If
                End If
            Next
        End If

        'DC list
        Dim df As DomainControllerCollection = fr.DomainControllers
        Console.WriteLine("Domain Controllers:")
        Console.WriteLine(Space(tabs + 1) + "Name  ;  IPAddress  ;  HighestCommittedUSN  ;  Site  ;  Round Trip Time")
        For Each dg As DomainController In df
            Console.Write(Space(tabs + 1) + dg.Name + " ; " + dg.IPAddress.ToString + " ; " + dg.HighestCommittedUsn.ToString + " ; " + dg.SiteName.ToString + " ; " + nw.Send(dg.Name).RoundtripTime.ToString + " ms" + vbNewLine)
            If printpartitions Then
                Console.WriteLine(Space(tabs + 1) + "Partitions:")
                For Each dh As String In dg.Partitions
                    Console.Write(Space(tabs + 3) + dh.ToString + vbNewLine)
                Next
            End If
        Next

        Console.WriteLine()

        If recursiv Then
            For i As Integer = 0 To fr.Children.Count - 1
                DumpForest(fr.Children(i).Name, tabs + 1, getproperties, recursiv)
            Next
        End If
    End Sub

    ''' <summary>
    ''' Determines whether as client is deactivated
    ''' </summary>
    ''' <param name="userAccountControl">The user account control.</param>
    ''' <returns>
    ''' <c>true</c> if [is client deactivated] [the specified user account control]; otherwise, <c>false</c>.
    ''' </returns>
    Public Function isClientDeactivated(ByVal userAccountControl As String) As Boolean
        Return Right(Hex(userAccountControl), 1) <> 2
    End Function

    Public Function GetAllDomains(ByVal basepath As String) As List(Of String)
        Dim retval As New List(Of String)
        Dim dc As DomainController = Domain.GetDomain(New DirectoryContext(DirectoryContextType.Domain, basepath)).FindDomainController()
        For Each tmp As Domain In dc.Forest.Domains
            retval.Add(tmp.Name)
        Next
        Return retval
    End Function

    ''' <summary>
    ''' Gets the domain information.
    ''' </summary>
    ''' <param name="dc">The dc.</param>
    ''' <returns></returns>
    Public Function GetDomainInformation(ByVal dc As String) As __Domain
        Dim retval As New __Domain
        Try
            Dim context As DirectoryContext = _
                New DirectoryContext(DirectoryContextType.Domain, dc)
            Dim dcinfo As Domain = Domain.GetDomain(context)
            retval.DomainMode = dcinfo.DomainMode.ToString
            retval.TrustRelationships = New List(Of __TrustInformation)
            For Each tmp As TrustRelationshipInformation In dcinfo.GetAllTrustRelationships
                Dim x As __TrustInformation
                x.SourceName = tmp.SourceName.ToString
                x.TargetName = tmp.TargetName.ToString
                x.TrustDirection = tmp.TrustDirection.ToString
                x.TrustType = tmp.TrustType.ToString
                retval.TrustRelationships.Add(x)
            Next
        Catch ex As Exception
            Windows.Forms.MessageBox.Show(ex.ToString)
        End Try
        Return retval
    End Function

    Public Function GetDomainControllerInformation(ByVal domaincontroller As String) As __DomainController
        Dim retval As New __DomainController
        Try
            Dim context As New DirectoryContext(DirectoryContextType.DirectoryServer, domaincontroller)
            Dim dcinfo As DomainController = DirectoryServices.ActiveDirectory.DomainController.GetDomainController(context)
            retval.CurrentTime = dcinfo.CurrentTime
            retval.DomainName = dcinfo.Domain.Name
            retval.ForestName = dcinfo.Forest.Name
            retval.HighestCommittedUsn = dcinfo.HighestCommittedUsn
            retval.IPAddress = dcinfo.IPAddress
            retval.Name = dcinfo.Name
            retval.OSVersion = dcinfo.OSVersion
            retval.SiteName = dcinfo.SiteName
            retval.IsGlobalCatalog = dcinfo.IsGlobalCatalog()
            retval.ReplicationOperationInformation.CurrentOperation = dcinfo.GetReplicationOperationInformation.CurrentOperation
            retval.ReplicationOperationInformation.OperationStartTime = dcinfo.GetReplicationOperationInformation.OperationStartTime
            retval.ReplicationOperationInformation.PendingOperations = dcinfo.GetReplicationOperationInformation.PendingOperations
        Catch ex As Exception
            Windows.Forms.MessageBox.Show(ex.ToString)
        End Try
        Return retval
    End Function

    ''' <summary>
    ''' Gets the computer domain.
    ''' </summary>
    ''' <returns></returns>
    Public Function GetComputerDomain() As String
        Try
            Return Domain.GetComputerDomain.Name
        Catch ex As ActiveDirectoryObjectNotFoundException
            Logger.GetInstance.Log(ClassName)
            Logger.GetInstance.Log(ex.ToString)
            Return "This computer is not part of a domain"
        Catch ex As Exception
            Return Nothing
        End Try
    End Function

End Class