Use this script and be rewarded for helping your company implement their green IT visions.
'Script by tomriddle 2009
'Power Saving Script
'GreenNights.vbs
'Run this script as a scheduled task against all domain workstations at night.
'checks target computer is not a server and optionally not in a certain IP range,
'has protection against users inadvertently clicking on script directly shutting down computers during the day.
'Script gets it's list of computers to shutdown by reading members of an Active Directory OU and sub OUs
'If logged on, screensaver active 20 minutes and is not a member of exclude list, shutdown cmd is sent.
'or If logged off and is not a member of exclude list, shutdown cmd is sent.
'both users and computers can be added to the exclude group
'creates a comprehensive log file to examine the following morning.
'Notes:-
'if a user leaves a document open on a computer over night, then that document will be lost.
'Screen savers need to be enforced with grouppolicy for that check to be used effectively.
'With positive publicity before implementing offering users an opt out, reception is good.
'We timed the full implementation of this script with Earth Hour with great success.
'No complaints from users.
'usage:-
'set scheduled task to run from a server at night.
'run command:- cscript.exe script.vbs
'Variables that can be changed
ScreenSaverTime=20 'Time screen saver has been left on in minutes before script acts on computer.
strServer="\\server\share\" 'location where script is stored - change to your server
strLog=strServer&"done.txt" 'list of computers that have been acted upon.
GShutDownSkip = "cn=GShutDownSkip,OU=Groups,dc=domain,dc=com" 'change to your domain
GShutDownPilot = "cn=GShutDownPilot,OU=Groups,dc=domain,dc=com"
If Not WScript.FullName = WScript.Path & "\cscript.exe" Then
msgbox "!!! WARNING !!!" &vbcrlf&vbcrlf& "YOU ARE NOT TO MANUALLY RUN THIS SCRIPT" &vbcrlf& "AS IT TURNS OFF MACHINES ON THE DOMAIN"
wscript.quit
end if
'Enumerate ALL 'Computer' Accounts in Active Directory
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = _
"Select Name, Location from 'LDAP://OU=Workstations,DC=domain,DC=com' " _
& "Where objectClass='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strComputer = objRecordSet.Fields("Name").Value
objRecordSet.MoveNext
SCRCGreen strComputer, strLog
Loop
'---------------------------------------------------
Sub SCRCGreen(strcomputer, strLog)
'Main script logic
'for testing place pilot computers in GShutDownPilot group.
'exit sub if computer not in group.
'if inGroup(strcomputer, GShutDownPilot)=false then
' 'WriteLog strLog, StrComputer&vbtab&now&vbtab&" "&vbtab&" "&vbtab&"Not in pilot group"
' exit sub
'end if
on error resume next
'Can ping
If Reachable(strComputer) then
'Is not in skip group i.e. special can't turn off type computer
if inGroup(strcomputer, GShutDownSkip) then
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"computer in exclude group"&vbtab&"Shutdown Aborted"
on error goto 0
exit sub
end if
'Is not a server
if isServer(strComputer)=false then
'Skip if has an IP starting with the following three octets 172 16 71
if instr(NetProperties(strComputer), "172.16.71.")=0 then
'User logged on check
if UserLoggedIn(strComputer)<>"" then
'Is in skip group i.e. special user - exit sub routine
if inGroup(UserLoggedIn(strcomputer), GShutDownSkip) then 'skip computer based on userid
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"Special user "&UserLoggedIn(strcomputer)&" is logged in"&vbtab&"Shutdown Aborted"
on error goto 0
exit sub
end if
'Screen saver running time check
if ScreenSaverRunning(strComputer)>=ScreenSaverTime then
'Check for Errors in script
if err=0 then
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"Screen Saver on "&ScreenSaverRunning(strComputer)&" Mins"&vbtab&"Shutdown initiated"
shutdown strComputer
else
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"Screen Saver on "&ScreenSaverRunning(strComputer)&" Mins - script error"&vbtab&"Shutdown aborted"
end if
else
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"User Logged in - ScreenSaver active "&ScreenSaverRunning(strComputer)&" Mins"&vbtab&"Shutdown aborted"
end if
else
if err=0 then
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"computer Logged Off"&vbtab&"Shutdown Initiated"
shutdown strComputer
else
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"computer Logged Off - script error"&vbtab&"Shutdown Aborted"
end if
end if
end if
end if
end if
on error goto 0
End sub
'---------------------------------------------------
Function isServer(strComputer)
'Check OS version and return 'true' if OS is Server, 'false' if not.
'Function by tomriddle 2009
On Error Resume Next
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
If InStr(1,objItem.Caption,"Server") Then
if err<>0 then
isServer=true ' Just in case
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"SERVER - or can't read WMI"&vbtab&"Shutdown aborted"
exit function
else
isServer=true
WriteLog strLog, StrComputer&vbtab&now&vbtab&Uptime(strComputer)&vbtab&"SERVER? "&vbtab&"Shutdown aborted"
end if
else
isServer=false
end if
next
on error goto 0
End function
'---------------------------------------------------
Function UserLoggedIn(strcomputer)
'Return true if a user is logged in
UserLoggedIn=""
on error resume next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'explorer.exe'")
For Each objProcess in colProcessList
objProcess.GetOwner strUserName, strUserDomain
UserLoggedIn=strUserName
Next
on error goto 0
End Function
'---------------------------------------------------
sub Shutdown(strComputer)
'Forced Shutdown
'The following code will force a system to shutdown, regardless of any applications open at the time.
'****************
'exit sub '******* TESTING - unremark out this line and sub is made safe for testing.
'****************
on error resume next
Const Force_Shutdown = 5
Set OpSysSet = GetObject("winmgmts:{(Shutdown)}//"&strComputer&"/root/cimv2").ExecQuery("select * from Win32_OperatingSystem where Primary=true")
For Each OpSys In OpSysSet
OpSys.Win32Shutdown(Force_Shutdown)
Next
on error goto 0
end sub
'---------------------------------------------------
Function Reachable(strComputer)
'Return true if can ping
Dim wmiQuery : wmiQuery = "Select * From Win32_PingStatus Where Address = '" & _
strComputer & "'"
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Dim objPing : Set objPing = objWMIService.ExecQuery(wmiQuery)
Dim objStatus
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
Reachable = False
Else
Reachable = True
End If
Next
End Function
'---------------------------------------------------
Function ScreenSaverRunning(strComputer)
'Returns the number of minutes the screen saver has been running for, else 0
ScreenSaverRunning=0
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process")
For Each objProcess in colProcesses
If Right(objProcess.Name, 4) = ".scr" Then
ScreenSaverRunning = datediff("n", WMIDateStringToDate(objProcess.CreationDate), now)
End If
Next
End Function
'---------------------------------------------------
Function inExcludedArray(strComputer)
'Returns true if strComputer is in array of computers to exclude
For i = 0 to Ubound(arrServiceList)-1
if arrServiceList(i)=strComputer then
inExcludedArray=true
exit function
else
inExcludedArray=false
end if
Next
End function
'---------------------------------------------------
Function WMIDateStringToDate(dtmBootup)
WMIDateStringToDate = CDate(Mid(dtmBootup, 7, 2) & "/" & _
Mid(dtmBootup, 5, 2) & "/" & Left(dtmBootup, 4) _
& " " & Mid (dtmBootup, 9, 2) & ":" & _
Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup,13, 2))
End Function
'---------------------------------------------------
sub WriteLog(strLog, StrContent)
'Write output to log file
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.OpenTextFile(strLog, 8, True).WriteLine strContent
End Sub
'---------------------------------------------------
Function Uptime(strComputer)
'Return uptime of the operating system of this computer
on error resume next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each objOS in colOperatingSystems
dtmBootup = objOS.LastBootUpTime
dtmLastBootupTime = WMIDateStringToDate(dtmBootup)
dtmSystemUptimeD = DateDiff("d", dtmLastBootUpTime, Now)
dtmSystemUptimeM = DateDiff("n", dtmLastBootUpTime, Now)
x=dtmSystemUptimeM mod 60
dtmSystemUptimeH = (dtmSystemUptimeM-x)/60
dtmSystemUptimeM = x
if dtmSystemUptimeH >= 24 then
dtmSystemUptimeH = dtmSystemUptimeH mod 24
end if
If dtmSystemUptimeD = 1 then
D="Day "
else
D="Days "
end if
If dtmSystemUptimeH = 1 then
H="Hour "
else
H="Hours "
end if
If dtmSystemUptimeM = 1 then
M="Minute "
else
M="Minutes "
end if
Uptime = dtmSystemUptimeD & D & dtmSystemUptimeH & H & dtmSystemUptimeM & M
Next
if err.number <> 0 then
Uptime = "Error Reading WMI"
end if
on error goto 0
end function
'---------------------------------------------------
function inGroup(strComputer, ShutdownGroup)
On Error Resume Next
Set objGroup = GetObject("LDAP://" & ShutdownGroup)
objGroup.GetInfo
arrMemberOf = objGroup.GetEx("member")
For Each strMember in arrMemberOf
if instr(strMember, strComputer)>0 then
inGroup=true
exit function
end if
Set objUser = GetObject ("LDAP://"&strMember)
if lcase(strComputer)=lcase(objUser.sAMAccountName) then
inGroup=true
exit function
end if
Next
inGroup=false
on error goto 0
end function
'---------------------------------------------------
Function NetProperties(strComputer)
'Return remote computer's Network properties
on error resume next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM " & _
"Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objItem In colItems
XIP= Join(objItem.IPAddress, ",")
Next
'Return ip computer has
if err.number <> 0 then
NetProperties = ""
else
NetProperties=XIP
end if
on error goto 0
end Function
Here is another quick freebie, more printers the better, log into the print server and change the defaults to double sided. Users can override this to print single sided if they want, instead of the other way around.