Don't know HOW useful this is to anyone, but this HTA allows you to Shutdown, restart or log off users.
All have a "Force" option that will automatically End all running applications For the Restart and Shutdown you can specify a shutdown delay and comment to be shown to the user.
This has only been tested with IE7 on a WIN XP system SP3
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<!--
'********************************************************************
'* File: PC Power Manager.hta
'* Author: Justin Thomas
'* Created: Oct 2009
'* Modified: Oct 2009
'* Nov 2009
'* Dec 2009
'* Version: 2.8
'********************************************************************
-->
<head>
<title>PC Power Manager</title>
<HTA:APPLICATION
applicationName = "PC Power Manager"
singleInstance = "yes"
showInTaskbar = "yes"
border = "thin"
scroll = "no"
maximizeButton = "no"
contextMenu = "no"
version = "2.8"
>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<style>
body{
background-color: buttonface;
}
p{
text-align: right;
}
button{
clear: both;
}
span{
font-size: 18pt;
}
#left{
float: left;
width: 200px;
}
#right{
float: right;
width: 225px;
}
</style>
<SCRIPT LANGUAGE="vbScript">
OPTION EXPLICIT
Const READ_ONLY = 1
Const LOG_OFF = 0
Const FORCE_LOGOFF = 4
Sub Window_OnLoad()
Call CenterWindow(500, 475)
Call CreateDelay(30)
Call ChangeState
pcList.Focus()
End Sub 'End Window_OnLoad()
Sub CenterWindow(intWidth, intHeight)
self.ResizeTo intWidth, intHeight
self.MoveTo (screen.Width - intWidth)/2, (screen.Height - intHeight)/2
End Sub 'End CenterWindow(intWidth, intHeight)
Sub CreateDelay(intMaxTime)
Dim i
For i=5 to intMaxTime
Dim objOption : Set objOption = Document.CreateElement("option")
objOption.value = "-t " & i
objOption.Text = i
sel_Delay.Add(objOption)
Next
End Sub 'End GetDelay()
Function CreateCmd()
If Document.GetElementByID("logoff").Checked = True Then
strNewCmd = ""
Else
Dim objTask
Dim strNewCmd : strNewCmd = "shutdown.exe "
Dim arrTasks : Set arrTasks = Document.GetElementsByName("rad_shutdownOpt")
For each objTask In arrTasks
If objTask.Checked Then
strNewCmd = strNewCmd & objTask.Value
End If
Next
If Document.GetElementByID("chk_Force").Checked Then
strNewCmd = strNewCmd & Document.GetElementByID("chk_Force").Value
End If
strNewCmd = strNewCmd & Document.GetElementByID("sel_Delay").Value
If Document.GetElementByID("txt_Message").Value = "" Then
strNewCmd = strNewCmd & " -c " & chr(34) & "This is a planned event." & chr(34)
Else
strNewCmd = strNewCmd & " -c " & chr(34) & Document.GetElementByID("txt_Message").Value & chr(34)
End If
Set arrTasks = Nothing
End If
CreateCmd = strNewCmd
End Function 'End CreateCmd()
Sub Execute_OnClick()
Dim strComputer, intProcessID
Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
Dim strCommand : strCommand = CreateCmd()
Dim arrComputers : arrComputers = Split(pcList.Value, vbCrLf)
txt_Results.Value = ""
If UBound(arrComputers) < 0 Then
Msgbox "At least one remote PC required!", vbApplicationModal & vbExclamation, "Remote PC's - Error"
pcList.Focus()
Else
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each strComputer In arrComputers
If UCase(strComputer) = UCase(objNetwork.ComputerName) Then
txt_Results.Value = UCase(strComputer) & " is the localhost, command aborted" & vbCrLf & txt_Results.Value
Else
Dim blnExecuteNext : blnExecuteNext = ValidatePC(strComputer)
If blnExecuteNext = True Then
Dim objWMI : Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer & "\root\cimv2")
On Error Resume Next
If Not(objFSO.FolderExists("\\" & strComputer & " \C$\Documents and Settings\" & objNetwork.UserName)) Then
objFSO.CreateFolder "\\" & strComputer & " \C$\Documents and Settings\" & objNetwork.UserName
End If
If strCommand <> "" Then
Dim objProcess : Set objProcess = objWMI.Get("Win32_Process")
objProcess.Create strCommand, Null, , intProcessID
Select Case Err.Number
Case "0"
txt_Results.Value = UCase(strComputer) & " successfully created shutdown process" & vbCrLf & txt_Results.Value
Case "2"
txt_Results.Value = UCase(strComputer) & " denied access to create proccess" & vbCrLf & txt_Results.Value
Case "3"
txt_Results.Value = "You do not have sufficient privileges to create processes on " & Ucase(strComputer) & vbCrLf & txt_Results.Value
Case "9"
txt_Results.Value = UCase(strComputer) & " could not find the specificed execution path" & vbCrLf & txt_Results.Value
Case "21"
txt_Results.Value = UCase(strComputer) & " was passed and invalid parameter" & vbCrLf & txt_Results.Value
Case Else
txt_Results.Value = "An unknown error has occured on " & UCase(strComputer) & vbCrLf & txt_Results.Value
End Select
Set objProcess = Nothing
Else
Dim objOSItem
Dim colOS : Set colOS = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each objOSItem In colOS
Select Case Document.GetElementByID("chk_Force").Checked
Case "True"
objOSItem.Win32Shutdown FORCE_LOGOFF
Case Else
objOSItem.Win32Shutdown LOG_OFF
End Select
Select Case Err.Number
Case "0"
txt_Results.Value = UCase(strComputer) & " successfully created shutdown process" & vbCrLf & txt_Results.Value
Case Else
txt_Results.Value = "An unknown error has occured on " & UCase(strComputer) & vbCrLf & txt_Results.Value
End Select
Next
Set objOSItem = Nothing
Set colOS = Nothing
End If 'End Shutdown Opt Check
End If 'End ValidatePC Check
End If 'End localhost Check
On Error Resume Next
objFSO.DeleteFolder "\\" & strComputer & " \C$\Documents and Settings\" & objNetwork.UserName, True
Next
Set objFSO = Nothing
Set objWMI = Nothing
Set objNetwork = Nothing
Err.Clear
End If
End Sub 'End Execute_OnClick()
Function ValidatePC(strComputer)
If strComputer = "" Then
ValidatePC = False
Exit Function
End If
ON ERROR RESUME NEXT
Dim colPing : Set colPing = GetObject("winmgmts:\\").ExecQuery("Select * from Win32_PingStatus where Address='" & strComputer & "'")
Dim objPingStatus
For Each objPingStatus in colPing
If objPingStatus.StatusCode = 0 Then
If IsNull(GetObject("winmgmts:\\" & strComputer & "\root\cimv2")) Then
txt_Results.Value = UCase(strComputer) & " denied access to WMI." & vbCrLf & txt_Results.Value
ValidatePC = False
Else
ValidatePC = True
End If
Else
txt_Results.Value = UCase(strComputer) & " did not respond to ping requests" & vbCrLf & txt_Results.Value
ValidatePC = False
End If
Next
Set objPingStatus = Nothing
Set colPing = Nothing
End Function 'End ValidatePC(strComputer)
Sub LoadFile_OnClick()
Dim objDialog : Set objDialog = CreateObject("UserAccounts.CommonDialog")
With objDialog
.Filter = "Text Files (*.txt)|*.txt"
.FilterIndex = 1
.InitialDir = "C:\"
End With
objDialog.ShowOpen
If objDialog.FileName <> "" Then
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(objDialog.FileName) Then
Dim objFile : Set objFile = objFSO.OpenTextFile(objDialog.FileName, READ_ONLY)
pcList.Value = ""
Do Until objFile.AtEndOfStream
Dim strLine : strLine = TRIM(objFile.ReadLine)
pcList.Value = pcList.Value & strLine & vbCrLf
Loop
Else
Msgbox objDialog.FileName & " not found!", vbApplicationModal & vbCritical,"Open File - Error"
End If
End If
Set objFile = Nothing
Set objFSO = Nothing
Set objDialog = Nothing
End Sub 'End GetFile_OnClick()
Sub ChangeState()
If Document.GetElementByID("logoff").Checked = True Then
Document.GetElementByID("sel_Delay").Disabled = True
Document.GetElementByID("txt_Message").Disabled = True
Else
Document.GetElementByID("sel_Delay").Disabled = False
Document.GetElementByID("txt_Message").Disabled = False
End If
End Sub 'End ChangeState()
Sub Exit_OnClick()
self.Close()
End Sub 'End CloseApplication()
</SCRIPT>
</head>
<body>
<div id="left">
Remote PC(s):
<br>
<textarea id="pcList" rows="17" cols="25"></textarea>
<br>
</div>
<div id="right">
<fieldset>
<legend>Task</legend>
<input type="radio" name="rad_shutdownOpt" id="logoff" checked onClick="ChangeState"/>Logoff<br>
<input type="radio" name="rad_shutdownOpt" value="-r " onClick="ChangeState"/>Restart<br>
<input type="radio" name="rad_shutdownOpt" value="-s " onClick="ChangeState"/>Shutdown<br>
<br>
<input type="checkbox" id="chk_force" value="-f " />Force
</fieldset>
<br>
<fieldset>
<legend>Delay</legend>
<select id="sel_Delay"></select>Second(s)
</fieldset>
<br>
<fieldset>
<legend>Display Message</legend>
<textarea id="txt_Message" rows="4" cols="24" ></textarea>
</fieldset>
</div>
<p>
<button name="LoadFile" accesskey="l"><u>L</u>oad File...</button> 
<button name="Execute" accesskey="e"><u>E</u>xecute</button> 
<button name="Exit" accesskey="x">E<u>x</u>it</button> 
</p>
<textarea id="txt_Results" cols="56" READONLY></textarea>
</body>
</html> Any suggestions to make it better or more efficient are welcome!
EDIT://Edited as requested below - DM
EDIT: Edited as requested below - Mbouchard
<message edited by mbouchard on Friday, December 18, 2009 1:55 AM>