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