WSH,VBS: получение учеток из 1С в AD

Const ADS_UF_SCRIPT = &H1
Const ADS_UF_ACCOUNTDISABLE = &H2
Const ADS_UF_HOMEDIR_REQUIRED = &H8
Const ADS_UF_LOCKOUT = &H10
Const ADS_UF_PASSWD_NOTREQD = &H20
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80
Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100
Const ADS_UF_NORMAL_ACCOUNT = &H200
Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = &H800
Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = &H1000
Const ADS_UF_SERVER_TRUST_ACCOUNT = &H2000
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_MNS_LOGON_ACCOUNT = &H20000
Const ADS_UF_SMARTCARD_REQUIRED = &H40000
Const ADS_UF_TRUSTED_FOR_DELEGATION = &H80000
Const ADS_UF_NOT_DELEGATED = &H100000
Const ADS_UF_USE_DES_KEY_ONLY = &H200000
Const ADS_UF_DONT_REQUIRE_PREAUTH = &H400000
Const ADS_UF_PASSWORD_EXPIRED = &H800000
Const ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = &H1000000

Sub recursive(objUnit, objDict)
    itemExists = False
    For Each objMember in objUnit
        If InStr(1, objMember.objectCategory, "CN=Person", vbTextCompare) > 0 Then
            itemExists = objDict.Exists(objMember.sAMAccountName)
            If itemExists = False Then
                               objDict.Add objMember.sAMAccountName, objMember.distinguishedName
            End If
        Else
            recursive objMember, objDict
        End If
    Next
End Sub

On Error Resume Next

Set objShell = CreateObject("WScript.Shell")
objShell.LogEvent 0, "Script started"

Set objDictionary = CreateObject("Scripting.Dictionary")
objDictionary.CompareMode = vbTextCompare

' Bind to the rootDSE object.
Set objRootDSE = GetObject("LDAP://rootDSE")
If (Err.Number <> 0) Then
    objShell.LogEvent 1, "Error getting rootDSE: " & Err.Number & " - " & Err.Description
    WScript.Quit
End If
    
' Bind to the root container in the domain.
Set objUsers = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
If (Err.Number <> 0) Then
    objShell.LogEvent 1, "Error getting root container: " & Err.Number & " - " & Err.Description
    WScript.Quit
End If

recursive objUsers, objDictionary





Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlHttp.SetOption(2) = (xmlHttp.GetOption(2) - SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS)
xmlHttp.Open "GET", "https://1c.contora.ru/Person", False, "login", "password"
xmlHttp.send ("")

If Not xmlHttp.status = 200 Then
    objShell.LogEvent 1, "Error receiving xml: " & xmlHttp.status & " - " & xmlHttp.statusText
    WScrit.Quit
End If





Set xmlParser = CreateObject("MSXML2.DOMDocument")
xmlParser.async = False
xmlParser.loadXML(xmlHttp.responseText)
Set xmlHttp = Nothing

If xmlParser.parseError.errorCode Then
    objShell.LogEvent 1, "Error parsing xml: " & xmlParser.parseError.errorCode & " - " & xmlParser.parseError.reason
    WScript.Quit
End If





' Bind to the Users folder in the domain.
Set objUsers = GetObject("LDAP://CN=Users," & objRootDSE.Get("defaultNamingContext"))
If (Err.Number <> 0) Then
    objShell.LogEvent 1, "Error getting Users container: " & Err.Number & " - " & Err.Description
    WScript.Quit
End If

