Imports System
Imports System.Text
Imports System.Collections
Imports System.DirectoryServices
Imports System.Security.Principal
Public Class Class1
'SamAccount is the right side of UserName (eg Domain\User => User)
'ActiveDirInfoByProp groups all Names, Values, Types
'AcviveDirInfoByPropName groups by individual property Name, Value, Type
'RequestedProperty is NOT case sensitive
Public Shared Function GetUserInfo(ByVal SamAccount As String, _
ByVal RequestedProperty As String, _
ByVal ActiveDirectoryPath As String, _
Optional ByVal EnumerateCollection As Boolean = False, _
Optional ByRef ActiveDirInfoByProp(,) As Object = Nothing, _
Optional ByRef ActiveDirInfoByPropName(,) As Object = Nothing) As String
Try
'ActiveDirectoryPath = "LDAP://na.valmont.com/OU=Users,OU=Department,OU=PlymouthIN,OU=Structures,DC=na,DC=valmont,DC=com"
Dim de As New DirectoryEntry(ActiveDirectoryPath)
Dim ds As New DirectorySearcher(de)
Dim sr As SearchResult
Dim src As SearchResultCollection
Dim rpc As ResultPropertyCollection
Dim rpvc As ResultPropertyValueCollection
'Build LDAP query
ds.Filter = ("(&(ObjectClass=user)(SamAccountName=" & SamAccount & "))")
src = ds.FindAll()
'MsgBox(src.PropertiesLoaded.ToString)
'I expect only one user from search result
Select Case src.Count
Case 0
MsgBox("Unexpected program result in ActiveDirectoryInfo.GetUserInfo" & vbNewLine & "No records returned", MsgBoxStyle.Critical)
Return "Null"
Exit Function
Case Is > 1
MsgBox("Unexpected program result in ActiveDirectoryInfo.GetUserInfo" & vbNewLine & src.Count & "Multiple records returned", MsgBoxStyle.Critical)
Return "Null"
Exit Function
End Select
'Get the search result from the collection
sr = src.Item(0)
'Get the Properites, they contain the usefull info
rpc = sr.Properties
'Retrieve from the properties collection the display name and email of the user
rpvc = rpc.Item(RequestedProperty)
'Enumerate the keys
If EnumerateCollection Then
Dim c As New Class1
c.EnumerateCollection(rpc, ActiveDirInfoByProp, ActiveDirInfoByPropName)
End If
'Dim utf As New UTF7Encoding
'Dim s As String = utf.GetString(dBytes)
Return CStr(rpvc.Item(0))
'Iterate the keys manually - some may bomb due to type inconsistancies
rpvc = rpc.Item("ReplicatedObjectVersion") : MsgBox("ReplicatedObjectVersion: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("SamAccountType") : MsgBox("SamAccountType: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MSExchMailboxGuid") : MsgBox("MSExchMailboxGuid: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("DSCorePropogationData") : MsgBox("DSCorePropogationData: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("LastLogon") : MsgBox("LastLogon: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("ObjectCatagory") : MsgBox("ObjectCatagory: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("ShowInAddressBook") : MsgBox("ShowInAddressBook: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MailNickName") : MsgBox("MailNickName: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MSExchalObjectVersion") : MsgBox("MSExchalObjectVersion: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("TextEncodedOrAddress") : MsgBox("TextEncodedOrAddress: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("CountryCode") : MsgBox("CountryCode: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MSExchPoliciesIncluded") : MsgBox("MSExchPoliciesIncluded: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("Initials") : MsgBox("Initials: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("Mail") : MsgBox("Mail: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("LogonCount") : MsgBox("LogonCount: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("PrimaryGroupID") : MsgBox("PrimaryGroupID: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("ObjectSID") : MsgBox("ObjectSID: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MSExchAdcGlobalNames") : MsgBox("MSExchAdcGlobalNames: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("WhenCreated") : MsgBox("WhenCreated: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MSExchUserAccountControl") : MsgBox("MSExchUserAccountControl: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("LegacyExchangeDN") : MsgBox("LegacyExchangeDN: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("UserParameters") : MsgBox("UserParameters: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("UserAccountControl") : MsgBox("UserAccountControl: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("Description") : MsgBox("Description: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("Info") : MsgBox("Info: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("HomeDrive") : MsgBox("HomeDrive: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("Unchanged") : MsgBox("Unchanged: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("AdsPath") : MsgBox("AdsPath: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MSExchUnmergedAttspt") : MsgBox("MSExchUnmergedAttspt: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("BadPwdCount") : MsgBox("BadPwdCount: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("LastLogoff") : MsgBox("LastLogoff: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MsnpAllowDialin") : MsgBox("MsnpAllowDialin: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("Sn") : MsgBox("Sn: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("PwdLastSet") : MsgBox("PwdLastSet: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("UsnCreated") : MsgBox("UsnCreated: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("Cn") : MsgBox("Cn: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("SamAccountName") : MsgBox("SamAccountName: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("WhenChanged") : MsgBox("WhenChanged: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("CodePage") : MsgBox("CodePage: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("InstanceType") : MsgBox("InstanceType: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("PhysicalDeliverOfficeName") : MsgBox("PhysicalDeliverOfficeName: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MdbUseDefaults") : MsgBox("MdbUseDefaults: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("DlMemDefault") : MsgBox("DlMemDefault: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("DisplayName") : MsgBox("DisplayName: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("ReplicationSignature") : MsgBox("ReplicationSignature: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MemberOf") : MsgBox("MemberOf: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("GivenName") : MsgBox("GivenName: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("UserPrincipalName") : MsgBox("UserPrincipalName: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MSExchMailboxSecurityDescriptor") : MsgBox("MSExchMailboxSecurityDescriptor: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("ObjectGuid") : MsgBox("ObjectGuid: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("Name") : MsgBox("Name: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("LockOutTime") : MsgBox("LockOutTime: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("AccountExpires") : MsgBox("AccountExpires: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("HomeDirectory") : MsgBox("HomeDirectory: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("ObjectClass") : MsgBox("ObjectClass: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("ProxyAddress") : MsgBox("ProxyAddress: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("MSExchHomeServerName") : MsgBox("MSExchHomeServerName: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("HomeMta") : MsgBox("HomeMta: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("DistinguishedName") : MsgBox("DistinguishedName: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("BadPasswordTime") : MsgBox("BadPasswordTime: " & CStr(rpvc.Item(0)))
rpvc = rpc.Item("HomeMdb") : MsgBox("HomeMdb: " & CStr(rpvc.Item(0)))
Catch ex As System.Exception
'do some error return here.
MsgBox(ex.Message & vbCrLf & ex.StackTrace)
End Try
End Function
Private Sub EnumerateCollection(ByVal rpc As ResultPropertyCollection, _
ByRef ActiveDirInfoByProp(,) As Object, _
ByRef ActiveDirInfoByPropName(,) As Object)
ReDim ActiveDirInfoByPropName(2, rpc.Count - 1)
ReDim ActiveDirInfoByProp(rpc.Count - 1, 2)
' item0.GetType.ToString & " " & item0.tostring
Dim ht As Hashtable = CType(rpc.PropertyNames.SyncRoot, Hashtable)
Dim de As IDictionaryEnumerator = ht.GetEnumerator
Dim i As Integer, item0 As Object
While de.MoveNext()
item0 = CType(de.Value, ResultPropertyValueCollection).Item(0)
'MsgBox(i & " " & myEnumerator.Key.ToString & vbNewLine & item0.ToString)
'Console.WriteLine("{0}:" + ControlChars.CrLf _
' + ControlChars.Tab + "{1}" + ControlChars.CrLf, myEnumerator.Key, item0.ToString)
ActiveDirInfoByProp(i, 0) = de.Key.ToString
ActiveDirInfoByPropName(0, i) = de.Key.ToString
ActiveDirInfoByProp(i, 1) = item0
ActiveDirInfoByPropName(1, i) = item0
With item0.GetType.ToString
ActiveDirInfoByProp(i, 2) = .Substring(.LastIndexOf(CChar(".")) + 1)
ActiveDirInfoByPropName(2, i) = .Substring(.LastIndexOf(CChar(".")) + 1)
End With
i += 1
End While
End Sub
End Class