Вот решил изучить ActiveDS. И в первом коде наткнулся на такую проблему: Вот код, полностью скопированный из MSDN 2003
- Код: Выделить всё
Option Explicit
Const ADS_UF_SCRIPT = &H1
Const ADS_UF_ACCOUNTDISABLE = &H2
Const ADS_UF_HOMEDIR_REQUIRED = &H8
Const ADS_UF_LOCKOUT = &H10
Const ADS_UF_PASSWD_NOTREQD = &H20
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80
Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100
Const ADS_UF_NORMAL_ACCOUNT = &H200
Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = &H800
Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = &H1000
Const ADS_UF_SERVER_TRUST_ACCOUNT = &H2000
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_MNS_LOGON_ACCOUNT = &H20000
Const ADS_UF_SMARTCARD_REQUIRED = &H40000
Const ADS_UF_TRUSTED_FOR_DELEGATION = &H80000
Const ADS_UF_NOT_DELEGATED = &H100000
Const ADS_UF_USE_DES_KEY_ONLY = &H200000
Const ADS_UF_DONT_REQUIRE_PREAUTH = &H400000
Const ADS_UF_PASSWORD_EXPIRED = &H800000
Const ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = &H1000000
Public Sub CreateUser(strName As String, strSAMAccountName As String, strInitialPassword As String)
Dim objRootDSE As IADs
Dim objUsers As IADsContainer
Dim objNewUser As IADsUser
' On Error Resume Next
' Bind to the rootDSE object.
Set objRootDSE = GetObject("LDAP://rootDSE")
If (Err.Number <> 0) Then
Exit Sub
End If
' Bind to the Users folder in the domain.
Set objUsers = GetObject("LDAP://CN=Users," & objRootDSE.Get("defaultNamingContext"))
If (Err.Number <> 0) Then
Exit Sub
End If
' Create the user object.
Set objNewUser = objUsers.Create("user", "CN=" + strName)
If (Err.Number <> 0) Then
Exit Sub
End If
' Set the sAMAccountName property.
objNewUser.Put "sAMAccountName", strSAMAccountName
If (Err.Number <> 0) Then
Exit Sub
End If
' Commit the new user.
objNewUser.SetInfo
If (Err.Number <> 0) Then
Exit Sub
End If
' Set the initial password. This must be done after
' SetInfo is called because the user object must
' already exist on the server.
objNewUser.SetPassword strInitialPassword
If (Err.Number <> 0) Then
Exit Sub
End If
' Set the pwdLastSet property to zero, which forces the
' user to change the password at next log on.
objNewUser.Put "pwdLastSet", 0
If (Err.Number <> 0) Then
Exit Sub
End If
' To enable the user account, remove the
' ADS_UF_ACCOUNTDISABLE flag from the userAccountControl
' property. Also, remove the ADS_UF_PASSWD_NOTREQD and
' ADS_UF_DONT_EXPIRE_PASSWD flags from the
' userAccountControl property.
Dim userActCtrl As Long
userActCtrl = objNewUser.Get("userAccountControl")
userActCtrl = userActCtrl And Not (ADS_UF_ACCOUNTDISABLE + ADS_UF_PASSWD_NOTREQD + ADS_UF_DONT_EXPIRE_PASSWD)
objNewUser.Put "userAccountControl", userActCtrl
If (Err.Number <> 0) Then
Exit Sub
End If
' Commit the updated properties.
objNewUser.SetInfo
End Sub
Процедура выдает ошибку(Automation error) при первом вызове GetObject. С чего бы это?