'*************************************************************************
' Script Name - WindowsUpdateRoaming.vbs
'
' Purpose - Checks to see if computer can contact SCE server - if no contact in 6 hours configure WU agent to point to MU. Checks
' every hour to see if can contact SCE server - if so, points the WU agent back at the WSUS server
'
' Assumptions - Script is run as a runtime task
'
' Parameters - ManagementGroupName
'
' (c) Copyright 2006, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
OPTION EXPLICIT
SetLocale("en-us")
CONST HKLM = &H80000002
Dim objReg
Dim strValue, strSCEServer, strManagementGroup
Dim objArgs
Set objArgs = WScript.Arguments
if objArgs.Count <> 1 Then
Wscript.Quit -1
End If
strManagementGroup = objArgs(0)
Set objReg = GetObject("winmgmts:root\default:StdRegProv")
If objReg Is Nothing then
'Wscript.Echo "Unabled to bind to StdRegProv"
Wscript.Quit
End If
' Get current WSUS Server
objReg.GetStringValue HKLM, "SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate", "WUServer", strValue
' Get just the FQDN of the WSUS Server
If IsNull(strValue) then
wscript.quit
End If
If (InStr(strValue,"//")) > 0 then
strSCEServer = Right(strValue,Len(strValue)-InStr(strValue,"//")-1)
Else
wscript.quit
End If
if (InStr(strSCEServer,":")) > 0 then
strSCEServer = Left(strSCEServer,Len(strSCEServer)-(Len(strSCEServer)-InStr(strSCEServer,":")+1))
End If
' Attempt to ping the WSUS server
If Ping(strSceServer) = 0 then
' since we are successful, check to see if we were previously had an unsuccessful count
objReg.GetDWORDValue HKLM, "SOFTWARE\Microsoft\Microsoft Operations Manager\3.0\Agent Management Groups\" & strManagementGroup, "WSUSContactCount", strValue
' if we previously couldn't connect, clean the WSUSContactCount key and point the AU client back as the WSUSServer
If IsEmpty(strValue) = FALSE then
objReg.DeleteValue HKLM,"SOFTWARE\Microsoft\Microsoft Operations Manager\3.0\Agent Management Groups\" & strManagementGroup, "WSUSContactCount"
objReg.SetDWORDValue HKLM, "SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate\AU", "UseWUServer", 1
End If
Else
' since we are unsuccessful, check to see if we were previously had an unsuccessful count
objReg.GetDWORDValue HKLM, "SOFTWARE\Microsoft\Microsoft Operations Manager\3.0\Agent Management Groups\" & strManagementGroup, "WSUSContactCount", strValue
' first unsuccessful contact, create the WSUSContactCount key equal to 1
If IsNull(strValue) then
objReg.SetDWORDValue HKLM, "SOFTWARE\Microsoft\Microsoft Operations Manager\3.0\Agent Management Groups\" & strManagementGroup, "WSUSContactCount", 1
' subsequent unsuccessful contact, add 1 to the WSUSContactCount key
ElseIf strValue < 7 then
strValue = strValue + 1
objReg.SetDWORDValue HKLM, "SOFTWARE\Microsoft\Microsoft Operations Manager\3.0\Agent Management Groups\" & strManagementGroup, "WSUSContactCount", strValue
' its been 6 hours since we communicated with the WSUS server - point the AU client at MU
ElseIf strValue > 6 then
objReg.SetDWORDValue HKLM, "SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate\AU", "UseWUServer", 0
End If
End If
' Attempts to ping using Win32_PingStatus class - Only exists in XP and above
Function Ping(strServer)
Dim objWMI, colPings, objPing
Set objWMI = GetObject("winmgmts:root\cimv2")
Set colPings = objWMI.ExecQuery("Select * From Win32_PingStatus where Address = '" & strServer & "'")
If colPings Is Nothing then
wscript.quit
Else
For Each objPing in colPings
If objPing.StatusCode = 0 Then
Ping = 0
Else
Ping = -1
End If
Next
End If
End Function