How can I get currently logged on active directory dc info?

[silverspecv]

I have some active directory oriented code, and I have it working, but it all starts with something like

Dim dEntry As New DirectoryEntry("LDAP://DC=domain,DC=com")

but how do I get info that goes inside the quotes? I currently have it hard coded for my domain here, but I will need it to pick up the user's domain once the app is deployed. I can get the "domain" portion of that by getting the currently logged on user as "domain\username" etc, but I can't find the "com" part anywhere

 

[SBendBuckeye]

Hello,

This code is something I worked on a long time ago to do something similar. I can't tell you what it does anymore but maybe you can get some ideas by single stepping it. I think you want the DirectorySearcher class. Good Luck!

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

Have a great day!

j2consulting@yahoo.com

 

[silverspecv]

Nope, there is some other stuff in there that I'm going to snatch, but your function still expects to be provided with the list of DC's.. I need something that will figure that part out so the app can be run on other people's domain without expecting them to type in "domain.com" etc.

 

[chrissie1]

environment.UserDomainName

How about this?

Christiaan Baes
Belgium

I just like this --> [Wiggle] [Wiggle]

 

[SBendBuckeye]

Hello,

If I remember right, this stuff may yield some of what you are looking for, not that the SamAccountName is just the user name:

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

Have a great day!

j2consulting@yahoo.com