How do you clean up credential roaming?

Some time ago, I posed and attempted to answer the question: How much space does Credential Roaming really take?  Based on the information that I provided in that post, you can get an idea for the amount of space all those wonderful credentials are now taking up in your Active Directory ntds.dit file.

With that in mind, a couple months ago I was posed with a challenge: How do you clean up credential roaming?  Basically, I had a client that had implemented credential roaming, were not use it, and the roaming aspect of credential roaming had gone a little haywire.  At the end of the day, credential roaming had ballooned their ntds.dit file by about 1GB and we now had to clean up the mess.  To complete this job we did the following tasks:

1. First we disabled credential roaming via GPO.
2. Next, I mashed out a script to wipe the directory clean of the cached credentials.
3. Finally, we performed some offline maintenance on the database to shrink the size of the ntds.dit file.

The script is as follows (mind the formatting):

On Error Resume Next

 

Dim cachedCon

Dim objConnection, objCommand, objRecordSet

Dim StdOut

Dim strSearchRoot

 

Set StdOut = WScript.StdOut

strSearchRoot = "mydc01/OU=Cool Users,Dc=mydomain,DC=com"

 

' Cache AD Connection

Set cachedCon = GetObject("LDAP://DC=mydomain,DC=com")

 

' Setup ADODB

Set objConnection = CreateObject("ADODB.Connection")

Set objCommand = CreateObject("ADODB.Command")

objConnection.Provider = "ADsDSOObject"

objConnection.Open("Active Directory Provider")

objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 500

objCommand.CommandText = "<LDAP://" & strSearchRoot & ">;(sAMAccountType=805306368);samaccountname,distinguishedName;subtree"

 

' Find Users

StdOut.Write "Finding User Accounts:  "

Set objRecordset = objCommand.Execute

StdOut.WriteLine objRecordSet.RecordCount

 

i = 1

 

Do Until objRecordSet.EOF

   StdOut.Write objRecordSet.Fields("samaccountname") & ": "

 

   strUserDN = objRecordSet.Fields("distinguishedName")

   Set objUser = GetObject("LDAP://" & strUserDN)

   objUser.PutEx 1,"msPKIAccountCredentials", 0

   objUser.PutEx 1,"msPKIDPAPIMasterKeys", 0

   objUser.PutEx 1,"msPKIRoamingTimeStamp", 0

   objUser.SetInfo

 

   StdOut.WriteLine "Completed " & i

   i = i + 1

 

   Set objUser = Nothing

 

   objRecordSet.MoveNext

Loop

 

Set objRecordSet = Nothing

Set cachedCon = Nothing

At the end of the day, the script basically just sets msPKIAccountCredentials, msPKIDPAPIMasterKeys, and msPKIRoamingTimeStamp attributes for each user account found to a null value.  Not too bad...