Формирование списка локальных администраторов

On Error Resume Next
 
Const ForReading = 1
 
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("c:\ip.txt", ForReading)
i = 1
 
Dim fso, tf
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set tf = fso.CreateTextFile("c:\report.txt", True)
 
Do Until objTextFile.AtEndOfStream 
    strNextLine = objTextFile.Readline
    objDictionary.Add i, strNextLine
    i = i
 
For Each objItem in objDictionary
 
 
Set colAccounts = GetObject("winmgmts://" & strNextLine & "").ExecQuery("Select * From Win32_Group Where LocalAccount = TRUE And SID = 'S-1-5-32-544'")
   For Each objAccount in colAccounts
    strGroup = objAccount.Name
Set objGroup = GetObject("WinNT://" & strNextLine & "/" & strGroup)
bufer = bufer & objTextFile.Readline & VbCrLf &_
              " " & VbCrLf
  For Each objUser in objGroup.Members
    strUserPath = objUser.aDSPath
    strUserPath = Replace(strUserPath, "WinNT://", "")
    bufer = bufer & " " & strUserPath & VbCrLf
  Next
Next
Next
Loop
  tf.WriteLine(bufer)
Wscript.Echo bufer

'************************************************************************************************************************
'* Имя: LocalAdmin_Groups_Revision.vbs                                                                                  *
'* Язык: VBScript                                                                                                       *
'* Назначение: Контроль групп локальных администраторов для заданного списка станций домена.                            *
'* Описание:                                                                                                            *
'* 1. Выполняемые действия.                                                                                             *
'* 1.1. Удаление "учёток", отсутствующих в контрольном списке.                                                          *
'* 1.2. Добавление "учёток", присутствующих в контрольном списке, но отсутствующих в списке членов группы админ-ов.     *
'* 2. Источники данных - две рабочие книги Excel.                                                                       *
'* 2.1. Первая - со списком проверяемых компьютеров, вторая - со списком допустимых "учёток" локальных администраторов. *
'* 2.2. Компьютеры представлены их NetBIOS-именами.                                                                     *
'*      Список располагается на первом рабочем листе книги, в первой колонке листа, начиная со второй строки            *
'*      (первая строка содержит шапку). В каждой ячейке - имя только одного компьютера.                                 *
'*      Вторая - четвёртая колонки предназначены для отражения результатов работы сценария:                             *
'*      - список обнаруженных "учёток" администраторов;                                                                 *
'*      - список удалённых "учёток" администраторов;                                                                    *
'*      - список "учёток" администраторов, которые должны были быть удалены, но не удалены из-за возникшей              *
'*        при выполнении данной операции ошибки;                                                                        *
'*      - список добавлённых "учёток" администраторов;                                                                  *
'*      - список "учёток" администраторов, которые должны были быть добавлены, но не добавлены из-за возникшей          *
'*        при выполнении данной операции ошибки.                                                                        *
'* 2.3. Допустимые "учётки" локальных администраторов предствалены строками в формате ПРЕФИКС + "/" + ИМЯ,              *
'*      где ПРЕФИКС - строка, обозначающая тип "учётки": Domain - для доменной, Local - для локальной.                  *
'*      Например:                                                                                                       *
'*      - Domain/Администраторы домена;                                                                                 *
'*      - Local/Администратор.                                                                                          *
'*      Список располагается на первом рабочем листе книги, в первой колонке листа, начиная со второй строки            *
'*      (первая строка содержит шапку). В каждой ячейке - только одна "учётка".                                         *
'* 2.4. Кавычки в списках нигде не используются.                                                                        *
'* 3. В том случае, когда книга со списком допустимых "учёток" локальных администраторов не указана,                    *
'*    будет выполняться просмотр состава групп без его корректировки.                                                   *
'* 4. Диалог выбора файлов рабочих книг организован с помощью свойства "FileDialog" объекта "Excel.Application".        *
'* 5. Сценарий ориентирован на работу в графическом режиме.                                                             *
'************************************************************************************************************************
 
Dim objShell, strBaseFolder
Dim strBookComputers, strAdminsList, strTemp, blnContinue
Dim objExcel, objWB, objDialog
 
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number = 0 Then
    MsgBox "Укажите файл книги EXCEL со списком проверяемых компьютеров.", vbQuestion, "Контроль групп локальных администраторов"
    Set objShell = CreateObject("Shell.Application")
    strBaseFolder = objShell.NameSpace(&H5).Self.Path
    If Err.Number <> 0 Then
        Err.Clear
        strBaseFolder = "C:\"
    End If
    Set objShell = Nothing
    Set objDialog = objExcel.FileDialog(3)
    objDialog.Filters.Add "Книга MS Excel 97-2003", "*.xls", 1
    objDialog.Filters.Add "Книга MS Excel 2007-2010", "*.xlsx", 2
    objDialog.InitialFileName = strBaseFolder
    objDialog.AllowMultiSelect = False
    objDialog.InitialFileName = vbNullString
    objDialog.Show
    If objDialog.SelectedItems.Count = 1 Then
        strBookComputers = objDialog.SelectedItems(1)
        MsgBox "Укажите файл книги EXCEL с допустимым списком локальных администраторов.", vbExclamation, "Контроль групп локальных администраторов"
        objDialog.Show
        If objDialog.SelectedItems.Count = 1 Then
            strTemp = objDialog.SelectedItems(1)
            Set objWB = objExcel.Workbooks.Open(strTemp)
            If Err.Number = 0 Then
                For i = 2 To objWB.Worksheets(1).Range("a1").CurrentRegion.Rows.Count
                    strAdminsList = strAdminsList & objWB.Worksheets(1).Cells(i, 1).Value & ";"
                Next
                objWB.Close
                blnContinue = True
            Else
                MsgBox "Не удалось открыть файл книги " & UCase(strTemp), vbCritical, "Контроль групп локальных администраторов"
                Err.Clear
            End If
        Else
            MsgBox "Файл книги EXCEL с допустимым списком локальных администраторов не выбран." & vbNewLine & _
                    "Корректировка списка выполняться не будет.", vbExclamation, "Контроль групп локальных администраторов"
            blnContinue = True
        End If
        If blnContinue Then
            Set objWB = objExcel.Workbooks.Open(strBookComputers)
            If Err.Number = 0 Then
                objExcel.Visible = True
                Call LocalAdmins_AuditorEx(objWB, strAdminsList)
                objWB.Save
                objWB.Close
                MsgBox "Готово.", vbInformation, "Контроль групп локальных администраторов"
            Else
                MsgBox "Не удалось открыть файл книги " & UCase(strBookComputers), vbCritical, "Контроль групп локальных администраторов"
                Err.Clear
            End If
            Set objWB = Nothing
        End If
    End If
    Set objDialog = Nothing
    objExcel.Quit
