2009-10-06 3 views

ответ

1

Добавить ссылки для типа ActiveDS библиотеки и ADO для вашего проекта.

 
Sub GetDomains() 
    Dim objRootDSE As IADs 
    Dim objBase As IADs 
    Dim path As String 
    Dim rsDomains As ADODB.Recordset 
    Dim cnADS As ADODB.Connection 
    Dim cmdCommand As ADODB.Command 

    Set objRootDSE = GetObject("LDAP://rootDSE") 
    path = "LDAP://" & objRootDSE.Get("rootDomainNamingContext") 
    Set objBase = GetObject(path) 

    Set cnADS = New ADODB.Connection 
    cnADS.Provider = "ADsDSOObject" 
    cnADS.Open "ADSI" 

    Set cmdCommand = New ADODB.Command 
    cmdCommand.ActiveConnection = cnADS 
    cmdCommand.Properties("searchScope") = ADS_SCOPE_SUBTREE 
    cmdCommand.CommandText = "SELECT Name, distinguishedName FROM '" & objBase.ADsPath & "' WHERE objectCategory = 'domain'" 
    Set rsDomains = cmdCommand.Execute 

    Do While rsDomains.EOF = False 
     List1.AddItem (rsDomains!Name) 
     rsDomains.MoveNext 
    Loop 

End Sub 

У меня есть только один домен, чтобы проверить это против, так что я надеюсь, что вам нужно, дайте мне знать, если он получает все домены для вас. Также обратите внимание, Я не добавлял обработку ошибок.

Смежные вопросы