Finding Users with Blank (Null) Passwords in AD

This could help a lot of people I thought. This comes originally from http://seclists.org/pen-test/2007/Apr/21

 

You just have to change the portion ‘LDAP://dc=exchange,dc=local’  of the script and put your domain name there. Simply copy and paste it in a notepad and then save the notepad as .vbs

On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2

blankPWD = ""
strDomain = InputBox ("Enter the domain DN: ")
Set objConn = CreateObject("ADODB.Connection")
Set objCmd =   CreateObject("ADODB.Command")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
Set objCmd.ActiveConnection = objConn

objCmd.Properties("Page Size") = 10000
objCmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE

objCmd.CommandText = "SELECT AdsPath FROM ‘LDAP://dc=exchange,dc=local’ WHERE objectCategory=’user’"
Set objRecordSet = objCmd.Execute

objRecordSet.MoveFirst
Do Until objRecordSet.EOF
   strPath = objRecordSet.Fields("AdsPath").Value
   Set objUser= GetObject(strPath)
   objUser.ChangePassword blankPWD, blankPWD
   If Err= 0 or Err = -2147023569 Then
       Wscript.Echo objUser.CN
   End If
   Err.Clear
   objRecordSet.MoveNext
Loop

 

Hope this helps.