I use Marimba and do not like their Reboot option. Essentailly if your application requires a Reboot, a screen pops with a Yes/No option.

I want to create my own Reboot message similiar to what WSUS has, in which a dialog box pops up and gives you options to reboot now or 1-4 hours later. If it has no response, then it reboots automatically after a set time I set.

Does anybody know if there is something out there like that I could use and modify to my needs. Thanks.
0 Comments   [ + ] Show Comments

Comments

Please log in to comment

Rating comments in this legacy AppDeploy message board thread won't reorder them,
so that the conversation will remain readable.

Answers

0
Here's an HTA I built in a rush for a client recently. You can obviously edit the various bits and bobs (e.g. the timeout and logo picture file) to suit yourself. The flow is a little convulted, but that's because I pressed working routines into service and used another working script as a shell. Anyway, knock yourself out...<!DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd>
<HTML xmlns:yCode>
<TITLE>Scheduled shutdown</TITLE>

<HTA:APPLICATION
ID = "DoShutdown"
APPLICATIONNAME = "DoShutdown"
BORDER = "None"
BORDERSTYLE = "Normal"
CAPTION = "Yes"
CONTEXTMENU = "No"
INNERBORDER = "Yes"
MAXIMIZEBUTTON = "No"
MINIMIZEBUTTON = "No"
NAVIGABLE = "No"
SCROLL = "No"
SCROLLFLAT = "Yes"
SELECTION = "No"
SHOWINTASKBAR = "No"
SINGLEINSTANCE = "Yes"
SYSMENU = "No"
>
<HEAD>
<STYLE>
HTML, BODY
{
margin: 0;
padding: 0;
line-height: 1.5em;
font-size: 87%;
font-family: Verdana, Arial, Helvetica, sans-serif;
}

#top_body
{
clear: both;
margin: 20px 0 0 0;
text-align: center;
}

#top_body p
{
margin: 20px 0 0 0;
font-style: italic;
}

H1
{
color:#FF0000;
font-weight: bold;
text-transform: uppercase;
font-family: "Arial Narrow", Arial, Helvetica, sans-serif;
font-size: 3em; margin: 0 15px 0 0;
letter-spacing: -.05em;
}

H2
{
color: #4e4a4e;
font-weight: bold;
font-size: 1.4em;
margin: 15px 0 0 0;
}

INPUT
{
font-family: tahoma;
font-size: 18pt;
}
</STYLE>

<SCRIPT LANGUAGE="VBScript">
Public intReturn
Public objFSO
Public objWSHShell
Public objWSHShellApp
Public strArgument
Public strHTA
Public strHTAPath
Public strAppRootFolder
Public strCommandLine
Public intSlashPos
Public intHTANamePos
Public intSpacePos
Public strHours
Public strMinutes
Public strSeconds
Public datCountdownStartedTime
Public datExecutionTime
Public datCurrentTime
Public datRemainingTime
Public strCountdownStartedTime
Public strExecutionTime
Public strCurrentTime
Public strRemainingTime
Public intHours
Public intMinutes
Public intSeconds
Public intTimerID
Public strRestartType
Public strHeaderText
Public strRestartText

Const intWindowWidth = 550
Const intWindowHeight = 410

Const WMI_Shutdown_LogOff = 0
Const WMI_Shutdown_LogOffForced = 4
Const WMI_Shutdown_PowerOff = 8
Const WMI_Shutdown_PowerOffForced = 12
Const WMI_Shutdown_Reboot = 2
Const WMI_Shutdown_RebootForced = 6
Const WMI_Shutdown_Shutdown = 1
Const WMI_Shutdown_ShutdownForced = 5

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSHShell = CreateObject("WScript.Shell")
Set objWSHShellApp = CreateObject("Shell.Application")

'// Set default timeout for 5 minutes
intHours = 0
intMinutes = 5
intSeconds = 0

'// Set default shutdown type
strRestartType = "RF"
intShutdownFlag = WMI_Shutdown_RebootForced
strRestartText = "restarted"
strHeaderText = "Scheduled restart"

Sub Window_Onload
Dim blnShow
Dim blnMiniseAllOpenWindows
Dim objFileHTA
Dim blnResult_Window
Dim intCountColon
Dim intCountSpace

strCommandLine = Trim(DoShutdown.CommandLine)
blnMiniseAllOpenWindows = True

'// Ditch the stupid quotes which MS has decreed will surround the name
'// even when there are no spaces in ANY folder name!
strCommandLine = Replace(strCommandLine, Chr(34), "")

'// Bizarrely, if an argument is passed to an HTA and we remove the quote marks,
'// we get an extra space character!
If InStr(strCommandLine, " ") > 0 Then
strCommandLine = Replace(strCommandLine, " ", " ")
End If

