Deleting LDAP Directory Objects

This topic of the SelfADSI tutorial deals with the deleting of LDAP directory objects. The following content is available here: :

Deleting Single Objects with DeleteObject	Deleting Subtrees (Objects with child objects)
Deleting Objects in Containers with Delete

Deleting Single Objects with DeleteObject

If you want to delete an object with an ADSI script, you have to bind to this object and then call the function DeleteObject.

obj.DeleteObject(0)

The parameter is reserved and have to be set to the value 0 always.

Set obj = GetObject("LDAP://CN=JohnDoe,OU=users,OU=company,DC=cerrotorre,DC=de")
obj.DeleteObject(0)

ADSI Reference on the MSDN: DeleteObject()

Deleting Objects in Containers with Delete

If you want to delete a lot of objects in a certain container (for example an OU), then you can bind to the container and then use the ADSI function Delete.

container.Delete "<object class>", "<object RDN>"

You have to pass two string parameters here: The object class of the object which is to be deleted - and the object's name (the Relative Distinguished name RDN - this includes the label, for example "cn=").

Set ou = GetObject("LDAP://OU=users,OU=company,DC=cerrotorre,DC=de")
ou.Delete "user", "CN=PhilippFoeckeler" 'delete a user account

Set ou = GetObject("LDAP://dc1.cerrotorre.de/OU=computers,OU=company,DC=cerrotorre,DC=de")
For Each obj In ou
ou.Delete obj.Class, obj.Name 'delete all objects in the container
Next

Another example for demonstration purposes: This could be a function which automates the LDAP bind to the parent container:

DeleteAsChild "CN=Doe\, John,OU=Users,OU=DivisionB,OU=Cerro,DC=ldapexplorer,DC=com"

Sub DeleteAsChild(objDN)
     Dim obj, container
     Dim objClass, objRDN, containerPath

     Set obj = GetObject("LDAP://" & objDN)        'evaluate object class
     objClass = obj.Class
     objRDN = obj.Name                             'get the object's RDN
     containerPath = obj.Parent                    'get the container's LDAP path

     Set container = GetObject(containerPath)      'bind to container object and perform the Delete

container.Delete objClass, objRDN
End Sub

Please note that you get the same result with a simple DeleteObject also.

ADSI Reference on the MSDN: Delete()

< back to top

Deleting Subtrees (Objects with child objects)

If you try to delete an LDAP container (like an OU) in which are other objects stored, you'll geth the runtime error 0x80072015 (-2147016683: LDAP_ONLY_ALLOWED_ON_LEAFS). This is because the two methods which were introduced here can only delete containers which are empty (witout any child objects). If you want to delete an entire LDAP subtree, you need a recursive function which removes all the children, grandchildren and so on:

DeleteTree "OU=DivisionB,OU=Cerro,DC=ldapexplorer,DC=com"

Sub DeleteTree(objDN)
     Set obj = GetObject("LDAP://" & objDN)

     If (obj.Class="organizationalUnit") Then
          For Each child In obj
               DeleteTree(child.distinguishedName)
          Next
     End If

     obj.DeleteObject(0)
End Sub

This function could cause too much time and cpu cycles if you use this in very large or complex directory sub structures. Therefor i want to show another approach which works without any recursion. This other method can delete subtrees also, but uses this pseudo-code:

- Do an LDAP search operation (ADO) to get all child objects beneath the given container.
- Sort the results accordding to the length of the distinguished names (determining factor is the count of the commas in the DN)
- Delete all obejcts, begin with the 'longest' DNs (this deletes the objects in the lowest hierarchy first).

The script syntax is more complicated due to the LDAP search and the sort operation, but it is much faster when it comes to really large and complex LDAP environments:

DeleteTree("OU=DivisionB,OU=Cerro,DC=ldapexplorer,DC=com")

Sub DeleteTree(objDN)
     children = Array()

     Set ado = CreateObject("ADODB.Connection")               'create new ADO connection
     ado.Provider = "ADSDSOObject"                            'use the ADSI interface
     ado.Open "ADS-Search"                                    'use any name for the connection

     Set adoCmd = CreateObject("ADODB.Command")               'create new ADO command
     adoCmd.ActiveConnection = ado                            'assignment to an existing ADO connection
     adoCmd.Properties("Page Size") = 1000                    'set the Paged Results value to 1000 (AD standard)
     adoCmd.Properties("Cache Results") = True
     adoCmd.CommandText = "<LDAP://" & objDN & ">;(objectClass=*);distinguishedName;subtree"

     Set objectList = adoCmd.Execute                          'perform search
     ReDim children(objectList.RecordCount - 1)               'prepare array for search results
     i = 0

     While Not objectList.EOF                                 'transfer all results into the array
          children(i) = objectList.Fields("distinguishedName")
          i = i + 1

          objectList.MoveNext        'jump to the next found object
     Wend

     SortLongestFirst children                                 'sort the array, longest names first!

     For i = 0 To UBound(children)                             'delete objects in the arrays order
          Set obj = GetObject("LDAP://" & children(i))
          obj.DeleteObject(0)
     Next
End Sub

Sub SortLongestFirst(ByRef arr)                                'ShellSort function
Dim value, index, index2, distance, lastEl, numEls

    lastEl = UBound(arr)
    numEls = lastEl + 1
    distance = 1

    Do
        distance = distance * 3 + 1
    Loop Until distance > numEls

    Do
        distance = distance \ 3
        For index = distance To lastEl
            value = arr(index)
            index2 = index
            Do While (commaCount(arr(index2 - distance)) < commaCount(value))     'compare the length according to commas
                arr(index2) = arr(index2 - distance)
                index2 = index2 - distance
                If index2 - distance < 0 Then Exit Do
            Loop
            arr(index2) = value
        Next
    Loop Until distance = 1
End Sub

'_________________________________________________________________________________________________________________
Function commaCount(s)                                       'count the commas
    sPure = Replace(s, "\,", " ")
    commaCount = 0

    pos = InStr(sPure, ",")
    While (pos > 0)
        commaCount = commaCount + 1
        pos = InStr(pos+1, sPure, ",")
    Wend
End Function

By the way: We use the ShellSort algorithm here.

< back to top

< back to SelfADSI home