Представьте ситуацию: новые пользователи заводятся в домен автоматически с заранее известным паролем, например password. Т. е. политика сложности пароля позволяет использовать простые пароли, хоть 111111. Смена пароля лежит на совести пользователя, а значит — не меняется. С помощью данного vbs-скрипта можно проверить какие пользователи используют словарные пароли

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes 
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset 
Dim strUser, strPassword, objDomain, objNS 
Dim iplus, iall 
Dim fso, f1 
Dim WshShell, Path 

Const ADS_SECURE_AUTHENTICATION = &H1 
Const ADS_USE_ENCRYPTION = &H2 

Set fso = CreateObject("Scripting.FileSystemObject") 
Set f1 = fso.CreateTextFile("c:\testfile.txt", True) 
iplus = 1 
iall = 1 
Set objNS = GetObject("LDAP:") 
strPassword = InputBox("Введите пароль для проверки") 
Set adoCommand = CreateObject("ADODB.Command") 
Set adoConnection = CreateObject("ADODB.Connection") 
adoConnection.Provider = "ADsDSOObject" 
adoConnection.Open "Active Directory Provider" 
adoCommand.ActiveConnection = adoConnection 

Set objRootDSE = GetObject("LDAP://RootDSE") 
strDNSDomain = objRootDSE.Get("defaultNamingContext") 
strBase = "<LDAP://" & strDNSDomain & ">" 

strFilter = "(&(objectCategory=person)(objectClass=user))" 
strAttributes = "sAMAccountName" 
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 
adoCommand.CommandText = strQuery 
adoCommand.Properties("Page Size") = 100 
adoCommand.Properties("Timeout") = 30 
adoCommand.Properties("Cache Results") = False 

Set adoRecordset = adoCommand.Execute 
Do Until adoRecordset.EOF 
    strUser = adoRecordset.Fields("sAMAccountName").Value 
    On Error Resume Next 
    Set objDomain = objNS.OpenDSObject("LDAP://" & strDNSDomain, _ 
        strUser, strPassword, ADS_SECURE_AUTHENTICATION) 
    If (Err.Number = 0) Then 
        On Error GoTo 0 
   f1.WriteLine(iplus & " User : " & strUser & vbTab & vbTab & " Пароль : '" & strPassword & "'") 
   iplus = iplus + 1 
    End If 
    On Error GoTo 0 
    adoRecordset.MoveNext 
   iall = iall + 1 
Loop 

f1.WriteLine("Всего проверено " & iall & " пользователей") 
f1.Close 
adoRecordset.Close 
adoConnection.Close 

Set WshShell = WScript.CreateObject("WScript.Shell") 
On Error Resume Next 
Path = "notepad c:\testfile.txt" 
WshShell.Run Path