'// Whatever happens, the command line will have a backslash in it
intSlashPos = InStrRev(strCommandLine, "\")
intHTANamePos = InStr(UCase(strCommandLine), ".HTA")
intSpacePos = InStr(UCase(strCommandLine), " ")

If intHTANamePos < intSpacePos Then
'// The HTA was launched with argument(s). How many?
Call ParseArguments
Else
Set objFileHTA = objFSO.GetFile(strCommandLine)
strHTA = objFileHTA.Name
Set objFileHTA = Nothing
End If

Set objFileHTA = objFSO.GetFile(strHTA)
strHTA = objFileHTA.Name
strHTAPath = objFileHTA.ParentFolder.Path

Call ResizeWindow(intWindowWidth, intWindowHeight, blnShow)
Call CentreWindow(intWindowWidth, intWindowHeight, blnShow)

spanHeader.InnerText = strHeaderText
spanRestartText.InnerText = strRestartText
spanCountdownStartedPrompt.InnerText = "Countdown Started:"
spanExecutionTimePrompt.InnerText = "Execution Time:"
spanCurrentTimePrompt.InnerText = "Current Time:"
spanRemainingTimePrompt.InnerText = "Remaining Time:"

Call CalculateTimeout
Call CheckCountdown(blnMiniseAllOpenWindows, intHours,intMinutes,intSeconds)
End Sub

Sub ParseArguments
Dim blnResult_Parse
Dim intCountColon
Dim intCountSpace
Dim strArgument1
Dim strArgument2

strArgument = ""
strArgument1 = ""
strArgument2 = ""

blnResult_Window = GetSubstringCount(Chr(32), strCommandLine, True, intCountSpace)

If intCountSpace = 0 Then
strHTA = strCommandLine
Exit Sub
ElseIf intCountSpace = 1 Then
strHTA = Split(strCommandLine, Chr(32))(0)
strArgument1 = Split(strCommandLine, Chr(32))(1)
ElseIf intCountSpace = 2 Then
strHTA = Split(strCommandLine, Chr(32))(0)
strArgument1 = Split(strCommandLine, Chr(32))(1)
strArgument2 = Split(strCommandLine, Chr(32))(2)
Else
'// Twat...
End If

If InStr(strArgument1, ":") > 0 Then
blnResult_Parse = GetSubstringCount(":", strArgument1, True, intCountColon)

If (intCountColon > 2) Or (intCountColon < 1) Then
'// Twat...
Else
strHours = Split(strArgument1, ":")(0)
strMinutes = Split(strArgument1, ":")(1)
strSeconds = Split(strArgument1, ":")(2)
End If
End If

If Len(strArgument2) > 0 Then
Select Case strArgument2
Case "L"
intShutdownFlag = WMI_Shutdown_LogOff
strHeaderText = "Scheduled log-off"
strRestartText = "logged off"
Case "LF"
intShutdownFlag = WMI_Shutdown_LogOffForced
strHeaderText = "Scheduled log-off"
strRestartText = "forcibly logged off"
Case "P"
strHeaderText = "Scheduled power-off"
intShutdownFlag = WMI_Shutdown_PowerOff
strRestartText = "powered off"
Case "PF"
strHeaderText = "Scheduled power-off"
intShutdownFlag = WMI_Shutdown_PowerOffForced
strRestartText = "forcibly powered off"
Case "R"
strHeaderText = "Scheduled restart"
intShutdownFlag = WMI_Shutdown_Reboot
strRestartText = "restarted"
Case "RF"
strHeaderText = "Scheduled restart"
intShutdownFlag = WMI_Shutdown_RebootForced
strRestartText = "forcibly restarted"
Case "S"
intShutdownFlag = WMI_Shutdown_Shutdown
strHeaderText = "Scheduled shut-down"
strRestartText = "shut down"
Case "SF"
strHeaderText = "Scheduled shut-down"
intShutdownFlag = WMI_Shutdown_ShutdownForced
strRestartText = "forcibly shut down"
End Select
End If
End Sub

Sub CalculateTimeout()
If Len(strHours) > 1 Then
If Left(strHours, 1) = "0" Then
strHours = Right(strHours, 1)
End If
End If
intHours = CInt(strHours)

If Len(strMinutes) > 1 Then
If Left(strMinutes, 1) = "0" Then
strMinutes = Right(strMinutes, 1)
End If
End If
intMinutes = CInt(strMinutes)

If Len(strSeconds) > 1 Then
If Left(strSeconds, 1) = "0" Then
strSeconds = Right(strSeconds, 1)
End If
End If
intSeconds = CInt(strSeconds)
End Sub

Sub CheckCountdown(ByVal blnMinise, ByVal intInHours, ByVal intInMinutes, ByVal intInSeconds)
Dim intHoursToExecutionTime
Dim intMinutesToExecutionTime
Dim intSecondsToExecutionTime

If blnMinise Then
'// Minimise all open windows, to make ours stand out
objWSHShellApp.MinimizeAll
End If

datCountdownStartedTime = Now()

intHoursToExecutionTime = 0
intMinutesToExecutionTime = 0
intSecondsToExecutionTime = 0

If intInHours =0 And intInMinutes = 0 And intInSeconds = 0 Then
intSecondsToExecutionTime = 2
Else
If intInHours > 0 Then
intHoursToExecutionTime = intInHours
End If

If intInMinutes > 0 Then
intMinutesToExecutionTime= (intHoursToExecutionTime * 60) + intInMinutes
End If

intSecondsToExecutionTime = (intMinutesToExecutionTime * 60) + intInSeconds
End If

datExecutionTime = DateAdd("s",intSecondsToExecutionTime, datCountdownStartedTime)

intTimerID = window.setInterval("DoCountdown()", 1000)

End Sub

Sub DoCountdown()

strCountdownStartedTime = DatePart("h", datCountdownStartedTime) & ":"
strCountdownStartedTime = strCountdownStartedTime & Right("00" & DatePart("n", datCountdownStartedTime), 2) & ":"
strCountdownStartedTime = strCountdownStartedTime & Right("00" & DatePart("s", datCountdownStartedTime), 2)

strExecutionTime = DatePart("h", datExecutionTime) & ":"
strExecutionTime = strExecutionTime & Right("00" & DatePart("n", datExecutionTime), 2) & ":"
strExecutionTime = strExecutionTime & Right("00" & DatePart("S", datExecutionTime), 2)

strCurrentTime = DatePart("h", Now()) & ":"
strCurrentTime = strCurrentTime & Right("00" & DatePart("n", Now()), 2) & ":"
strCurrentTime = strCurrentTime & Right("00" & DatePart("s", Now()), 2)

blnResult = CalculateTimeSpan(Now(), datExecutionTime, strRemainingTime)

spanCountdownStarted.InnerText = strCountdownStartedTime
spanExecutionTime.InnerText = strExecutionTime
spanCurrentTime.InnerText = strCurrentTime
spanRemainingTime.InnerText = strRemainingTime

If strRemainingTime = "00:00:00" Then
Call ClearCountdown
Shutdown(intShutdownFlag)
End If
End Sub

Function CalculateTimeSpan(ByVal datFirst, ByVal datSecond, ByRef strTimeSpan)
Dim strSpanHours
Dim strSpanstrSpanMinutes
Dim strSpanSeconds

If (IsDate(datFirst) And IsDate(datSecond)) = False Then
strTimeSpan = "00:00:00"
Exit Function
End If

strSpanSeconds = Abs(DateDiff("S", datFirst, datSecond))
strSpanMinutes = strSpanSeconds \ 60
strSpanHours = strSpanMinutes \ 60
strSpanMinutes = strSpanMinutes mod 60
strSpanSeconds = strSpanSeconds mod 60

If Len(strSpanHours) = 1 Then
strSpanHours = "0" & strSpanHours
End If

strTimeSpan = strSpanHours & ":" & Right("00" & strSpanMinutes, 2) & ":" & Right("00" & strSpanSeconds, 2)
End Function

Sub ClearCountdown
'// Because of most browser's idiotic behaviour with empty table cells,
'// we populate them with spaces

Dim strSpaces

strSpaces = String(4, " ")
spanCountdownStarted.InnerText = strSpaces
spanExecutionTime.InnerText = strSpaces
spanCurrentTime.InnerText = strSpaces
spanRemainingTime.InnerText = strSpaces

window.clearInterval(intTimerID)
End Sub

Sub Shutdown(ByVal intShutdownFlag)
Dim objWMIService

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown )}").InstancesOf("Win32_OperatingSystem")

