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.
|
