Add Users To Security Group Using LDAP

Category:

Windows 2000/XP

Type:

Snippets

Difficulty:

Intermediate

Author: Anonymous

Version Compatibility: Visual Basic 6

More information:

Originally for use in my school to migrate the new pupils for the next year. Also demonstrates how to determine if an account is disabled, how to unlock an account and more.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
'***************************************************************************************' ' Copyright MARIANNE BUSCH ' '***************************************************************************************' Option Explicit Public strUserName As String Public strContainer As String Public strAdminName As String Public strAdminPassword As String

Code:

Public Function CreateUser( _
    strFirstName As String, _
    strLastName As String, _
    strPasswd As String, _
    strDescription As String, _
    strHomePagePath As String, _
    strProfil As String, _
    straGruppen As Variant, _
    bolPasswdChangeAfterNextLogon As Boolean, _
    bolAccountIsDisabled As Boolean, _
    strHomedir As String, _
    strLaufwerk As String) As String
 
On Error GoTo dbErrHandler
Dim cn As IADsContainer    'LDAP - Objekte
Dim grp As IADsGroup
Dim usr As IADsUser
Dim LDAP As IADsOpenDSObject
    Set LDAP = GetObject("LDAP:")
    Set cn = LDAP.OpenDSObject("LDAP://" & strContainer, strAdminName, strAdminPassword, 0)

'Aufruf der den Benutzer anlegt und dessen Eigenschaften konfiguriert
    Set usr = cn.Create("user", "CN=" & strUserName)
        usr.Put "sAMAccountName", CStr(strUserName)             'NT-Anmeldename
        usr.Put "userPrincipalName", CStr(strUserName)          'UPN-Name (Name@Organisation)

usr.SetInfo                                             'Alles speichern
        usr.GetInfo                                             'und neu einlesen

usr.Put "DisplayName", CStr(strUserName)
        usr.FullName = strUserName
        usr.LastName = strLastName
        usr.Description = strDescription
        usr.HomePage = strHomePagePath

usr.Profile = strProfil
        usr.HomeDirectory = strHomedir
        usr.Put "homeDrive", CStr(strLaufwerk)
        
        usr.Put "msNpAllowDialin", True                         'geht nur in nicht reiner Win2000 Domain
        
        usr.SetPassword CStr(strPasswd)
        usr.PasswordRequired = True
        
        If bolPasswdChangeAfterNextLogon = True Then
            usr.Put "pwdLastSet", CLng(0)                       'aktivierung des Passwort „ndern H„kchens
        End If
        
        usr.AccountDisabled = bolAccountIsDisabled

If strFirstName <> "" Then usr.FirstName = strFirstName
        If strFirstName <> "" Then usr.NamePrefix = strDescription
    
        usr.SetInfo                                             'Alles speichern
    
    'Gruppen hinzufgen
    Dim inti As Integer
    Do
        Set grp = LDAP.OpenDSObject("LDAP://" & CStr(Trim(straGruppen(inti))), strAdminName, strAdminPassword, 0)
            grp.Add (usr.ADsPath)
        Set grp = Nothing
        inti = inti + 1
    Loop While inti < (UBound(straGruppen) + 1)
            
        usr.SetInfo                                             'Alles speichern
        
    Set grp = Nothing
    Set usr = Nothing
    Set cn = Nothing
    Set LDAP = Nothing
    
Exit Function
dbErrHandler:
    Select Case Err.Number
        Case -2147019886
            CreateUser = "Der Benutzer existiert schon!" 'Meldung nicht „ndern!
        Case Else
            CreateUser = Err.Number & " " & Err.Description
    End Select
End Function

Public Function CreateUserEx( _
    Optional strFirstName As String, _
    Optional strLastName As String, _
    Optional strPasswd As String, _
    Optional bolPasswdRequired As Boolean, _
    Optional strDescription As String, _
    Optional strHomePagePath As String, _
    Optional strProfil As String, _
    Optional straGruppen As Variant, _
    Optional bolPasswdChangeAfterNextLogon As Boolean, _
    Optional bolAccountIsDisabled As Boolean, _
    Optional strHomedir As String, _
    Optional strLaufwerk As String, _
    Optional bolmsNpAllowDialin As Boolean) As String
    
On Error GoTo dbErrHandler
Dim cn As IADsContainer    'LDAP - Objekte
Dim grp As IADsGroup
Dim usr As IADsUser
Dim LDAP As IADsOpenDSObject
    Set LDAP = GetObject("LDAP:")
    Set cn = LDAP.OpenDSObject("LDAP://" & strContainer, strAdminName, strAdminPassword, 0)