For Each objSystem In objWMIService
objSystem.Win32Shutdown intShutdownFlag
Next

Set objWMIService = Nothing
End Sub

Sub DoCancel
Window.Close
End Sub

Sub btnQuit_onClick
Call ExitScript
End Sub

Sub ExitScript
'// So that no-one knows we've been, reset the Custom Zone
'objWshShell.RegWrite strIEAccessDataAcrossDomainsLocalRegKey, 1, "REG_DWORD"
'If Err.Number <> 0 Then
' strMsg = "Unable to write IE Security registry value."
' MsgBox strMsg, vbOKonly + vbCritical
'End If

self.Close
End Sub

Sub HandleKeys
Select Case window.event.keycode
Case 13
Call btnExecute_onClick
Case 27
Call btnQuit_onClick
End Select
End Sub

Sub GetScreenSize(ByRef intHorizontal, ByRef intVertical)
Dim strComputer
Dim objWMIService_GSS
Dim colItems
Dim objItem

strComputer = "."

Set objWMIService_GSS = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService_GSS.ExecQuery("Select * From Win32_DesktopMonitor")

For Each objItem In colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Exit For
Next

Set colItems = Nothing
Set objWMIService_GSS = Nothing
End Sub

Sub ResizeWindow(ByVal intWidth, ByVal intHeight, ByVal blnShowMsg)
Dim intH
Dim intV
Dim objMessageAreaResize

With Window
If blnShowMsg Then
Set objMessageAreaResize = .document.getElementById("HeaderArea")
objMessageAreaResize.InnerHTML = "Resizing window"
Set objMessageAreaResize = Nothing
End If

.resizeTo intWidth,intHeight
End With
End Sub

Sub CentreWindow(ByVal intWidth, ByVal intHeight, ByVal blnShowMsg)
Dim intH
Dim intV
Dim intLeft
Dim intTop
Dim objMessageAreaCentre

Call GetScreenSize(intH, intV)

intLeft = (intH - intWidth) / 2
intTop = (intV - intHeight) / 2

With Window
If blnShowMsg Then
Set objMessageAreaCentre = .document.getElementById("HeaderArea")
objMessageAreaCentre.InnerHTML = "Centering window"
Set objMessageAreaCentre = Nothing
End If

.moveTo intLeft, intTop
End With
End Sub

