[DmitriiV]

Freem, вот один из возможных вариантов:

читать дальше »

Код:

Dim objRoot, strDomain
Dim strComputer, strUser, blnPing, intStatus, strTemp
Dim objConnection, objCommand, objRSet, strCommandText
Dim objWMI, objCollection, objItem
Const ADS_SCOPE_SUBTREE = 2
Const ADS_UF_ACCOUNTDISABLE = 2

Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
strComputer = Trim(InputBox("Имя компьютера:", "Выключение или перезагрузка станции"))
If Len(strComputer) > 0 Then
    strComputer = UCase(strComputer)
    strCommandText = "SELECT cn,userAccountControl,operatingSystem FROM 'LDAP://" & strDomain & _
                        "' WHERE objectCategory='Computer' AND cn='" & strComputer & "'"
    objCommand.CommandText = strCommandText
    Set objRSet = objCommand.Execute
    If objRSet.RecordCount > 0 Then
        objRSet.MoveFirst
        If CBool(objRSet.Fields("userAccountControl").Value And ADS_UF_ACCOUNTDISABLE) Then
            MsgBox strComputer & " -> учётная запись компьютера отключена", vbExclamation, "Отчёт"
        Else
            strTemp = objRSet.Fields("operatingSystem").Value
            If Not IsNull(strTemp) Then
                If InStr(1, strTemp, "server", vbTextCompare) = 0 And _
                    InStr(1, strTemp, "2000", vbTextCompare) = 0 Then
                    blnPing = Available(strComputer)
                    If blnPing Then
                        strUser = Logged_Session(strComputer, intStatus)
                        Select Case intStatus
                            Case 0, 1
                                If MsgBox(strComputer & " -> обнаружен сеанс " & UCase(strUser) & "." & vbNewLine & "Закрыть?", vbYesNo + vbQuestion, "Выбор продолжения") = vbYes Then
                                    intStatus = -1
                                    On Error Resume Next
                                    Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown,RemoteShutdown)}!\\" & strComputer & "\root\cimv2")
                                    If Err.Number = 0 Then
                                        Set objCollection = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
                                        If Err.Number = 0 Then
                                            For Each objItem In objCollection
                                                intStatus = objItem.Win32Shutdown(4)
                                            Next
                                            Set objItem = Nothing
                                            If intStatus = 0 Then
                                                WScript.Sleep 10000
                                                intStatus = -1
                                                strTemp = Off_Reboot(strComputer, intStatus, False)
                                                If Len(strTemp) > 0 Then
                                                    If intStatus = 0 Then
                                                        MsgBox strComputer & " -> команда на закрытие сеанса " & UCase(strUser) & " послана успешно," & vbNewLine & "команда на выключение/перезагрузку послана успешно", vbInformation, "Отчёт"
                                                    Else
                                                        MsgBox strComputer & " -> команда на закрытие сеанса " & UCase(strUser) & " послана успешно," & vbNewLine & "команда на выключение/перезагрузку отклонена", vbInformation, "Отчёт"
                                                    End If
                                                Else
                                                    MsgBox strComputer & " -> команда на закрытие сеанса " & UCase(strUser) & " послана успешно," & vbNewLine & "операция выключения/перезагрузки отменена", vbInformation, "Отчёт"
                                                End If
                                            Else
                                                MsgBox strComputer & " -> команда на закрытие сеанса " & UCase(strUser) & " отклонена" & vbNewLine & "Код ошибки: " & intResult, vbExclamation, "Отчёт"
                                            End If
                                        Else
                                            MsgBox strComputer & " -> обращение к операционной системе не выполнено." & vbNewLine & "Код ошибки: " & Err.Number, vbCritical, "Отчёт"
                                            Err.Clear
                                        End If
                                        Set objCollection = Nothing
                                    Else
                                        MsgBox strComputer & " -> подключение с дополнительными полномочиями не разрешено." & vbNewLine & "Код ошибки: " & Err.Number, vbCritical, "Отчёт"
                                        Err.Clear
                                    End If
                                    Set objWMI = Nothing
                                    On Error GoTo 0
                                Else
                                    MsgBox strComputer & " -> операция отменена", vbInformation, "Отчёт"
                                End If
                            Case 2
                                intStatus = -1
                                strTemp = Off_Reboot(strComputer, intStatus, False)
                                If Len(strTemp) > 0 Then
                                    If intStatus = 0 Then
                                        MsgBox strComputer & " -> команда на выключение/перезагрузку послана успешно", vbInformation, "Отчёт"
                                    Else
                                        MsgBox strComputer & " -> команда на выключение/перезагрузку отклонена", vbExclamation, "Отчёт"
                                    End If
                                Else
                                    MsgBox strComputer & " -> операция выключения/перезагрузки отменена", vbInformation, "Отчёт"
                                End If
                            Case Else
                                If MsgBox(strComputer & " -> возникли ошибки при обращении к компьютеру." & vbNewLine & _
                                    "Попытаться его выключить или перезагрузить?", vbYesNo + vbQuestion, "Выбор продолжения") = vbYes Then
                                    intStatus = -1
                                    strTemp = Off_Reboot(strComputer, intStatus, True)
                                    If Len(strTemp) > 0 Then
                                        If intStatus = 0 Then
                                            MsgBox strComputer & " -> команда на выключение/перезагрузку послана успешно", vbInformation, "Отчёт"
                                        Else
                                            MsgBox strComputer & " -> команда на выключение/перезагрузку отклонена", vbExclamation, "Отчёт"
                                        End If
                                    Else
                                        MsgBox strComputer & " -> операция выключения/перезагрузки отменена", vbInformation, "Отчёт"
                                    End If
                                Else
                                    MsgBox strComputer & " -> операция выключения/перезагрузки отменена", vbInformation, "Отчёт"
                                End If
                        End Select
                    Else
                        MsgBox strComputer & " -> компьютер не отвечает", vbExclamation, "Отчёт"
                    End If
                Else
                    MsgBox strComputer & " -> доступ запрещён", vbExclamation, "Отчёт"
                End If
            Else
                MsgBox strComputer & " -> доступ невозможен, т.к. тип ОС не определён", vbExclamation, "Отчёт"
            End If
        End If
    Else
        MsgBox strComputer & " -> неверное имя компьютера", vbCritical, "Отчёт"
    End If
