Еще вчера работа из VB c объектами секъюрити Window NT Domain
была сильно затруднена. Нет, естественно, находились смельчаки,
и с использованием Network API оно все работало. Могу даже примерчик
дать.
В настоящий момент ситуация изменилась. Не могу сказать, что
ситуация изменилась в корне. Но обнозначно стало лучше. Некоторый
пессимизм этой фразы вызван одной банальной причиной. Микрософт
выпустил в свет вместе с Windows 2000 набор объектов и утилит
названный Active Dirrectory. Особо распостраняться по этому
поводу я буду. Принципиально познакомится с этой технологией
можно в сети ,
А еще лучше зайдите на и весь лист будет у ваших ног...
В то же время для поддержки 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
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
' Кстати, получаемый обьект будет распологать всеми правами пользователя
' на основании которого он создан 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
Собственно, скопировав вышележащий код к себе вы сможете повторить
мой проект.
Подобным же образом вы доберетесь до списка всех компьютеров
в сети,
до списка всех принтеров на которых разрешено печатать . Перечисление
любых сетевых ресурсов вам доступно.
Надеюсь этот пример поможет вам начать . Дальше разберетесь...