'// =========================================================================================================
'// Name: GetSubstringCount
'// Purpose: Determines how many times one string occurs in another string
'// Input: strToLookFor - the string to look for
'// strSearch - the string to look in
'// blnIgnoreCase - If True, ignore case of both strings
'// Output: intStringCount - a 'ByRef' variable which will contain the number of occurrences
'// Returns: True/False
'// =========================================================================================================
Function GetSubstringCount(ByVal strToLookFor, ByVal strSearch, ByVal blnIgnoreCase, ByRef intStringCount)
'// Since VBS doesn't provide a string counter (i.e. how many times a string occurs in another string)
'// we hack it using Split: the UBound of the array will tell us how many occurrences there are, if any

'// Assume the worst
intStringCount = 0
GetSubstringCount = False

If Len(strToLookFor) = 0 Then
strMsg = "A parameter, 'strToLookFor', passed to " & strScriptName & ".GetSubstringCount is empty."
'errStatus = MsgUsr(strMsg, intButtonType, strScriptName & ".GetSubstringCount", intButtonPressed)
Exit Function
End If

If Len(strSearch) = 0 Then
strMsg = "A parameter, 'strSearch', passed to " & strScriptName & ".GetSubstringCount is empty."
'errStatus = MsgUsr(strMsg, intButtonType, strScriptName & ".GetSubstringCount", intButtonPressed)
Exit Function
End If

If blnIgnoreCase Then
intStringCount = UBound(Split(strSearch, strToLookFor))
Else
intStringCount = UBound(Split(UCase(strSearch), UCase(strToLookFor)))
End If

GetSubstringCount = True

End Function

'//=========================================================================================================
'// Name: StringMatch
'// Purpose: Checks if two strings match
'// Why not use 'If strFirst = strSecond', you're asking?
'// Well, the 'Equals' operator :
'// - is not very fast (at string comparison)!
'// - compares strings left to right and is smart enough to stop comparing when it spots the first difference, but
'// - is too dumb to first do the most obvious test: comparing the lengths of the strings!
'// Input: strFirst - the first string
'// strSecond - the second string
'// blnMatch - a Boolean indicating whether or not the strings matched
'// Output: None
'// Returns: True/False
'//
'//=========================================================================================================
Function StringMatch(ByVal strFirst, ByVal strSecond, ByRef blnMatch)

StringMatch = True

blnMatch = False

If LenB(strFirst) = LenB(strSecond) Then
blnMatch = (InStrB(1, strFirst, strSecond, vbBinaryCompare) <> 0)
End If

End Function

</SCRIPT>
</HEAD>

<BODY onKeyPress='HandleKeys()'>
<DIV ID="pagewidth1">
<DIV ID="top_body">
<P><IMG SRC="lvlogo.gif" /></p>
<P>&nbsp;</P>
<H1><SPAN ID=spanHeader></SPAN></H1>
<P>&nbsp;</P>
</DIV>
</DIV>

<P ALIGN="center">
This computer is scheduled to be <SPAN ID='spanRestartText'></SPAN>.<BR>Please click the 'Cancel' button if you wish to continue using it.
</P>

<TABLE WIDTH='98%' BORDER=0>
<TR>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanCountdownStartedPrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanCountdownStarted'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='5%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanExecutionTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanExecutionTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>

<TR>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanCurrentTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanCurrentTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='5%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanRemainingTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanRemainingTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>
</TABLE>

<TABLE WIDTH='98%' BORDER=0>
<TR>
<TD>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>

<TR>
<TD ALIGN='CENTER'>
<FONT SIZE="2">
<INPUT ACCESSKEY='Q' CLASS="button" TYPE="button" VALUE="Cancel" ID='btnQuit' NAME='btnQuit'>
</FONT>
</TD>
</TR>
</TABLE>
</BODY>
</HTML>
Answered 07/08/2010 by: VBScab
Red Belt

Please log in to comment
0
I guess the only way to do via Marimba is to use a Customization. And i also guess that you dont want this message appearing after every single install (ie, those which dont require a reboot). So from that, you'd need to capture the return code and handle it from there. Here's a rough script which you can hack around with. You might even want to merge parts of it into VBScabs HTA above, especially if you wanted to use dropdowns to specify hours of delay etc.

Dim installerReturnCode, rebootPCReturn
Dim rebootMsg : rebootMsg = "Would you like to reboot now? (Selecting 'No' will remind you in 1 hour)"

Set WshShell = WScript.CreateObject("WScript.Shell")

installerReturnCode = WshShell.Run("msiexec.exe /i whatever.msi /qb!", 0, True)
'3010 = reboot requested

If installerReturnCode = "3010" Then
rebootPCReturn = MsgBox(rebootMsg, 4 + 32)
Do While rebootPCReturn <> 6
'sleep for an Hour
WScript.Sleep(3600000)
rebootPCReturn = MsgBox(rebootMsg, 4 + 32)
Loop
'finally, user has decided to reboot
If rebootPCReturn = 6 Then
WshShell.Run "shutdown.exe /r /t 10 /c "" This system will automatically restart in a moment..."" /f /d p:4:1", 0, False
End If
End If

Set WshShell = Nothing
Answered 07/08/2010 by: captain_planet
Second Degree Brown Belt

Please log in to comment
0
Oh, and make sure you check the box in the customization which says 'Run script as detached process' otherwise the install will never end....unless you reboot!