Set nodes = xmlParser.getElementsByTagName("Person")
For Each node In nodes
Do

    strLogin = Trim(node.getAttribute("Login"))
    If IsNull(strLogin) Or Len(strLogin) = 0 Then
        Exit Do
    End If

    Set objUser = Nothing
    If objDictionary.Exists(strLogin) Then
        Set objUser = GetObject("LDAP://" & objDictionary(strLogin))
        objDictionary.Remove(strLogin)
    End If

    strFullName = Trim(node.getAttribute("FullName"))
    If IsNull(strFullName) Or Len(strFullName) = 0 Then
        Exit Do
    End If
    
    IsNewUser = False
    
    If objUser Is Nothing Then
        Err.Clear
	Set objUser = objUsers.Create("user", "CN=" & strFullName)
        If (Err.Number <> 0) Then
	    objShell.LogEvent 1, "Error creating user" & strLogin & ": " & Err.Number & " - " & Err.Description
            Exit Do
        End If
        IsNewUser = True
    Else
        objShell.LogEvent 0, "Found user " & strLogin
    End If

    strFirstName = Trim(node.getAttribute("FirstName"))
    If IsNull(strFirstName) Then
        strFirstName = ""
    End If
    
    strMiddleName = Trim(node.getAttribute("MiddleName"))
    If IsNull(strMiddleName) Then
        strMiddleName = ""
    End If
    
    strLastName = Trim(node.getAttribute("LastName"))
    If IsNull(strLastName) Then
        strLastName = ""
    End If
    
    Err.Clear
    objUser.sAMAccountName    = strLogin
    objUser.displayName       = strFullName
    objUser.givenName         = strFirstName
    objUser.initials          = Left(strMiddleName, 1)
    objUser.sn                = strLastName
    objUser.userPrincipalName = strLogin & "@contora.ru"
    
    objUser.SetInfo
    If (Err.Number <> 0) Then
        objShell.LogEvent 1, "Error commiting user " & strLogin & ": " & Err.Number & " - " & Err.Description
        Exit Do
    End If
    
    If Not IsNewUser Then
        Exit Do
    End If
    
    objShell.LogEvent 1, "Setting password for user " & strLogin
    Err.Clear
    objUser.SetPassword "Qq12345"
    If (Err.Number <> 0) Then
        objShell.LogEvent 1, "Error setting password for user " & strLogin & ": " & Err.Number & " - " & Err.Description
        Exit Do
    End If
    
    Err.Clear
    objUser.pwdLastSet = 0
    If (Err.Number <> 0) Then
        objShell.LogEvent 1, "Error setting pwdLastSet for user " & strLogin & ": " & Err.Number & " - " & Err.Description
        Exit Do
    End If
    
    Err.Clear
    userActCtrl = objUser.Get("userAccountControl")
    userActCtrl = userActCtrl And Not (ADS_UF_ACCOUNTDISABLE + ADS_UF_PASSWD_NOTREQD + ADS_UF_DONT_EXPIRE_PASSWD)
    objUser.userAccountControl = userActCtrl
    If (Err.Number <> 0) Then
        objShell.LogEvent 1, "Error setting userAccountControlfor user " & strLogin & ": " & Err.Number & " - " & Err.Description
        Exit Do
    End If
    
    Err.Clear
    objUser.SetInfo
    If (Err.Number <> 0) Then
        objShell.LogEvent 1, "Error second commiting user " & strLogin & ": " & Err.Number & " - " & Err.Description
        Exit Do
    End If

Loop While False
Next
Set xmlParser = Nothing





Err.Clear
Set objDontOff = GetObject("LDAP://CN=dontoff,CN=Users," & objRootDSE.Get("defaultNamingContext"))
If (Err.Number <> 0) Then
    objShell.LogEvent 1, "Error getting dontoff container: " & Err.Number & " - " & Err.Description
    WScript.Quit
End If

For Each objMember In objDontOff.members
    If objDictionary.Exists(objMember.sAMAccountName) Then
        objDictionary.Remove(objMember.sAMAccountName)
    End If
Next





For Each strLogin In objDictionary
Do

    Set objUser = Nothing
    Set objUser = GetObject("LDAP://" & objDictionary(strLogin))
    
    If IsNull(objUser) Or objUser Is Nothing Then
        Exit Do
    ElseIf InStr(1, objUser.memberOf, "CN=dontoff,CN=Users", vbTextCompare) > 0 Then
        Exit Do
    End If
    
    Err.Clear
    objUser.AccountDisabled = True
    objUser.SetInfo
    If (Err.Number <> 0) Then
        objShell.LogEvent 1, "Error disabling user " & strLogin & ": " & Err.Number & " - " & Err.Description
        Exit Do
    Else
        objShell.LogEvent 0, "Disabled user " & strLogin
    End If
    
Loop While False    
Next





objShell.LogEvent 0, "Script finished"