'ShutdownIfLoggedOff.vbs
'power management
'Alan dot Kaplan at va dot gov
'This script shuts down PC when no user is logged on.  Can run as scheduled task, or using SMS/SCCM
'9/22/2008, 7/12/11
'

Option Explicit 
dim wshShell
dim message, strComputer
Dim errMsg, strNTName
Dim objLocator, objWMIService, oCompSys, oCSItem
Dim strSubject, strBody, strTo, strFrom
Dim objNet
Dim strTestEmail, strMyName, strLOA,iDelaySeconds

'Email Constants do not change
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSendUsingPort = 25
Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"

Set objNet = CreateObject("Wscript.Network")
Set wshShell = WScript.CreateObject("WScript.Shell")
strComputer = objNet.Computername

' ****** ======== EDITING REQUIRED HERE  ====== ******
'SMTP Mail server 
Const strMailServer = "smtp.mydomain.com"

'Best to use a GROUP here, so if admin leaves, no change required.
strTo = "Admin.Name@mydomain.com"

'From line.  Defaults to computername
strFrom = strComputer & "@mydomain.com"

'Log Off Acttions -- pick one, comment out others
'strLOA = "LogOffAlways"	'Always logoff, even if user logged on
'strLOA = "NotifyOnly"		'Never logoff user.  Send admin email
strLOA = "LogoffAndNotify"	'Logoff user, send admin email
'strLOA = "AllowStop"		'Allow user to abort

iDelaySeconds = 900	' 15 minutes if user logged on

' ========== End Edits =======
If Not LoggedOn Then 
	Shutdown (0)
Else
	NotLoggedOn 
End If 

'================ Functions and Subroutines ============

Sub NotLoggedOn ()
	Select Case lcase(strLOA)
		Case "logoffalways"
			Shutdown iDelaySeconds		'15 minutes
		Case "notifyonly"
			strSubject = "No shutdown on " & strComputer 
			strBody = strComputer & " was not shutdown on " & Date & _
			"at " & now & " because user " & strNTName & strMyName & " was logged on."
			Notify ()
		Case "logoffandnotify"
			strSubject = "Delayed shutdown on " & strComputer 
			strBody = strComputer & " shutdown was delayed on " & Date & _
			"at " & now & " because user " & strNTName & strMyName & " was logged on."
			Notify ()
			Shutdown iDelaySeconds
		Case Else					'All other allow user to abort shutdown
			Shutdown iDelaySeconds
			AllowStop			
		End Select
End Sub 


Sub Shutdown(iTime) ' power down time in seconds
	Dim strCommand,  quote
	Dim objEx, data
	quote=chr(34)

	strCommand = "%windir%\system32\shutdown.exe -s -c " & quote & _
	 "power conservation shutdown" & quote & " -f -d p:0:0 -t " & iTime
	Set objEx = WshShell.Exec(strCommand)
End Sub 


Sub AllowStop()	'Will this work if user is not an admin?
	Dim quote
	quote=chr(34)
	Dim strCommand
	Dim objEx, data
	Dim retval
	retval = InputBox("Type " & quote & "stop" & quote & " to abort shutdown","Stop Shutdown?","Do Not Stop",350)
	If lcase(retval) = "stop" Then 
		strCommand = "%windir%\system32\shutdown.exe -a"
		Set objEx = WshShell.Exec(strCommand)
	End If 
End Sub 

Sub Notify() ' send email
	GetName
	Dim i
	Dim m_objCDO, m_objCDOcon, Fields
	
	Set m_objCDO = CreateObject("CDO.Message")
	Set m_objCDOcon = CreateObject("CDO.Configuration")
	
	'Setting up Mail
	'Note that I am relying on a server that does not require authentication
	'this is because the username/pw would be in plaintext, available to the
	'user.  You can use authentication -- see CDO docs
	
	Set Fields = m_objCDOcon.Fields
	With Fields
	   .Item(cdoSendUsingMethod)       = 2
	   .Item(cdoSMTPServer)            = strMailServer
	   .Item(cdoSMTPServerPort)        = cdoSendUsingPort
	   .Item(cdoSMTPConnectionTimeout) = 100   
	   .Update
	End With
	
	'Passing parameters to message object
	Set m_objCDO.Configuration = m_objCDOcon
	
	With m_objCDO
	    .To       = strTo
	    .From     = strFrom
	End With

	m_objCDO.TextBody = strBody
	m_objCDO.Subject  = strSubject
	
	i = 0

	'Retry if fails to send
    Do
    	Err.Clear
    	m_objCDO.Send
		WScript.Sleep 6000				'Wait a minute
		i = i + 1
    Loop Until Err.Number = 0 Or i = 10	'after 10 times bail
	
	Set m_objCDO = Nothing
	Set m_objCDOcon = Nothing

End Sub


Sub GetName 'Gets user's first and last from AD
	Dim strDescription 
	If wshShell.ExpandEnvironmentStrings("%LOGONSERVER%") = strComputer Then
		strMyName =""
		Exit Sub 
	End If 
	
	Dim objLocator, objWMIService, objUserInfoList, objUserInfo
	set objLocator = CreateObject("WbemScripting.SWbemLocator")
	Set objWMIService = objLocator.ConnectServer(strComputer) 
	
	Set objUserInfoList = objWMIService.InstancesOf("Win32_ComputerSystem")
	
	If (Err.Number = 0)  Then
		For Each objUserInfo in objUserInfoList
		  	If Not isnull(objUserInfo.Username) Then  
		   		strNTName =  objUserInfo.UserName 
		  	End If  
		Next
	Else
		strMyName =""
		Exit Sub 
	End If
	
	Dim tArray
	tArray = Split(strNTName,"\")
	strNTName = tArray(1)
	sDomain = tArray(0)
	
	Dim objConnection, oRS, objCommand, root, sDomain
	Const ADS_SCOPE_SUBTREE = 2
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand = CreateObject("ADODB.Command")
	objConnection.Provider = ("ADsDSOObject")
	objConnection.Open "Active Directory Provider"
	objCommand.ActiveConnection = objConnection
	
	'Get the ADsPath for the domain to search. 

	objCommand.CommandText = "SELECT samAccountName,description, givenname, sn FROM " & _
	    "'LDAP://" & sDomain & "' WHERE samAccountName = '" & strNTName &  "'"

	objCommand.Properties("SearchScope") = ADS_SCOPE_SUBTREE
	Set oRS = objCommand.Execute
	

	If oRS.RecordCount = 0 Then
	   strMyName = ""
	Else

	    strMyName = " (" & oRS("givenName").value & space(1) & oRS("sn").value 

	    If IsArray(oRS("Description")) Then 
	    	tArray = oRS("Description")
	    	strDescription = tArray(0)
	    Else
			If Len(oRS("Description"))>0 Then
				strDescription = oRS("Description")	
			End If
		End If 
	End If 
	
	If Len(strDescription) > 0 Then 
		strMyName = strMyName & ", " & strDescription & ")"
	Else
		strMyName = strMyName & ")"
	End If 
	
	
	Set root = Nothing
	Set oRS = Nothing
	Set objCommand = Nothing
	Set objConnection = Nothing
	
End Sub

Function LoggedOn() ' Check for logged on user indirec
	LoggedOn = False
	Dim oWMI, colItems, objItem
	Set oWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
	Set colItems = oWMI.ExecQuery("SELECT caption FROM Win32_Process where caption = 'explorer.exe'",,48)

	For Each objItem In colItems
	      LoggedOn = True
	Next
End Function