In my opinion, it's all just overkill. Give me a simple yes/no box any day. No extra processes running in the background, and no pop-up reminders that do my head in. I hate things reminding me to reboot. But then again that's just my opinion. If i click 'no' and i try running my app 4 hours later and it doesn't work because i haven't rebooted - tough. I'd been told. Mind you, i guess that wont stop *some* drongo's raising support calls.....
Answered 07/08/2010 by: captain_planet
Second Degree Brown Belt

Please log in to comment
0
Thank you very much to both of you. I will look through these scripts and try to get it to work with Marimba.

The thing that is strange with Marimba and which I do not like, is they have this message box for their Patch system, but only gives a simple Yes/No box for the application side. I have not been able to get a straight answer as to why this is the case.

The problem with the Yes/No box they have is it is not customizable. There is no timeout function, so the box can just sit there forever and hangs other updates from coming down. The problem, which is useless in any case with the first issue being present, is you cannot customize the message.
Answered 07/09/2010 by: guru533
Yellow Belt

Please log in to comment
0
Here's a revised version which handles the command line a little more elegantly. The earlier one would have problems with folder names which have a space. There's also now a '/help' argument and I've separated the options from the 'force' parameter into a separate argument.<!DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd>
<HTML xmlns:yCode>
<TITLE>Scheduled shutdown</TITLE>

<HTA:APPLICATION
ID = "DoShutdown"
APPLICATIONNAME = "DoShutdown"
BORDER = "None"
BORDERSTYLE = "Normal"
CAPTION = "Yes"
CONTEXTMENU = "No"
INNERBORDER = "Yes"
MAXIMIZEBUTTON = "No"
MINIMIZEBUTTON = "No"
NAVIGABLE = "No"
SCROLL = "No"
SCROLLFLAT = "Yes"
SELECTION = "No"
SHOWINTASKBAR = "No"
SINGLEINSTANCE = "Yes"
SYSMENU = "No"
>
<HEAD>
<STYLE>
HTML, BODY
{
margin: 0;
padding: 0;
line-height: 1.5em;
font-size: 87%;
font-family: Verdana, Arial, Helvetica, sans-serif;
}

#top_body
{
clear: both;
margin: 20px 0 0 0;
text-align: center;
}

#top_body p
{
margin: 20px 0 0 0;
font-style: italic;
}

H1
{
color:#FF0000;
font-weight: bold;
text-transform: uppercase;
font-family: "Arial Narrow", Arial, Helvetica, sans-serif;
font-size: 3em; margin: 0 15px 0 0;
letter-spacing: -.05em;
}

H2
{
color: #4e4a4e;
font-weight: bold;
font-size: 1.4em;
margin: 15px 0 0 0;
}

INPUT
{
font-family: tahoma;
font-size: 18pt;
}
</STYLE>

<SCRIPT LANGUAGE="VBScript">
Public intReturn
Public objFSO
Public objWSHShell
Public objWSHShellApp
Public strDummy
Public strArgument
Public blnArgumentsAreValid
Public strHTA
Public strHTAPath
Public strAppRootFolder
Public strCommandLine
Public dicArguments
Public intSlashPos
Public intHTANamePos
Public intSpacePos
Public strHours
Public strMinutes
Public strSeconds
Public datCountdownStartedTime
Public datExecutionTime
Public datCurrentTime
Public datRemainingTime
Public strCountdownStartedTime
Public strExecutionTime
Public strCurrentTime
Public strRemainingTime
Public intHours
Public intMinutes
Public intSeconds
Public intTimerID
Public strRestartType
Public strHeaderText
Public strRestartText

Const intWindowWidth = 550
Const intWindowHeight = 410

Const WMI_Shutdown_LogOff = 0
Const WMI_Shutdown_Forced = 4
Const WMI_Shutdown_PowerOff = 8
Const WMI_Shutdown_Reboot = 2
Const WMI_Shutdown_Shutdown = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSHShell = CreateObject("WScript.Shell")
Set objWSHShellApp = CreateObject("Shell.Application")
Set dicArguments = CreateObject("Scripting.Dictionary")

dicArguments.CompareMode = vbTextcompare '// Set case insensitivity for arguments

'// Set default timeout for 5 minutes
intHours = 0
intMinutes = 5
intSeconds = 0

'// Set default shutdown type
strRestartType = "RF"
intShutdownFlag = WMI_Shutdown_RebootForced
strRestartText = "restarted"
strHeaderText = "Scheduled restart"

Sub Window_Onload
Dim blnShow
Dim blnMiniseAllOpenWindows
Dim objFileHTA
Dim blnResult_Window
Dim intCountColon
Dim intCountSpace

strCommandLine = Trim(DoShutdown.CommandLine)
blnMiniseAllOpenWindows = True

'// Ditch the stupid quotes which MS has decreed will surround the name
'// even when there are no spaces in ANY folder name!
strCommandLine = Replace(strCommandLine, Chr(34), "")

'// Bizarrely, if an argument is passed to an HTA and we remove the quote marks,
'// we get an extra space character!
If InStr(strCommandLine, " ") > 0 Then
strCommandLine = Replace(strCommandLine, " ", " ")
End If

Call ParseArguments
Call AssignAndValidateArguments

If Not blnArgumentsAreValid Then
ExitScript
End If

Call ResizeWindow(intWindowWidth, intWindowHeight, blnShow)
Call CentreWindow(intWindowWidth, intWindowHeight, blnShow)

