Sign In
Create Account
Follow Us on Twitter
Subscribe on Youtube
1
can anyone look at this and tell me how to change it so i can get the username, last/first name and group of a user instead of all the users?
thank you :thumbup1:
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
Please note this is not my work, all credit to its author.:rules:
Back to top