usr.SetInfo                                             'Alles speichern
        usr.GetInfo                                             'und neu einlesen
        
        usr.Put "DisplayName", CStr(strUserName)
        usr.FullName = strUserName
        
'Optionale Eigenschaften setzen
        If strLastName <> "" Then usr.LastName = strLastName
        If strDescription <> "" Then usr.Description = strDescription
        If strHomePagePath <> "" Then usr.HomePage = strHomePagePath

If strProfil <> "" Then usr.Profile = strProfil
        If strHomedir <> "" Then usr.HomeDirectory = strHomedir
        If strLaufwerk <> "" Then usr.Put "homeDrive", CStr(strLaufwerk)
        
        usr.Put "msNpAllowDialin", bolmsNpAllowDialin           'geht nur in nicht reiner Win2000 Domain
        
        If strPasswd <> "" Then usr.SetPassword CStr(strPasswd)
        usr.PasswordRequired = bolPasswdRequired
        
        If bolPasswdChangeAfterNextLogon = True Then
            usr.Put "pwdLastSet", CLng(0)                       'aktivierung des Passwort „ndern H„kchens
        End If
        
        usr.AccountDisabled = bolAccountIsDisabled

If strFirstName <> "" Then usr.FirstName = strFirstName
        'usr.NamePrefix = strDescription
        
    'Gruppen hinzufgen
    Dim inti As Integer
    Do Until inti >= UBound(straGruppen)
        Set grp = LDAP.OpenDSObject("LDAP://" & CStr(Trim(straGruppen(inti))), strAdminName, strAdminPassword, 0)
            grp.Add (usr.ADsPath)
        Set grp = Nothing
        inti = inti + 1
    Loop 'While inti < (UBound(straGruppen) + 1)
            
    usr.SetInfo                                             'Alles speichern
        
    Set grp = Nothing
    Set usr = Nothing
    Set cn = Nothing
    Set LDAP = Nothing
    
Exit Function
dbErrHandler:
    Select Case Err.Number
        Case -2147019886
            CreateUserEx = "Der Benutzer existiert schon!" 'Meldung nicht „ndern!
        Case Else
            CreateUserEx = Err.Number & " " & Err.Description
    End Select
End Function

Public Function UserPropertiesAndClassGroup(strKlasse As String, strGroup As String) As String

On Error GoTo dbErrHandler
Dim cn As IADsContainer      'LDAP - Objekte
Dim grp As IADsGroup
Dim usr As IADsUser
Dim LDAP As IADsOpenDSObject
    Set LDAP = GetObject("LDAP:")
    Set cn = LDAP.OpenDSObject("LDAP://" & strContainer, strAdminName, strAdminPassword, 0)
    
    Set usr = cn.GetObject("user", "CN=" & strUserName)                  'User
    'Eigenschaften
        usr.Description = strKlasse
        usr.NamePrefix = strKlasse
        
    'Gruppen hinzufgen
    Set grp = LDAP.OpenDSObject("LDAP://" & strGroup, strAdminName, strAdminPassword, 0)
        grp.Add (usr.ADsPath)
            
        usr.SetInfo
    Set cn = Nothing
    Set usr = Nothing
    Set grp = Nothing
    Set LDAP = Nothing
    
Exit Function
dbErrHandler:
    Select Case Err.Number
        Case -2147019886
            UserPropertiesAndClassGroup = "Der Benutzer ist schon in der Gruppe"
        Case Else
            UserPropertiesAndClassGroup = Err.Number & " " & Err.Description
    End Select
End Function

Public Function CreateGroup(strGroup As String, strDescription As String) As String
On Error GoTo dbErrHandler
Dim cn As IADsContainer    'LDAP - Objekte
Dim grp As IADsGroup
Dim LDAP As IADsOpenDSObject
    Set LDAP = GetObject("LDAP:")
Set cn = LDAP.OpenDSObject("LDAP://" & strContainer, CStr(strAdminName), strAdminPassword, 0)

Set grp = cn.Create("group", "CN=" & strGroup)
    grp.Put "saMAccountName", CStr(strGroup)
    grp.Description = strDescription
    grp.SetInfo

Set grp = Nothing
    Set cn = Nothing
    Set LDAP = Nothing

Exit Function
dbErrHandler:
    Select Case Err.Number
        Case -2147019886
            CreateGroup = "Die Gruppe existiert schon!"
        Case Else
            CreateGroup = Err.Number & " " & Err.Description
    End Select
End Function

Public Function DelUser() As String
'Aufruf der den Benutzer l”scht