spanHeader.InnerText = strHeaderText
spanRestartText.InnerText = strRestartText
spanCountdownStartedPrompt.InnerText = "Countdown Started:"
spanExecutionTimePrompt.InnerText = "Execution Time:"
spanCurrentTimePrompt.InnerText = "Current Time:"
spanRemainingTimePrompt.InnerText = "Remaining Time:"

Call CalculateTimeout
Call CheckCountdown(blnMiniseAllOpenWindows, intHours,intMinutes,intSeconds)
End Sub

Sub ParseArguments
Dim blnResult_Parse
Dim arrAllArguments
Dim strAllArguments
Dim arrArgument
Dim strArgument
Dim intArgumentPos

On Error Resume Next

With document
strDummy = .url
strHTA = Mid(strDummy, Len("file://" ) + 1 )
strHTAPath = objFSO.GetParentFolderName(strDummy)
End With

intArgumentPos = InStr(strCommandLine, "/")

If intArgumentPos = 0 Then
Exit Sub
End If

strAllArguments = Trim(Split(strCommandLine, strHTA)(1))
arrAllArguments = Split(strAllArguments, " ")

For Each strArgument In arrAllArguments
arrArgument = Split(strArgument, "=", 2)

'/ If value is specified multiple times, last one wins
If dicArguments.Exists(Trim(arrArgument(0))) Then
dicArguments.Remove(Trim(arrArgument(0)))
End If

If UBound(arrArgument) >= 1 Then
dicArguments.Add Trim(arrArgument(0)), Trim(arrArgument(1))
Else
dicArguments.Add Trim(arrArgument(0)),""
End If
Next

On Error Goto 0
End Sub

Sub AssignAndValidateArguments
Dim intCountColon
Dim intCountSpace
Dim strAction
Dim strCountdownTime
Dim blnForce

blnArgumentsAreValid = False

'// Check for -help, -? etc help request on command line
If (dicArguments.Count < 1) Or (dicArguments.Exists("help")) or (dicArguments.Exists("/help")) or (dicArguments.Exists("?")) or (dicArguments.Exists("/?")) Then
strDummy = "Command line switches for this application are:"
strDummy = strDummy & vbCRLF & vbCRLF
strDummy = strDummy & vbTAB & "/T=hh:mm:ss" & vbTAB & "Sets the number of hours, minutes and seconds to countdown before shutdown/restart occurs."
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & "Use hh:mm:ss format."
strDummy = strDummy & vbCRLF & vbCRLF
strDummy = strDummy & vbTAB & "/A=x" & vbTAB & vbTAB & "Sets the action to take."
strDummy = strDummy & " Valid options for 'x' are:"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & vbTAB & "L" & vbTAB & "- log the user off"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & vbTAB & "P" & vbTAB & "- power-off the machine"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & vbTAB & "R" & vbTAB & "- restart the machine"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & vbTAB & "S" & vbTAB & "- shutdown the machine"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & "/F" & vbTAB & vbTAB & "Forces the action."
strDummy = strDummy & vbCRLF

MsgBox strDummy,vbOKOnly
Exit Sub
End If

strAction = dicArguments("/A")
strCountdownTime = dicArguments("/T")
If dicArguments.Exists("/F") Then
blnForce = True
End If

'// Validate dependencies
If strAction = "" Then
strDummy = "You must specify the '/A' argument."
' MsgBox strDummy,vbOKOnly
' Exit Sub

'// As a default, let's set a restart
strHeaderText = "Scheduled restart"
intShutdownFlag = WMI_Shutdown_Reboot
strRestartText = "restarted"
Else
Select Case strAction
Case "L"
strHeaderText = "Scheduled log-off"
intShutdownFlag = WMI_Shutdown_LogOff
strRestartText = "logged off"
Case "P"
strHeaderText = "Scheduled power-off"
intShutdownFlag = WMI_Shutdown_PowerOff
strRestartText = "powered off"
Case "R"
strHeaderText = "Scheduled restart"
intShutdownFlag = WMI_Shutdown_Reboot
strRestartText = "restarted"
Case "S"
strHeaderText = "Scheduled shut-down"
intShutdownFlag = WMI_Shutdown_Shutdown
strRestartText = "shut down"
End Select

If blnForce Then
intShutdownFlag = intShutdownFlag & WMI_Shutdown_Forced
strRestartText = "forcibly " & strRestartText
End If
End If

If Len(strCountdownTime) > 0 Then
If InStr(strCountdownTime, ":") > 0 Then
blnResult_Parse = GetSubstringCount(":", strCountdownTime, True, intCountColon)

If (intCountColon > 2) Or (intCountColon < 1) Then
'// Twat...
Else
strHours = Split(strCountdownTime, ":")(0)
strMinutes = Split(strCountdownTime, ":")(1)
strSeconds = Split(strCountdownTime, ":")(2)
End If
End If
End If

blnArgumentsAreValid = True
End Sub

Sub CalculateTimeout()
If Len(strHours) > 1 Then
If Left(strHours, 1) = "0" Then
strHours = Right(strHours, 1)
End If
End If
intHours = CInt(strHours)

If Len(strMinutes) > 1 Then
If Left(strMinutes, 1) = "0" Then
strMinutes = Right(strMinutes, 1)
End If
End If
intMinutes = CInt(strMinutes)

