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
If you want to delete an object with an ADSI script, you have to bind to this object and then call the function DeleteObject.
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")
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
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"
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
Please note that you get the same result with a simple DeleteObject also.
Reference on the MSDN: Delete()
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:
Set obj = GetObject("LDAP://" & objDN)
If (obj.Class="organizationalUnit") Then
For Each child In obj
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:
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
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))
Sub SortLongestFirst(ByRef arr) 'ShellSort function
Dim value, index, index2, distance, lastEl, numEls
lastEl = UBound(arr)
numEls = lastEl + 1
distance = 1
distance = distance * 3 + 1
Loop Until distance > numEls
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
arr(index2) = value
Loop Until distance = 1
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, ",")
By the way: We use the ShellSort algorithm here.