On Error GoTo dbErrHandler
Dim cn As IADsContainer    'LDAP - Objekte
Dim usr As IADsUser
Dim LDAP As IADsOpenDSObject
    Set LDAP = GetObject("LDAP:")
    Set cn = LDAP.OpenDSObject("LDAP://" & strContainer, CStr(strAdminName), strAdminPassword, 0)
    Set usr = cn.GetObject("user", "CN=" & strUserName)                 'User
    
        cn.Delete "user", usr.Name
        
    Set usr = Nothing
    Set cn = Nothing
    Set LDAP = Nothing

Exit Function
dbErrHandler:
    Select Case Err.Number
        Case -2147016656
            DelUser = "Der Benutzer existierte nicht!"
        Case Else
            DelUser = Err.Number & " " & Err.Description
    End Select
End Function

Public Function SetPasswd(strPasswd As String, bolPasswdChangeAfterNextLogon As Boolean) As String
'Aufruf der den das Kennwort auf das angegebene setzt

On Error GoTo dbErrHandler
Dim cn As IADsContainer    'LDAP - Objekte
Dim usr As IADsUser
Dim LDAP As IADsOpenDSObject
    Set LDAP = GetObject("LDAP:")
Set cn = LDAP.OpenDSObject("LDAP://" & strContainer, CStr(strAdminName), strAdminPassword, 0)
    Set usr = cn.GetObject("user", "CN=" & strUserName)                 'User
        usr.SetPassword CStr(strPasswd)
    
    If bolPasswdChangeAfterNextLogon = True Then
        usr.Put "pwdLastSet", CLng(0)   'Aktivierung des „ndern H„kchens
    End If
        
    Set usr = Nothing
    Set cn = Nothing
    Set LDAP = Nothing

Exit Function
dbErrHandler:
    Select Case Err.Number
        Case -2147016656
            SetPasswd = "Der Benutzer existiert nicht!"
        Case Else
            SetPasswd = Err.Number & " " & Err.Description
    End Select
End Function

Public Function Un_LockAccount(bytToLock As Byte) As String
'Entsperrt den Account
'bytToLock = 0 Entsperrt
'bytToLock = 1 Sperrt

On Error GoTo dbErrHandler
Dim cn As IADsContainer    'LDAP - Objekte
Dim usr As IADsUser
Dim LDAP As IADsOpenDSObject
    Set LDAP = GetObject("LDAP:")
Set cn = LDAP.OpenDSObject("LDAP://" & strContainer, CStr(strAdminName), strAdminPassword, 0)
    Set usr = cn.GetObject("user", "CN=" & strUserName)                 'User
    
    If bytToLock = 1 Then
        usr.AccountDisabled = True
    Else
        usr.IsAccountLocked = False
        usr.AccountDisabled = False
    End If
    
    usr.SetInfo
    
    Set usr = Nothing
    Set cn = Nothing
    Set LDAP = Nothing

Exit Function
dbErrHandler:
    Select Case Err.Number
        Case -2147016656
            Un_LockAccount = "Der Benutzer existiert nicht!"
        Case Else
            Un_LockAccount = Err.Number & " " & Err.Description
    End Select
End Function

Public Function IsAccountDisabled(ByRef strErrDescriptionIfMeIs3 As String) As Byte
'0 = Benutzer existiert nicht
'1 = Benutzer existiert und ist NICHT gesperrt
'2 = Benutzer existiert und IST gesperrt
'3 = Fehler

On Error GoTo dbErrHandler
Dim cn As IADsContainer    'LDAP - Objekte
Dim usr As IADsUser
Dim LDAP As IADsOpenDSObject  'Lesen drfte ich wahrscheinlich auch ohne Anmeldung, doch das testet Zugriff
    Set LDAP = GetObject("LDAP:")
Set cn = LDAP.OpenDSObject("LDAP://" & strContainer, CStr(strAdminName), strAdminPassword, 0)
    Set usr = cn.GetObject("user", "CN=" & strUserName)                 'User
        
    If (usr.AccountDisabled = True) Or (usr.IsAccountLocked = True) Then
        IsAccountDisabled = 2
    Else
        IsAccountDisabled = 1
    End If
            
    Set usr = Nothing
    Set cn = Nothing
    Set LDAP = Nothing
    
Exit Function
dbErrHandler:
    Select Case Err.Number
        Case -2147016656
            IsAccountDisabled = 0
        Case Else
            IsAccountDisabled = 3
            strErrDescriptionIfMeIs3 = Err.Description
    End Select
End Function