End If
WScript.Quit 0

'======

Function Logged_Session(strWS, intStat)
Dim objWMI, objCollection, objItem, strName

On Error Resume Next
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strWS & "\root\cimv2")
If Err.Number = 0 Then
    Set objCollection = objWMI.ExecQuery("SELECT UserName FROM Win32_ComputerSystem")
    If Err.Number = 0 Then
        For Each objItem In objCollection
            If Err.Number = 0 Then
                strName = objItem.UserName
                If IsNull(strName) Then
                    strName = "сеанс не обнаружен"
                    intStat = 2
                Else
                    intStat = 0
                End If
            Else
                Err.Clear
                strName = "неидентифицированный сеанс"
                intStat = 1
            End If
        Next
        Set objItem = Nothing
    Else
        Err.Clear
        strName = "не удалось выполнить запрос"
        intStat = -1
    End If
    Set objCollection = Nothing
Else
    Err.Clear
    strName = "подключение не разрешено"
    intStat = -1
End If
Set objWMI = Nothing
On Error GoTo 0
Logged_Session = strName
End Function

'======

Function Off_Reboot(strWS, intRes, blnForce)
Dim objCollection, objItem
Dim xAnswer, intTemp, strTemp

If blnForce Then
    xAnswer = MsgBox("Выключить или перезагрузить?" & vbNewLine & vbNewLine & "ДА - выключить;" & vbNewLine & "НЕТ - перезагрузить.", vbYesNo + vbQuestion, "Выбор продолжения")
Else
    xAnswer = MsgBox("Выключить или перезагрузить?" & vbNewLine & vbNewLine & "ДА - выключить;" & vbNewLine & "НЕТ - перезагрузить;" & vbNewLine & "ОТМЕНА - отказ от продолжения работы.", vbYesNoCancel + vbQuestion, "Выбор продолжения")
End If
Select Case xAnswer
    Case vbYes: intTemp = 8
    Case vbNo: intTemp = 6
    Case Else: intTemp = -1
End Select
strTemp = vbNullString
If intTemp > 0 Then
    On Error Resume Next
    Set objCollection = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown,RemoteShutdown)}!\\" & strWS & "\root\cimv2").InstancesOf("Win32_OperatingSystem")
    If Err.Number = 0 Then
        If intTemp = 6 Then
            For Each objItem In objCollection
                intRes = objItem.Win32Shutdown(intTemp)
                If Err.Number <> 0 Then
                    intRes = Err.Number
                    Err.Clear
                    strTemp = strWS & " -> при попытке выполнить операцию возникла ошибка с кодом: " & intRes
                End If
            Next
            If intRes = 0 Then
                strTemp = strWS & " -> операция выполнена."
            Else
                If Len(strTemp) = 0 Then strTemp = strWS & " -> операция не выполнена. Код ошибки: " & intRes
            End If
        Else
            For Each objItem In objCollection
                intRes = objItem.Shutdown
                If Err.Number <> 0 Then
                    intRes = Err.Number
                    Err.Clear
                    strTemp = strWS & " -> при попытке выполнить операцию возникла ошибка с кодом: " & intRes
                End If
            Next
            If intRes = 0 Then
                strTemp = strWS & " -> операция выполнена."
            Else
                If Len(strTemp) = 0 Then strTemp = strWS & " -> операция не выполнена. Код ошибки: " & intRes
            End If
        End If
        Set objItem = Nothing
    Else
        intRes = Err.Number
        Err.Clear
        strTemp = strWS & " -> при попытке выполнить операцию возникла ошибка с кодом: " & intRes
    End If
    Set objCollection = Nothing
    On Error GoTo 0
End If
Off_Reboot = strTemp
End Function

'======

Function Available(strWS)
Dim objWMI, objItem

Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("SELECT StatusCode FROM Win32_PingStatus WHERE Address='" & strWS & "'")
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

Сценарий для домена. Ориентирован на управление станциями с ОС XP/Vista/7, но может работать и с 2003/2008(R2). Можно также использовать и для 2000(Pro/Srv), но там процедура идентификации сеанса может давать недостоверный результат (нужны дополнительные проверки).
Для управления станций с серверными версиями ОС и с 2000 в алгоритм надо внести некоторые изменения.
Не проверялся на 8/2012.