If Len(strSeconds) > 1 Then
If Left(strSeconds, 1) = "0" Then
strSeconds = Right(strSeconds, 1)
End If
End If
intSeconds = CInt(strSeconds)
End Sub

Sub CheckCountdown(ByVal blnMinise, ByVal intInHours, ByVal intInMinutes, ByVal intInSeconds)
Dim intHoursToExecutionTime
Dim intMinutesToExecutionTime
Dim intSecondsToExecutionTime

If blnMinise Then
'// Minimise all open windows, to make ours stand out
objWSHShellApp.MinimizeAll
End If

datCountdownStartedTime = Now()

intHoursToExecutionTime = 0
intMinutesToExecutionTime = 0
intSecondsToExecutionTime = 0

If intInHours =0 And intInMinutes = 0 And intInSeconds = 0 Then
intSecondsToExecutionTime = 2
Else
If intInHours > 0 Then
intHoursToExecutionTime = intInHours
End If

If intInMinutes > 0 Then
intMinutesToExecutionTime= (intHoursToExecutionTime * 60) + intInMinutes
Else
intMinutesToExecutionTime= (intHoursToExecutionTime * 60)
End If

intSecondsToExecutionTime = (intMinutesToExecutionTime * 60) + intInSeconds
End If

datExecutionTime = DateAdd("s",intSecondsToExecutionTime, datCountdownStartedTime)

intTimerID = window.setInterval("DoCountdown()", 1000)

End Sub

Sub DoCountdown()

strCountdownStartedTime = DatePart("h", datCountdownStartedTime) & ":"
strCountdownStartedTime = strCountdownStartedTime & Right("00" & DatePart("n", datCountdownStartedTime), 2) & ":"
strCountdownStartedTime = strCountdownStartedTime & Right("00" & DatePart("s", datCountdownStartedTime), 2)

strExecutionTime = DatePart("h", datExecutionTime) & ":"
strExecutionTime = strExecutionTime & Right("00" & DatePart("n", datExecutionTime), 2) & ":"
strExecutionTime = strExecutionTime & Right("00" & DatePart("S", datExecutionTime), 2)

strCurrentTime = DatePart("h", Now()) & ":"
strCurrentTime = strCurrentTime & Right("00" & DatePart("n", Now()), 2) & ":"
strCurrentTime = strCurrentTime & Right("00" & DatePart("s", Now()), 2)

blnResult = CalculateTimeSpan(Now(), datExecutionTime, strRemainingTime)

spanCountdownStarted.InnerText = strCountdownStartedTime
spanExecutionTime.InnerText = strExecutionTime
spanCurrentTime.InnerText = strCurrentTime
spanRemainingTime.InnerText = strRemainingTime

If strRemainingTime = "00:00:00" Then
Call ClearCountdown
Shutdown(intShutdownFlag)
End If
End Sub

Function CalculateTimeSpan(ByVal datFirst, ByVal datSecond, ByRef strTimeSpan)
Dim strSpanHours
Dim strSpanstrSpanMinutes
Dim strSpanSeconds

If (IsDate(datFirst) And IsDate(datSecond)) = False Then
strTimeSpan = "00:00:00"
Exit Function
End If

strSpanSeconds = Abs(DateDiff("S", datFirst, datSecond))
strSpanMinutes = strSpanSeconds \ 60
strSpanHours = strSpanMinutes \ 60
strSpanMinutes = strSpanMinutes mod 60
strSpanSeconds = strSpanSeconds mod 60

If Len(strSpanHours) = 1 Then
strSpanHours = "0" & strSpanHours
End If

strTimeSpan = strSpanHours & ":" & Right("00" & strSpanMinutes, 2) & ":" & Right("00" & strSpanSeconds, 2)
End Function

Sub ClearCountdown
'// Because of most browser's idiotic behaviour with empty table cells,
'// we populate them with spaces

Dim strSpaces

strSpaces = String(4, " ")
spanCountdownStarted.InnerText = strSpaces
spanExecutionTime.InnerText = strSpaces
spanCurrentTime.InnerText = strSpaces
spanRemainingTime.InnerText = strSpaces

window.clearInterval(intTimerID)
End Sub

Sub Shutdown(ByVal intShutdownFlag)
Dim objWMIService

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown )}").InstancesOf("Win32_OperatingSystem")

For Each objSystem In objWMIService
objSystem.Win32Shutdown intShutdownFlag
Next

Set objWMIService = Nothing
End Sub

Sub DoCancel
Window.Close
End Sub

Sub btnQuit_onClick
Call ExitScript
End Sub

Sub ExitScript
'// So that no-one knows we've been, reset the Custom Zone
'objWshShell.RegWrite strIEAccessDataAcrossDomainsLocalRegKey, 1, "REG_DWORD"
'If Err.Number <> 0 Then
' strMsg = "Unable to write IE Security registry value."
' MsgBox strMsg, vbOKonly + vbCritical
'End If

Set dicArguments = Nothing
Set objWSHShellApp = Nothing
Set objWSHShell = Nothing
Set objFSO = Nothing

self.Close
End Sub

Sub HandleKeys
Select Case window.event.keycode
Case 13
Call btnExecute_onClick
Case 27
Call btnQuit_onClick
End Select
End Sub

Sub GetScreenSize(ByRef intHorizontal, ByRef intVertical)
Dim strComputer
Dim objWMIService_GSS
Dim colItems
Dim objItem

strComputer = "."

Set objWMIService_GSS = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService_GSS.ExecQuery("Select * From Win32_DesktopMonitor")

For Each objItem In colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Exit For
Next

Set colItems = Nothing
Set objWMIService_GSS = Nothing
End Sub

Sub ResizeWindow(ByVal intWidth, ByVal intHeight, ByVal blnShowMsg)
Dim intH
Dim intV
Dim objMessageAreaResize

With Window
If blnShowMsg Then
Set objMessageAreaResize = .document.getElementById("HeaderArea")
objMessageAreaResize.InnerHTML = "Resizing window"
Set objMessageAreaResize = Nothing
End If

.resizeTo intWidth,intHeight
End With
End Sub

Sub CentreWindow(ByVal intWidth, ByVal intHeight, ByVal blnShowMsg)
Dim intH
Dim intV
Dim intLeft
Dim intTop
Dim objMessageAreaCentre

Call GetScreenSize(intH, intV)

intLeft = (intH - intWidth) / 2
intTop = (intV - intHeight) / 2

With Window
If blnShowMsg Then
Set objMessageAreaCentre = .document.getElementById("HeaderArea")
objMessageAreaCentre.InnerHTML = "Centering window"
Set objMessageAreaCentre = Nothing
End If

.moveTo intLeft, intTop
End With
End Sub

'// =========================================================================================================
'// Name: GetSubstringCount
'// Purpose: Determines how many times one string occurs in another string
'// Input: strToLookFor - the string to look for
'// strSearch - the string to look in
'// blnIgnoreCase - If True, ignore case of both strings
'// Output: intStringCount - a 'ByRef' variable which will contain the number of occurrences
'// Returns: True/False
'// =========================================================================================================
Function GetSubstringCount(ByVal strToLookFor, ByVal strSearch, ByVal blnIgnoreCase, ByRef intStringCount)
'// Since VBS doesn't provide a string counter (i.e. how many times a string occurs in another string)
'// we hack it using Split: the UBound of the array will tell us how many occurrences there are, if any

'// Assume the worst
intStringCount = 0
GetSubstringCount = False

If Len(strToLookFor) = 0 Then
strMsg = "A parameter, 'strToLookFor', passed to " & strScriptName & ".GetSubstringCount is empty."
'errStatus = MsgUsr(strMsg, intButtonType, strScriptName & ".GetSubstringCount", intButtonPressed)
Exit Function
End If

If Len(strSearch) = 0 Then
strMsg = "A parameter, 'strSearch', passed to " & strScriptName & ".GetSubstringCount is empty."
'errStatus = MsgUsr(strMsg, intButtonType, strScriptName & ".GetSubstringCount", intButtonPressed)
Exit Function
End If

If blnIgnoreCase Then
intStringCount = UBound(Split(strSearch, strToLookFor))
Else
intStringCount = UBound(Split(UCase(strSearch), UCase(strToLookFor)))
End If

GetSubstringCount = True

End Function

'//=========================================================================================================
'// Name: StringMatch
'// Purpose: Checks if two strings match
'// Why not use 'If strFirst = strSecond', you're asking?
'// Well, the 'Equals' operator :
'// - is not very fast (at string comparison)!
'// - compares strings left to right and is smart enough to stop comparing when it spots the first difference, but
'// - is too dumb to first do the most obvious test: comparing the lengths of the strings!
'// Input: strFirst - the first string
'// strSecond - the second string
'// blnMatch - a Boolean indicating whether or not the strings matched
'// Output: None
'// Returns: True/False
'//
'//=========================================================================================================
Function StringMatch(ByVal strFirst, ByVal strSecond, ByRef blnMatch)

StringMatch = True

blnMatch = False

If LenB(strFirst) = LenB(strSecond) Then
blnMatch = (InStrB(1, strFirst, strSecond, vbBinaryCompare) <> 0)
End If

End Function
</SCRIPT>
</HEAD>

<BODY onKeyPress='HandleKeys()'>
<DIV ID="pagewidth1">
<DIV ID="top_body">
<P><IMG SRC="DoShutdownClientLogo.gif" /></p>
<P>&nbsp;</P>
<H1><SPAN ID=spanHeader></SPAN></H1>
<P>&nbsp;</P>
</DIV>
</DIV>

<P ALIGN="center">
This computer is scheduled to be <SPAN ID='spanRestartText'></SPAN>.<BR>Please click the 'Cancel' button if you wish to continue using it.
</P>

<TABLE WIDTH='98%' BORDER=0>
<TR>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanCountdownStartedPrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanCountdownStarted'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='5%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanExecutionTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanExecutionTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>

<TR>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanCurrentTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanCurrentTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='5%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanRemainingTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanRemainingTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>
</TABLE>

<TABLE WIDTH='98%' BORDER=0>
<TR>
<TD>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>

<TR>
<TD ALIGN='CENTER'>
<FONT SIZE="2">
<INPUT ACCESSKEY='Q' CLASS="button" TYPE="button" VALUE="Cancel" ID='btnQuit' NAME='btnQuit'>
</FONT>
</TD>
</TR>
</TABLE>
</BODY>
</HTML>
Answered 07/20/2010 by: VBScab
Red Belt

Please log in to comment
Answer this question or Comment on this question for clarity