'--------------------------------------------
' 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