ActiveDirectoryinVBNET.vb

 '*********************************************************************************************
'MODULE     :   ActiveDirectoryinVBNET.vb
'Screen Name : ADSI Details - Active_Directory (LDAP Utility)
'Designed By : Mr. Vivek Nigam
'Designed On : November 18, 2005
'COPYRIGHT     :   Copyright 2005-6 [Nigam Software Solutions Ltd.] All Rights Reserved.
'FILENAME     :   ActiveDirectoryinVBNET.vb
'CREATED :   15-August-2006
'DESCRIPTION:
'
'MODIFICATION HISTORY:
' 1.0
' Modified On :
' Modified By :

' Initial Version, Coding Started

'*********************************************************************************************
Option Explicit On
Imports System.DirectoryServices
Imports System.IO
Imports System.Text
Public Class frmActiveDirectory
    Inherits System.Windows.Forms.Form
    Dim fs As New FileStream("ADSIUsersAndTheirGroupsList.txt", FileMode.Create)
    Dim s As New StreamWriter(fs)

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer. 
    'Do not modify it using the code editor.
    Friend WithEvents cmdActiveDirectory As System.Windows.Forms.Button
    Friend WithEvents cmdClose As System.Windows.Forms.Button
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.cmdActiveDirectory = New System.Windows.Forms.Button
        Me.cmdClose = New System.Windows.Forms.Button
        Me.SuspendLayout()
        '
        'cmdActiveDirectory
        '
        Me.cmdActiveDirectory.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.cmdActiveDirectory.ForeColor = System.Drawing.Color.Brown
        Me.cmdActiveDirectory.Location = New System.Drawing.Point(11, 6)
        Me.cmdActiveDirectory.Name = "cmdActiveDirectory"
        Me.cmdActiveDirectory.Size = New System.Drawing.Size(224, 40)
        Me.cmdActiveDirectory.TabIndex = 0
        Me.cmdActiveDirectory.Text = "Get Active Directory in VB NET"
        '
        'cmdClose
        '
        Me.cmdClose.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.cmdClose.ForeColor = System.Drawing.Color.Brown
        Me.cmdClose.Location = New System.Drawing.Point(12, 53)
        Me.cmdClose.Name = "cmdClose"
        Me.cmdClose.Size = New System.Drawing.Size(224, 40)
        Me.cmdClose.TabIndex = 1
        Me.cmdClose.Text = "Close"
        '
        'frmActiveDirectory
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.BackColor = System.Drawing.Color.Silver
        Me.ClientSize = New System.Drawing.Size(248, 101)
        Me.Controls.Add(Me.cmdClose)
        Me.Controls.Add(Me.cmdActiveDirectory)
        Me.MaximizeBox = False
        Me.MinimizeBox = False
        Me.Name = "frmActiveDirectory"
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "Active Directory in VB NET"
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub cmdClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdClose.Click
        End
    End Sub

    Private Sub cmdActiveDirectory_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdActiveDirectory.Click
        Call LoadADSIDetails("")
    End Sub
    Public Sub LoadADSIDetails(ByVal Query As String)
        Dim counter As Int16 = 0
        Dim searcher As New DirectorySearcher("")
        Dim DataToWrite As String
        Try
            Cursor.Current = Cursors.WaitCursor
            If Query.Trim.Length = 0 Then
                s.WriteLine("search Filter =" + "(&(!(userAccountControl:1.2.840.113556.1.4.803:=2))(objectCategory=user))")
                searcher.Filter = "(&(!(userAccountControl:1.2.840.113556.1.4.803:=2))(objectCategory=user))"
            Else
                s.WriteLine("search Filter =" + "(&(!(userAccountControl:1.2.840.113556.1.4.803:=2))(objectCategory=user)(" + Query + "))")
                searcher.Filter = "(&(!(userAccountControl:1.2.840.113556.1.4.803:=2))(objectCategory=user)(" + Query + "))"
            End If
            searcher.SearchScope = SearchScope.Subtree

            s.WriteLine("")

            Dim FirstName, SurName, Email, UserName, GroupName As String

            For Each result As SearchResult In searcher.FindAll()
                FirstName = ""
                SurName = ""
                Email = ""
                UserName = ""

                counter = counter + 1

                If Not (IsNothing(result)) Then
                    Dim myResultPropColl As ResultPropertyCollection
                    myResultPropColl = result.Properties

                    Dim myKey As String
                    For Each myKey In myResultPropColl.PropertyNames
                        Select Case myKey
                            Case "samaccountname"
                                Try
                                    UserName = myResultPropColl(myKey)(0)

                                Catch ex As Exception
                                    UserName = ""

                                End Try
                            Case "sn"
                                Try
                                    SurName = myResultPropColl(myKey)(0)

                                Catch ex As Exception
                                    SurName = ""

                                End Try
                            Case "givenname"
                                Try
                                    FirstName = myResultPropColl(myKey)(0)

                                Catch ex As Exception
                                    FirstName = ""

                                End Try
                            Case "mail"
                                Try
                                    Email = myResultPropColl(myKey)(0)

                                Catch ex As Exception
                                    Email = ""

                                End Try
                        End Select

                    Next
                End If
                If FirstName = "" Then
                    FirstName = SurName
                End If
                DataToWrite = "Sr. No.- " + CStr(counter) + ""
                s.WriteLine(DataToWrite)
                s.WriteLine("")
                DataToWrite = "First Name - " + FirstName + ""
                s.WriteLine(DataToWrite)
                DataToWrite = "SurName - " + SurName + ""
                s.WriteLine(DataToWrite)
                DataToWrite = "Email - " + Email + ""
                s.WriteLine(DataToWrite)
                DataToWrite = "User Name " + UserName + ""
                s.WriteLine(DataToWrite)
                s.WriteLine("")
                MsgBox("User Name : " + UserName + "", MsgBoxStyle.Information + MsgBoxStyle.OKOnly, "Active Directory User Information And Its Group(s) in VB. NET")
                If Not (IsNothing(UserName)) Then
                    Call GetActiveDirectoryUserGroups(UserName)
                End If
            Next
            s.WriteLine("Total Number of user(s) :" + CStr(counter))
            s.Close()
            fs.Close()
        Catch ex As Exception
            MessageBox.Show(ex.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error) 'This will give a description of the error.
            Cursor.Current = Cursors.Default
            Exit Sub
        Finally
            MsgBox("Active directory (LDAP) user details and their belonging group(s) information has been exported successfully in application path on ..bin/ADSIUsersAndTheirGroupsList.txt file.", MsgBoxStyle.Information + MsgBoxStyle.OKOnly, "Active Directory User Information And Its Group(s) in VB. NET")
            searcher.Dispose()
            Cursor.Current = Cursors.Default
        End Try
    End Sub
    Public Sub GetActiveDirectoryUserGroups(ByVal UserName As String)

        Dim search As New DirectorySearcher("")
        Dim groupCount As Int64
        Dim counter As Int64
        Dim Sql As String
        Dim GroupName As String
        Dim PrimaryGroup As String
        Dim GroupArr As Array
        Dim DataToWriteGroups As String
        Try

            search.Filter = "(&(!(userAccountControl:1.2.840.113556.1.4.803:=2))(objectCategory=user)(samaccountname=" + UserName.ToString.Trim + "))"
            search.PropertiesToLoad.Add("memberOf")


            Dim result As SearchResult = search.FindOne()

            If Not (IsNothing(result)) Then

                Try
                    groupCount = result.Properties("memberOf").Count
                Catch ex As NullReferenceException
                    groupCount = 0
                End Try

                If groupCount > 0 Then
                    DataToWriteGroups = "Group(s) Belongs To User - " + UserName + ""
                    s.WriteLine(DataToWriteGroups)
                    s.WriteLine("")
                    For counter = 0 To groupCount - 1
                        GroupName = ""
                        GroupName = CStr(result.Properties("memberOf")(counter))
                        GroupArr = Split(GroupName, ",")
                        If Not (IsNothing(GroupArr(0))) Then
                            GroupName = Mid(GroupArr(0), 4, Len(GroupArr(0)) - 3)
                            DataToWriteGroups = "" + GroupName + ""
                            s.WriteLine(DataToWriteGroups)
                            MsgBox("Group(s) belongs to " + UserName + " - " + GroupName + " ", MsgBoxStyle.Information + MsgBoxStyle.OKOnly, "Active Directory User Information And Its Group(s) in VB. NET")
                        End If
                    Next
                End If
                ' Get primary Group
                PrimaryGroup = GetPrimaryGroupName(UserName)
                If PrimaryGroup.Length > 0 Then
                    DataToWriteGroups = "" + PrimaryGroup + ""
                    s.WriteLine(DataToWriteGroups)
                    s.WriteLine("")
                    MsgBox("Primary Group belongs to " + UserName + " - " + PrimaryGroup + " ", MsgBoxStyle.Information + MsgBoxStyle.OKOnly, "Active Directory User Information And Its Group(s) in VB. NET")
                End If

            End If
        Catch ex As Exception
            MessageBox.Show(ex.Message, " Error", MessageBoxButtons.OK, MessageBoxIcon.Error) 'This will give a description of the error.
            Exit Sub
        Finally
            search.Dispose()
        End Try
    End Sub
    Public Shared Function GetPrimaryGroupName(ByVal userSamAccountName As String) As String
        Dim domainSid() As Byte
        Dim primaryGroupSid() As Byte
        Dim primaryGroupId As Integer
        Dim primaryGroupOctet As String
        Dim primaryGroupName As String
        Dim rootDse As DirectoryEntry
        Dim domainRoot As DirectoryEntry
        Dim primaryGroup As DirectoryEntry
        Dim searcher As DirectorySearcher
        Dim results As SearchResultCollection
        Dim result As SearchResult
        Dim enumerator As IEnumerator


        rootDse = New DirectoryEntry("LDAP://rootDSE")
        domainRoot = New DirectoryEntry("LDAP://" + DirectCast(rootDse.Properties("defaultNamingContext").Value, String))


        domainSid = DirectCast(domainRoot.Properties("objectSID").Value, Byte())
        searcher = New DirectorySearcher(domainRoot)
        searcher.SearchScope = SearchScope.Subtree
        searcher.CacheResults = False
        searcher.PropertiesToLoad.AddRange(New String() {"primaryGroupID"})
        searcher.Filter = String.Format("(&(objectCategory=user)(sAMAccountName={0}))", userSamAccountName)


        results = searcher.FindAll() 'I don't use FindOne because it leaks memory if the search fails in 1.1 or lower...
        enumerator = results.GetEnumerator
        If enumerator.MoveNext Then
            result = DirectCast(enumerator.Current, SearchResult)
            primaryGroupId = DirectCast(result.Properties("primaryGroupId")(0), Integer)
            ReDim primaryGroupSid(domainSid.Length + 3)
            Array.Copy(domainSid, primaryGroupSid, domainSid.Length)
            Array.Copy(BitConverter.GetBytes(primaryGroupId), 0, primaryGroupSid, domainSid.Length, 4)
            primaryGroupSid(1) = Convert.ToByte((primaryGroupSid.Length - 8) \ 4)
            primaryGroupOctet = ConvertToOctetString(primaryGroupSid)
            primaryGroup = New DirectoryEntry(String.Format("LDAP://<SID={0}>", primaryGroupOctet))
            primaryGroupName = DirectCast(primaryGroup.Properties("samAccountName").Value, String)

            primaryGroup.Dispose()
        Else
            primaryGroupName = String.Empty
        End If


        results.Dispose()
        searcher.Dispose()
        domainRoot.Dispose()
        rootDse.Dispose()


        Return primaryGroupName


    End Function

    Public Overloads Shared Function ConvertToOctetString(ByVal values As Byte()) As String
        Return ConvertToOctetString(values, False, False)
    End Function

    Public Overloads Shared Function ConvertToOctetString(ByVal values As Byte(), ByVal isAddBackslash As Boolean) As String
        Return ConvertToOctetString(values, isAddBackslash, False)
    End Function


    Public Overloads Shared Function ConvertToOctetString(ByVal values As Byte(), ByVal isAddBackslash As Boolean, ByVal isUpperCase As Boolean) As String
        Dim iterator As Integer
        Dim builder As StringBuilder


        Dim slash As String
        If isAddBackslash Then
            slash = ""
        Else
            slash = String.Empty
        End If


        Dim formatCode As String
        If isUpperCase Then
            formatCode = "X2"
        Else
            formatCode = "x2"
        End If
        builder = New StringBuilder(values.Length * 2)
        For iterator = 0 To values.Length - 1
            builder.Append(slash)
            builder.Append(values(iterator).ToString(formatCode))
        Next


        Return builder.ToString()


    End Function
End Class

Project Homepage: