Борис Рудой - професиональный программист на ASP и Visual Basic. Возраст 36 лет

Еще вчера работа из VB c объектами секъюрити Window NT Domain была сильно затруднена. Нет, естественно, находились смельчаки, и с использованием Network API оно все работало. Могу даже примерчик дать. В настоящий момент ситуация изменилась. Не могу сказать, что ситуация изменилась в корне. Но обнозначно стало лучше. Некоторый пессимизм этой фразы вызван одной банальной причиной. Микрософт выпустил в свет вместе с Windows 2000 набор объектов и утилит названный Active Dirrectory. Особо распостраняться по этому поводу я буду. Принципиально познакомится с этой технологией можно в сети , например здесь
А еще лучше зайдите на http://www.ya.ru и весь лист будет у ваших ног...

В то же время для поддержки AD клиенту работающему в системе на базе 9x и NT надо установить некоторые библиотеки, точнее просто проинсталлировать специальный пакет, который MS распостраняет с Win2000 сервером. Также его можно скачать и с самого сайта Микрософт. Еще одна ложка дегтя, это то, что полная поддержка AD получается только, если в качестве домейн контроллера установлен Win2000 сервер. Так что в своем примере я пользовался не всеми возможностями AD, а только теми, которые поддержаны провайдером, предоставляющим доступ к информации о NT Domain - конкретно Active Directory Services Interfaces (ADSI) и "Winnt:"
Хочу сразу дать вам ссылку - откуда начинать читать про ADSI . Однако, зная особенности поведения сайтов Микроcофт собственно клиента adsi и хелп файл для программиста помещаю у себя на сервере.
На этом позвольте считать вступительное слово оконченным.

Вернемся к секьюрити. Задача стояла так - создаем базу данных, доступ к ней должен осуществляться как авторизованными пользователями NT Domain, так и "виртуальными" пользователями, с именами существующими исключительно для доступа в эту базу. В данном, конкретном случае нас интересует именно первая часть задачи. Итак, есть желание получать
- список доступных домейнов
- список пользователей конкретного домейна
- список групп
- информацию о принадлежности юзера к конкретным группам
- и последнее - уметь проверять правильность пароля предоставленного пользователем.

Для этого и был написан класс, соотвествующие фрагменты которого идут ниже .

'Как определить список доступных NT домейнов 
'Результат работы будет возвращен как строковый массив.

Public Function GetDomainList() As Variant
    Dim DomList() As String
        
    Dim oIADs As ActiveDs.IADs
    Dim oContainer As ActiveDs.IADsContainer
    
    Dim oDom As IADsDomain
    'Это очень важное место - мы задаем тип провайдера,
    ' с которым будем работать. Для нашего случая это 
    ' "Winnt:" Существуют еще несколько провайдеров,
    ' например для работы с Novel
    Set oContainer = GetObject("WinNT:")
        ' Теперь мы должны отфильтровать обьекты в контейнере
        ' и оставить только нужные. В данном случае нас
        ' интересуют домейны
        oContainer.Filter = Array("Domain")
        
    ' Готовим массив, результат будет лежать, начиная с 
    ' индекса 1 
    ' 0 Элемент массива так и останется пустым. Это удобно
    ' - так  как никогда не 
    ' вернется неинициализированный массив. Нам останется 
    ' просто перебрать его элементы начиная с 1 до
    ' Ubound(Имя Массива) 
    ReDim DomList(0)
    

    ' далее просто передбираем элементы коллекции
    For Each oIADs In oContainer
        Set oDom = oIADs
        ReDim Preserve DomList(UBound(DomList) + 1)
        ' кроме свойства .Name  там есть еще информация. 
        ' На нее можно взглянуть прямо в рантайм.
        DomList(UBound(DomList)) = oDom.Name
        
    Next oIADs
    ' возвращаем заполненный массив.
    GetDomainList = DomList
    ' не забываем сбросить референсы в Nothing
    Set oDom = Nothing
    Set oContainer = Nothing
    
End Function

Теперь нам нужен список пользователей

Public Function GetUserList(FullNamesList As Variant, _ 
         Optional DomainName As String) As Variant
    ' возвращает полный список юзеров данного домейна.
    ' В аргумент FullNamesList будет положен массив с
    ' полными именами пользователей.
    
    Dim curDomServer As String
    Dim Ulist() As String
    Dim FNlist() As String
    
    ' если  имя домейна не задано при вызове этого метода
    ' берем текущее имя.  
    ' Оно хранится в этом же классе в переменной sCurrentDomain
    If DomainName = "" Then
        curDomServer = sCurrentDomain
    Else
        curDomServer = DomainName
    End If
    Dim sUserInfo
    Dim oIADs As ActiveDs.IADs
    Dim oContainer As ActiveDs.IADsContainer
    Dim oUser As IADsUser
   
   ' Теперь контейнер создается не на полном namespaсe,
	' а на базе конкретного имени домейна
	Set oContainer = GetObject("WinNT://" + curDomServer)
	' И нужен нам оттуда именно список пользователей
	' какие еще фильтры вы можете применять -
   ' можно посмотреть в прилагаемом хелпе
	oContainer.Filter = Array("User")
   ReDim Ulist(0)
   ReDim FNlist(0)
   For Each oIADs In oContainer
		Set oUser = oIADs
		' заполняем массивы
		ReDim Preserve Ulist(UBound(Ulist) + 1)
		ReDim Preserve FNlist(UBound(FNlist) + 1)
		Ulist(UBound(Ulist)) = oUser.Name
		FNlist(UBound(FNlist)) = oUser.FullName
   Next oIADs

	' возвращаем значения
	GetUserList = Ulist
	FullNamesList = FNlist
   ' не забываем сбросить референсы в Nothing
	Set oUser = Nothing
	Set oContainer = Nothing
