Sub Example1()
Dim objADSysInfo As Object, objCurrentUser As Object
Dim objGroup As Object, objItem As Object
Dim strCurUserName As String, strListUsers As String
Const strTestGroup = "здесь - имя нужной группы"
Const strDomainName = "здесь - DNS-имя домена"
Const strDC = "здесь - DNS-имя контроллера домена"
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objCurrentUser = GetObject("LDAP://" & objADSysInfo.UserName)
strCurUserName = objCurrentUser.cn
Set objCurrentUser = Nothing
Set objADSysInfo = Nothing
MsgBox "Текущий пользователь: " & strCurUserName, vbInformation
Set objGroup = GetObject("WinNT://" & strDomainName & "/" & strDC & "/" & strTestGroup & ",group")
For Each objItem In objGroup.Members
strListUsers = strListUsers & objItem.Name & ","
Next
Set objGroup = Nothing
If InStr(1, strListUsers, strCurUserName, vbTextCompare) > 0 Then
MsgBox "Результат поиска положительный.", vbInformation
Else
MsgBox "Результат поиска отрицательный.", vbCritical
End If
End Sub
Как узнать логин и стаус пользователя с помощью VBA?
Тут такое дело: я создал базу данных в Access и теперь запариваюсь по поводу создания бэкап файлов и отката программы до определённого момента. Естественно, что создавать бэкапы и откатывать программу имеет право очень ограниченый круг людей. Так вот мне надо узнать логин пользователя, под которым он вошёл в сеть(ну или в винду) и права, которые он имеет на определённую директорию(достаточно только чтение, или больше). Подскажите, пожалста, как это сделать?
Ну с логином я кое-как разобрался, теперь остаются права пользователя. Я вот, что подумал, а может проще будет проверить к каким локальной и глобальной группам этот юзер относится? Только я не знаю откуда это выковырнуть:(
Вобщем буду рад любым идеям!:)
Вобщем буду рад любым идеям!:)
Вообще говоря, VBA не имеет собственных средств для решения таких задач. Здесь нужно использовать дополнительный инструментарий, например, Win32 API, WMI...
Цитата: Apy4
Ну с логином я кое-как разобрался...
Если Вы говорите о свойстве UserName объекта Application, то при работе с Windows линейки NT здесь могут быть "подводние камни".
Дело в том, что это свойство возвращает имя не того пользователя, который открыл текущий сеанс работы в Windows, а того, под чьим именем был создан профиль, назначенный для использования текущему пользователю. Резюме: это [color=red]ненадёжный[/color] способ верификации.
Цитата: Apy4
... теперь остаются права пользователя. Я вот, что подумал, а может проще будет проверить к каким локальной и глобальной группам этот юзер относится?
Пожалуй, второе проще первого. Здесь надо знать какая у Вас сеть: одноранговая или доменная.
Что касается логина, то я пробовал два способа: с помощью функций UserName и Environ. Результат они давали одинаковый и вроде правильный. Не подскажете, какой из них работает более надежно (не приятно будет, если ошибка всплывет через пару месяцев), или есть еще какие-то способы, работающие наверняка?
А вот сеть в организации доменная.
А вот сеть в организации доменная.
Цитата: Apy4
Что касается логина, то я пробовал два способа: с помощью функций UserName и Environ. Результат они давали одинаковый и вроде правильный. Не подскажете, какой из них работает более надежно...
[color=blue]Environ[/color] возвращает верные данные. Однако с её помощью Вы не сможете установить членства пользователя в группах.
Цитата: Apy4
... или есть еще какие-то способы, работающие наверняка?... А вот сеть в организации доменная.
В таком случае удобнее всего будет воспользоваться интерфейсами ADSI.
Вот пара примеров.
1. Определение имени текущего пользователя и проверка его членства в заданной доменной группе:
Код:
2. Определение имени текущего пользователя и проверка его членства хотя бы в одной из заданных доменных групп:
Код:
Sub Example2()
Dim objADSysInfo As Object, objCurrentUser As Object
Dim strCurUserName As String, strListGroups As String
Dim intResFind As Integer
Dim arrMemberOf, arrTestGroups, strItem
arrTestGroups = Array("Группа 1", "Группа 2", "Группа 3")
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objCurrentUser = GetObject("LDAP://" & objADSysInfo.UserName)
strCurUserName = objCurrentUser.cn
arrMemberOf = objCurrentUser.GetEx("MemberOf")
Set objADSysInfo = Nothing
Set objCurrentUser = Nothing
MsgBox "Текущий пользователь: " & strCurUserName, vbInformation
For Each strItem In arrMemberOf
strListGroups = strListGroups & strItem & vbNewLine
Next
intResFind = 0
For i = LBound(arrTestGroups) To UBound(arrTestGroups)
If InStr(1, strListGroups, arrTestGroups(i), vbTextCompare) > 0 Then
intResFind = intResFind + 1
End If
Next
If intResFind > 0 Then
MsgBox "Результат поиска положительный.", vbInformation
Else
MsgBox "Результат поиска отрицательный.", vbCritical
End If
End Sub
Dim objADSysInfo As Object, objCurrentUser As Object
Dim strCurUserName As String, strListGroups As String
Dim intResFind As Integer
Dim arrMemberOf, arrTestGroups, strItem
arrTestGroups = Array("Группа 1", "Группа 2", "Группа 3")
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objCurrentUser = GetObject("LDAP://" & objADSysInfo.UserName)
strCurUserName = objCurrentUser.cn
arrMemberOf = objCurrentUser.GetEx("MemberOf")
Set objADSysInfo = Nothing
Set objCurrentUser = Nothing
MsgBox "Текущий пользователь: " & strCurUserName, vbInformation
For Each strItem In arrMemberOf
strListGroups = strListGroups & strItem & vbNewLine
Next
intResFind = 0
For i = LBound(arrTestGroups) To UBound(arrTestGroups)
If InStr(1, strListGroups, arrTestGroups(i), vbTextCompare) > 0 Then
intResFind = intResFind + 1
End If
Next
If intResFind > 0 Then
MsgBox "Результат поиска положительный.", vbInformation
Else
MsgBox "Результат поиска отрицательный.", vbCritical
End If
End Sub
Спасибо огромное, Dmitrii! Всё работает и это замечательно!:D