Смена пароля у пользователя в домене и генератор паролей

Вот такой небольшой скрипт по генерации паролей заданной длины + есть функция смены пароля у пользователя текущего домена (поиск по sAMAccountName)

 

'
' Скрипт генерации паролей. Запускать от администратора с повышением привилегий
'
Interactive=False
Complexity=False
strLow="abcdefghijklmnopqrstuvwxyz"
strUp="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
strNumbers="1234567890"
strSpecial="!@#$%^&*()-_=+\|/"
PasswordLength=8

On Error Resume Next
Set objArgs=Wscript.Arguments
For i=0 to objArgs.Count-1
    If Ucase(objArgs.Item(i))="/COMPLEX" Then Complexity=True
    If Ucase(objArgs.Item(i))="/VERBOSE" Then Interactive=True
    If Ucase(left(objArgs.Item(i),9))="/PASSLEN:" Then PasswordLength=Cint(Mid(objArgs.Item(i),10))
    If Ucase(left(objArgs.Item(i),6))="/USER:" Then strUserName=Mid(objArgs.Item(i),7)
    If objArgs.Item(i)="/?" or Ucase(objArgs.Item(i))="/HELP" Then ShowUsage
Next
If Complexity Then strVoc=strSpecial & strLow & strUp & strNumbers Else strVoc=strLow & strUp & strNumbers
If Interactive Then print "Complexity: " & Complexity & vbcrlf & "PasswordLength: " & PasswordLength & vbcrlf & "Vocabulary: " & strVoc & vbcrlf & "UserName: " & strUserName
If strUserName="" Then
    print GeneratePassword
Else
    print "UserName: " & strUserName
    SetRandomPasswordFor strUserName
End If
Quit

Sub ShowUsage
    On Error Resume Next
    print "/COMPLEX - to generate ONLY complex passwords" & vbcrlf & "/VERBOSE - to be more loud" & vbcrlf & "/PASSLEN:N - to set password length to N" & vbcrlf & "/USER:username - to generate and set password for specified user in current domain" & vbcrlf & "/? or /HELP - this message" & vbcrlf & "NOTE: You must always run as administrator and be privileged"
    Quit
End Sub
Sub SetRandomPasswordFor(strUser)
    On Error Resume Next
    If Interactive Then print "Get distinguishedName for user: " & strUser
    Err.Clear
    strUserDN=GetLDAPValue("distinguishedName","sAMAccountName='" & strUser & "'")
    If strUserDN="" And Interactive Then print "Empty distinguishedName returned": Quit
    If Interactive Then print strUserDN
    If Interactive Then print "connecting to object"
    Err.Clear
    Set objUser=Getobject("LDAP://" & strUserDN)
    If Error And Interactive Then print "Something is wrong while connecting to object"
    If Interactive Then print "Generate password"
    strPassword=GeneratePassword
    print "Password is: >" & strPassword & "<"
    If Interactive Then print "Set password"
    objUser.SetPassword strPassword
    Err.Clear
    objUser.Setinfo
    If Error And Interactive Then print "Not set"
    print "Done"
End Sub
Function GeneratePassword
    On Error Resume Next
    Do
        strPass=""
        randomize timer
        i=0
        Do
            i=i+1
            x=int(rnd * len(strVoc)+1)
            strPass=strPass & mid(strVoc,x,1)
            If Len(strPass)>=PasswordLength Then Exit Do
        Loop
        If Complexity=False Then Exit Do
    Loop While IsComplex(strPass)=False
    GeneratePassword = strPass
End Function
Function IsComplex(strMyPassword)
    On Error Resume Next
    bSpecial=False
    bNumbers=False
    bLow=False
    bUp=False
    For i=1 to Len(strSpecial)
        If instr(1,strMyPassword,Mid(strSpecial,i,1))>0 Then bSpecial=True: Exit For
    Next
    For i=1 to Len(strNumbers)
        If instr(1,strMyPassword,Mid(strNumbers,i,1))>0 Then bNumbers=True: Exit For
    Next
    For i=1 to Len(strLow)
        If instr(1,strMyPassword,Mid(strLow,i,1))>0 Then bLow=True: Exit For
    Next
    For i=1 to Len(strUp)
        If instr(1,strMyPassword,Mid(strUp,i,1))>0 Then bUp=True: Exit For
    Next
    If bSpecial=True And bNumbers=True And bLow=True And bUp=True Then IsComplex=True Else IsComplex=False

End Function

Function GetLDAPValue(strValue,strFilter)
    On Error Resume Next
    Const ADS_SCOPE_SUBTREE = 2
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    strQuery="SELECT " & strValue & " FROM 'LDAP://" & GetLDAPDomain & "' WHERE " & strFilter
    objCommand.CommandText =  strQuery
    Set objRecordSet = objCommand.Execute
    Do Until objRecordSet.EOF
        strVar = strVar & objrecordset.Fields(strValue).Value & "|"
        objRecordSet.MoveNext
    Loop
    If Len(strVar)>1 Then strVar=left(strVar,Len(strVar)-1)
    If strVar="|" Then strVar=""
    GetLDAPValue=strVar
End Function
Function GetLDAPDomain
    On Error Resume Next
    Set iAdRootDSE = GetObject("LDAP://RootDSE")
    GetLDAPDomain = iAdRootDSE.Get("defaultNamingContext")
End Function
Sub print(strWhat)
    On Error Resume Next
    Wscript.echo strWhat
End Sub
Sub Quit
    Wscript.Quit
End Sub
Function Error
    If Err.Number=0 Then Error=False Else Error=True
End Function