End Function

Таким же образом можно добраться до списка групп пользователей:

Public Function GetGroupList(ByRef cNameWithDescriptions As _
   Collection, Optional DomainName As String) As Variant
    Dim curDomServer As String
    Dim Glist() As String
    Dim sGroupInfo
    Dim oIADs As ActiveDs.IADs
    Dim oContainer As ActiveDs.IADsContainer
    Dim oGroup As IADsGroup
    
    If DomainName = "" Then
        curDomServer = sCurrentDomain
    Else
        curDomServer = DomainName
    End If
    
    Set oContainer = GetObject("WinNT://" + curDomServer)
    oContainer.Filter = Array("Group")
    ReDim Glist(0)
    For Each oIADs In oContainer
        Set oGroup = oIADs
        ReDim Preserve Glist(UBound(Glist) + 1)
        Glist(UBound(Glist)) = oGroup.Name
        cNameWithDescriptions.Add (oGroup.Description), _
           CStr(UBound(Glist))
    Next oIADs
    
    GetGroupList = Glist
    Set oGroup = Nothing
    Set oContainer = Nothing
End Function

Свойства конкретного пользователя легко доступны:

Public Function GetUserProperty(UserName As String, _
                   Optional DomainName As String) As Variant
    Dim UProp() As String
    Dim oUser As IADsUser
    Dim Tmp As String
    Dim curDomServer As String
    
    If DomainName = "" Then
        curDomServer = sCurrentDomain
    Else
        curDomServer = DomainName
    End If
    
    Set oUser = GetObject("WinNT://" & curDomServer & "/" _
                 & UserName)
    ReDim UProp(0)
    
    On Error Resume Next
    With oUser
        ' Исключительно для примера привожу здесь
        ' только пару свойств  Большая часть из доступных
        ' свойств не будет работать без AD на Win2000
        ' для этого и предусмотрено On Error Resume Next
        Tmp = ""
        Tmp = .Department
        If Len(Tmp) > 0 Then
            Tmp = FormatString("Department:", Tmp, 20)
            ReDim Preserve UProp(UBound(UProp) + 1)
            UProp(UBound(UProp)) = Tmp
        End If
        
        Tmp = ""
        Tmp = .Description
        If Len(Tmp) > 0 Then
            Tmp = FormatString("Description:", Tmp, 20)
            ReDim Preserve UProp(UBound(UProp) + 1)
            UProp(UBound(UProp)) = Tmp
        End If
    End With
    On Error GoTo 0
    
    GetUserProperty = UProp
    Set oUser = Nothing
    
End Function

Похожим способом можно получить и список групп в которые входит пользователь.

Public Function GetUserGroup(UserName As String, _
                  Optional DomainName As String) As Variant
    Dim Groups() As String
    Dim curDomServer   As String
    Dim RealUsr As IADsUser
    Dim Grp As IADsGroup
    
    If UserName = "" Then
        Exit Function
    End If
    
    If DomainName = "" Then
        curDomServer = sCurrentDomain
    Else
        curDomServer = DomainName
    End If
    
    Set RealUsr = GetObject("WinNT://" & curDomServer & "/" _
                    & UserName)
    ReDim Groups(0)
    ' Обратите внимание - как связаны коллекции обьектов 
    ' Mы взяли пользователя и перебираем группы,
    ' на которые он ссылается
    For Each Grp In RealUsr.Groups
        ReDim Preserve Groups(UBound(Groups) + 1)
        Groups(UBound(Groups)) = Grp.Name
    Next
    
    GetUserGroup = Groups
    Set Grp = Nothing
    Set RealUsr = Nothing
    
End Function

Ну последнее - как проверить верен ли предоставленный пароль.

Public Function CheckUser(UserName As String, Password _
           As String) As Boolean
    
    Dim strQuery As String
    Dim dso As IADsOpenDSObject
    Dim obj
    
    CheckUser = False
    
    Screen.MousePointer = vbHourglass
    Set dso = GetObject("WinNT:")
    strQuery = "WinNT://" & sCurrentDomain
    
    ' Кстати, получаемый обьект будет распологать
    ' всеми правами пользователя
    ' на основании которого он создан
    On Error Resume Next
    Set obj = dso.OpenDSObject(strQuery, UserName, _
                  Password, ADS_SECURE_AUTHENTICATION)
    Screen.MousePointer = vbDefault
    If Err.Number <> 0 Or obj Is Nothing Then
        Err.Clear
        On Error GoTo 0
        
    End If
    
    CheckUser = True
    Exit Function
ToExit:
    Set obj = Nothing
    Set dso = Nothing

End Function

Собственно, скопировав вышележащий код к себе вы сможете повторить мой проект.
Подобным же образом вы доберетесь до списка всех компьютеров в сети,
до списка всех принтеров на которых разрешено печатать . Перечисление
любых сетевых ресурсов вам доступно.

Надеюсь этот пример поможет вам начать . Дальше разберетесь...