Else
    MsgBox "Не удалось создать экземпляр приложения EXCEL.", vbCritical, "Контроль групп локальных администраторов"
    Err.Clear
End If
Set objExcel = Nothing
WScript.Quit 0
 
'======
 
Function LocalAdmins_AuditorEx(objBook, strAdmins)
Dim objWsNet, strDomain
Dim objTemp, strTemp, arrTemp, blnModify, strAdmins2, strListFull, intRes
Dim strListRemoved, strListNotRemoved, strListAdded, strListNotAdded
Dim objGroup, objMember
 
Set objWsNet = CreateObject("WScript.Network")
strDomain = objWsNet.UserDomain
Set objWsNet = Nothing
If Len(strAdmins) > 0 Then
    blnModify = True
    strAdmins = Replace(strAdmins, "Domain", strDomain, 1, -1, vbTextCompare)
Else
    blnModify = False
End If
On Error Resume Next
With objBook.Worksheets(1)
    For i = 2 To .Range("a1").CurrentRegion.Rows.Count
        strListFull = vbNullString: strListRemoved = vbNullString: strListNotRemoved = vbNullString
                strListAdded = vbNullString: strListNotAdded = vbNullString
        .Cells(i, 1).Activate
        strTemp = .Cells(i, 1).Value
        .Range("c" & i & ":f" & i).ClearContents
        If Available(strTemp) Then
            Set objGroup = GetObject("WinNT://" & strDomain & "/" & strTemp & "/Администраторы,group")
            If Err.Number <> 0 Then
                Err.Clear
                Set objGroup = GetObject("WinNT://" & strDomain & "/" & strTemp & "/Administrators,group")
                If Err.Number <> 0 Then
                    Err.Clear
                End If
            End If
            If Not objGroup Is Nothing Then
                If blnModify Then strAdmins2 = Replace(strAdmins, "Local", strDomain & "/" & strTemp, 1, -1, vbTextCompare)
                For Each objMember In objGroup.Members
                    strTemp = Mid(objMember.ADsPath, 9) & ";"
                    strListFull = strListFull & strTemp
                    'If blnModify Then
                    '    If InStr(1, strAdmins2, strTemp, vbTextCompare) = 0 Then
                    '        intRes = objGroup.Remove(objMember.ADsPath)
                    '        If intRes = 0 Then
                    '            strListRemoved = strListRemoved & strTemp
                    '        Else
                    '            strListNotRemoved = strListNotRemoved & strTemp
                    '        End If
                    '    End If
                    'End If
                Next
                .Cells(i, 2).Value = Left(strListFull, Len(strListFull) - 1)
                'If blnModify Then
                '    arrTemp = Split(Left(strAdmins2, Len(strAdmins2) - 1), ";")
                '    For j = 0 To UBound(arrTemp)
                '        If InStr(1, strListFull, arrTemp(j), vbTextCompare) = 0 Then
                '            Set objTemp = GetObject("WinNT://" & arrTemp(j))
                '            If Err.Number = 0 Then
                '                intRes = objGroup.Add("WinNT://" & arrTemp(j))
                '                If intRes = 0 Then
                '                    strListAdded = strListAdded & arrTemp(j) & ";"
                '                Else
                '                    strListNotAdded = strListNotAdded & arrTemp(j) & ";"
                '                End If
                '                Set objTemp = Nothing
                '            Else
                '                strListNotAdded = strListNotAdded & arrTemp(j) & " (не найден);"
                '                Err.Clear
                '            End If
                '        End If
                '    Next
                '    .Cells(i, 3).Value = Left(strListRemoved, Len(strListRemoved) - 1)
                '    .Cells(i, 4).Value = Left(strListNotRemoved, Len(strListNotRemoved) - 1)
                '    .Cells(i, 5).Value = Left(strListAdded, Len(strListAdded) - 1)
                '    .Cells(i, 6).Value = Left(strListNotAdded, Len(strListNotAdded) - 1)
                'End If
            Else
                .Cells(i, 2).Value = "Ошибка подключения"
            End If
        Else
            .Cells(i, 2).Value = "Не отвечает или не существует"
        End If
        Set objMember = Nothing
        Set objGroup = Nothing
    Next
    .Columns("b:f").AutoFit
End With
End Function
 
'======
 
Function Available(strName)
Dim objWMI, objItem
 
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address='" & strName & "'")
For Each objItem In objWMI
    If IsNull(objItem.StatusCode) Then
        Available = False
    Else
        Available = (objItem.StatusCode = 0)
    End If
Next
Set objItem = Nothing
Set objWMI = Nothing
End Function