'--------------------------------------------
' Author: Isaac G
' Date: 4/29/2008
' Script to update users installed printers to
' use secondary print server
'

Option Explicit

Dim PF, StrHostPrintsrv1
Set PF = New PrinterFailover

	StrHostPrintsrv1 = "YOURPRIMARYPRINTSERVERNAME"
	If Ping(StrHostPrintsrv1) = False Then
	PF.PS_PROD = "YOURPRIMARYPRINTSERVERNAME"
	PF.PS_BACKUP = "YOURSECONDARYPRINTSERVERNAME"
	Else
	PF.PS_PROD = "YOURSECONDARYPRINTSERVERNAME"
	PF.PS_BACKUP = "YOURPRIMARYPRINTSERVERNAME"
	End If	
Public Function Ping(strHost)

    		Dim objPing, objRetStatus

    		set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
      		("select * from Win32_PingStatus where address = '" & strHost & "'")

    		for each objRetStatus in objPing
        		if IsNull(objRetStatus.StatusCode) or objRetStatus.StatusCode<>0 then
    			Ping = False
            		'WScript.Echo "Status code is " & objRetStatus.StatusCode
        		else
            		Ping = True
            		'Wscript.Echo "Bytes = " & vbTab & objRetStatus.BufferSize
            		'Wscript.Echo "Time (ms) = " & vbTab & objRetStatus.ResponseTime
           	 	'Wscript.Echo "TTL (s) = " & vbTab & objRetStatus.ResponseTimeToLive
        		end if
    		next
End Function 	

PF.UpdatePrinters

WScript.Quit


Class PrinterFailover

	
	'Public
	
	Public PS_PROD
	Public PS_BACKUP
	
	' Private
	
	Private oShell
	Private HKEY_CURRENT_USER
	Private HKCU_DEFAULT_PRINTER
	
	Private Sub Class_Terminate()
		Set oShell = Nothing
	End Sub

	Private Sub Class_Initialize()
		Set oShell = WScript.CreateObject("WScript.Shell")
		HKEY_CURRENT_USER = &H80000001	
	
		' Rev2
		HKCU_DEFAULT_PRINTER = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device"
		' end rev2

	End Sub

	Public Function UpdatePrinters()
	
		Dim v, ar, i, j

		ar = arPrinters()

		Dim retValueNames
		Dim retValueTypes
		
		Dim sKeyPath: sKeyPath = "Printers\Connections\"
		
		Dim RegFullKeyPath
		
		Dim arRegVal()
		
		Dim nName : nName = 0
		Dim nType : nType = 1
		Dim nVal  : nVal  = 2
		
		' rev2
		Dim PrintersUpdated: PrintersUpdated = False	
		Dim DefPrinter: DefPrinter = DefaultPrinter()
		' End rev 2

		For i = 0 to UBound(ar, 1)

			If InStr(ar(i), PS_PROD) > 0 Then
			
				'WScript.Echo "Updating printer key: " &  ar(i)
				
				' rev2
				PrintersUpdated = True
				' end rev2

				RegFullKeyPath = sKeyPath & ar(i)
				
				Call EnumRegVals(RegFullKeyPath, _ 
				                 retValueNames, _
				                 retValueTypes)
				
				ReDim arRegVal(3, UBound(retValueNames))
				
				For j = 0 To UBound(retValueNames) 
				  '  WScript.Echo "Value Name: " & retValueNames(j)  & " : " & oShell.RegRead("HKCU\" & RegFullKeyPath & "\" & retValueNames(j) )
				    
				    arRegVal(nName, j) = retValueNames(j)
				    
				    arRegVal(nType, j) = RegTypeNameFromVal(retValueTypes(j))
				    
				    arRegVal(nVal,  j) = oShell.RegRead("HKCU\" & RegFullKeyPath & "\" & retValueNames(j))
				    
				Next
				
				oShell.RegDelete "HKCU\" & RegFullKeyPath & "\"
				
				For j = 0 to UBound(arRegVal, 2)
					oShell.RegWrite Replace("HKCU\" & RegFullKeyPath & "\" & arRegVal(nName, j), PS_PROD, PS_BACKUP), _
					Replace(arRegVal(nVal, j),PS_PROD, PS_BACKUP), _
					arRegVal(nType, j)
				Next
			
			End If
		Next
		
		' rev2
		' Only update the default printer if we failed over something
		If PrintersUpdated Then
			UpdateDefaultPrinter(DefPrinter)
		End If
		'end rev2
		
	End Function


	Public Sub EnumRegVals(ByVal sKeyPath, _
			       ByRef retValueNames, _
			       ByRef retValueTypes)
	
	' WMI reference
	
	' http://msdn.microsoft.com/en-us/library/aa390387(VS.85).aspx

		Dim sComp: sComp = "."
		Dim i, oReg
		
		Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ 
		   sComp & "\root\default:StdRegProv")


		oReg.EnumValues HKEY_CURRENT_USER, sKeyPath,_
		   retValueNames, retValueTypes
			
	End Sub
	
	
	Private Function RegTypeNameFromVal(RegType)
		const REG_SZ = 1
		const REG_EXPAND_SZ = 2
		const REG_BINARY = 3
		const REG_DWORD = 4
		const REG_MULTI_SZ = 7
		
		Dim s
		
		Select Case RegType
		Case REG_SZ
		   s =  "REG_SZ"
		Case REG_EXPAND_SZ
		   s = "REG_EXPAND_SZ"
		Case REG_BINARY
		   s = "REG_BINARY"
		Case REG_DWORD
		   s = "REG_DWORD"
		Case REG_MULTI_SZ
		   s = "REG_MULTI_SZ" ' Even though RegWrite won't suppor this type
		End Select
		
		RegTypeNameFromVal = s
		
	End Function
	
	Private Function arPrinters()
	
		Dim sComp: sComp = "."
		Dim sKeyPath : sKeyPath = "Printers\Connections"
		Dim ar, subkey, oReg

		Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ 
		sComp & "\root\default:StdRegProv")
	
		oReg.EnumKey HKEY_CURRENT_USER, sKeyPath, ar
		
		arPrinters = ar	
	End Function
	
	' rev2
	Private Function DefaultPrinter()
		Dim s
		s = oShell.RegRead(HKCU_DEFAULT_PRINTER)
		DefaultPrinter = s
	End Function
	
	Private Sub UpdateDefaultPrinter(DefPrinter)
		oShell.RegWrite HKCU_DEFAULT_PRINTER, Replace(DefPrinter, PS_PROD, PS_BACKUP)
	End Sub

	' end rev2

End Class