Option Explicit

Dim arrDummy, arrPrinters
Dim blnDebug, blnPause
Dim i, intBreak, intValidArgs, lngDelay
Dim objFSO, objReg, wshShell
Dim strDefaultPort, strDefaultPrinter, strNewDev, strOldDev
Dim strCmdLine, strHive, strKeyPath, strKeyDescr, strPrnStr
Dim strKeyStroke, strMsg, strRegVal, strScriptName

Const HKCU = &H80000001

' Set blnDebug True to display intermediate results
blnDebug      = False
blnPause      = False
intBreak      = 0
intValidArgs  = 0
lngDelay      = 0
strHive       = "HKEY_CURRENT_USER\"
strKeyPath    = "Software\Microsoft\Windows NT\CurrentVersion\"
strKeyStroke  = ""
strMsg        = ""
strRegVal     = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device"
strScriptName = ""

' Connect to the registry using WMI; this is necessary to
' enumerate keys, which cannot be done with the wshShell object
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" _
                      & "./root/default:StdRegProv" )
' Query the list of printers
objReg.EnumValues HKCU, strKeyPath & "PrinterPorts", arrPrinters, arrDummy
Set objReg = Nothing

' Abort if the list of printers is empty; intBreak will
' show where the script aborted in debugging mode
intBreak = 1
If Not IsArray( arrPrinters ) Then Syntax

' Parse the command line
With WScript.Arguments
	' Debugging information
	If blnDebug Then
		strMsg = "Command Line Arguments    : " & .Count & vbCrLf
		For i = 0 To .Count - 1
			strMsg = strMsg & "Command Line Argument " _
			                & Right( "  " & i, 3 ) _
			                & " : " & .Item(i) & vbCrLf
		Next
		strMsg = strMsg & vbCrLf
	End If
	intBreak = 2
	' At least 2 arguments are required
	If .Count < 2 Then Syntax
	strMsg = strMsg & vbCrLf & "Available printers        : " _
	                & UBound( arrPrinters ) + 1 & vbCrLf
	' The first argument is the printer name
	For i = 0 To UBound( arrPrinters )
		' List printer names in debugging mode
		strMsg = strMsg & "Printer " _
		                & Right( "   " & ( i + 1 ), 3 ) _
		                & Space( 15 ) & ": " _
		                & Split( arrPrinters(i), "," )(0) & vbCrLf
		If LCase( Split( arrPrinters(i), "," )(0) ) = LCase( .Item(0) ) Then
			strNewDev    = arrPrinters(i)
			intValidArgs = 1
		End If
	Next
	strMsg = strMsg & vbCrLf
	' Abort if the printer name doesn't match one of the installed printers
	intBreak = 3
	If intValidArgs = 0 Then Syntax
	' Check for /D, /P, /S or /K switch; other switches are invalid; if the
	'second argument is "Unnamed" (doesn't start with a forward slash) then
	' it should be the command that is called to handle the printing itself
	If Left( .Item(1), 1 ) = "/" Then
		Select Case UCase( Mid( .Item(1), 2, 1 ) )
			Case "D"
				intBreak = 4
				lngDelay = ValidateDelay( .Item(1) )
			Case "K"
				intBreak = 5
				strKeyStroke = ValidateKeyStroke( .Item(1) )
			Case "P"
				blnPause = True
				intValidArgs = 2
			Case "S"
				intBreak = 6
				strScriptName = ValidateScript( .Item(1) )
			Case Else
				intBreak = 7
				Syntax
		End Select
	Else
		strCmdLine = ""
		For i = 1 To .Count - 1
			strCmdLine = strCmdLine & " " & .Item(i)
		Next
		strCmdLine = Mid( strCmdLine, 2 )
	End If
	' Abort on invalid switch
	intBreak = 8
	If intValidArgs = 1 Then Syntax
	' A third argument could be any of the switches,
	' or the (continuation of the) printing command
	If .Count > 2 Then
		If Left( .Item(2), 1 ) = "/" Then
			Select Case UCase( Mid( .Item(2), 2, 1 ) )
				Case "D"
					intBreak = 9
					lngDelay = ValidateDelay( .Item(2) )
				Case "K"
					intBreak = 10
					strKeyStroke = ValidateKeyStroke( .Item(2) )
				Case "P"
					If blnPause Then
						intBreak = 11
						Syntax
					End If
					blnPause     = True
					intValidArgs = 3
				Case "S"
					intBreak = 12
					strScriptName = ValidateScript( .Item(2) )
				Case Else
					intBreak = 13
					Syntax
			End Select
		Else
			strCmdLine = ""
			For i = 2 To .Count - 1
				strCmdLine = strCmdLine & " " & .Item(i)
			Next
			strCmdLine = Mid( strCmdLine, 2 )
			intValidArgs = 3
		End If
		intBreak = 14
		If intValidArgs = 2 Then Syntax
	End If
	' A fourth argument cannot be a switch
	If .Count > 3 Then
		If Left( .Item(3), 1 ) = "/" Then
			intBreak = 14
			Syntax
		Else
			strCmdLine = ""
			For i = 3 To .Count - 1
				strCmdLine = strCmdLine & " " & .Item(i)
			Next
			strCmdLine = Mid( strCmdLine, 2 )
			intValidArgs = 4
		End If
		' Abort if the fourth argument was a switch
		intBreak = 15
		If intValidArgs = 3 Then Syntax
	End If
End With

' Check the combination of command line arguments
If strCmdLine = "" Then
	' Don't send keystrokes if no program is specified
	intBreak = 16
	If strKeyStroke <> "" Then Syntax
Else
	' Program name shouldn't start with a forward slash
	intBreak = 17
	If Left( strCmdLine, 1 ) = "/" Then Syntax
End If

' Read the current and the new default printer settings from the registry
Set wshShell = CreateObject( "WScript.Shell" )
strOldDev = wshShell.RegRead( strHive & strKeyPath & "Windows\Device" )
strPrnStr = wshShell.RegRead( strHive & strKeyPath & "PrinterPorts\" & strNewDev )
arrDummy  = Split( strPrnStr, "," )
strNewDev = strNewDev & "," & arrDummy(0) & "," & arrDummy(1)
Set wshShell = Nothing

' Format intermediate results to be displayed in debugging mode
strKeyDescr = Replace( strKeyStroke, "+", "Shift+" )
strKeyDescr = Replace( strKeyDescr,  "%", "Alt+" )
strKeyDescr = Replace( strKeyDescr,  "^", "Ctrl+" )
strMsg = strMsg & "Current default printer   : " & strOldDev & vbCrLf
strMsg = strMsg & "Temporary default printer : " & strNewDev & vbCrLf
strMsg = strMsg & "Restore delay             : " & lngDelay / 1000 & " seconds" & vbCrLf
strMsg = strMsg & "Pause before restore      : " & blnPause & vbCrLf
strMsg = strMsg & "Restore script            : " & strScriptName & vbCrLf
strMsg = strMsg & "Keystrokes                : " & strKeyDescr & vbCrLf
strMsg = strMsg & "Print command             : " & strCmdLine & vbCrLf
If blnDebug Then WScript.Echo strMsg

If strScriptName <> "" Then
	' Create a restore script
	intBreak = 18
	If Not CreateScript( strScriptName, strOldDev ) Then Syntax
End If
' Use wshShell object
Set wshShell = CreateObject( "WScript.Shell" )
' Change the default printer in the registry
wshShell.RegWrite strRegVal, strNewDev, "REG_SZ"
If strCmdLine <> "" Then
	' Start the specified printing command
	wshShell.Run strCmdLine, 9, False
	If strKeyStroke <> "" Then
		' Wait at least 5 seconds before sending the specified keystrokes
		WScript.Sleep 5000
		wshShell.SendKeys strKeyStroke
	End If
End If
If lngDelay <> 0 Then
	' Wait as long as specified by the /D switch
	WScript.Sleep lngDelay
End If
If blnPause Then
	' Pause until "OK" button is clicked in the confirmation dialog
	MsgBox "Wait for the print job to finish." & vbCrLf & _
	       "Then click ""OK"" to restore the default printer", _
	       vbOKOnly + vbInformation, "Please wait"
End If
If strScriptName = "" Then
	' Restore the original default printer unless /S switch was used
	wshShell.RegWrite strRegVal, strOldDev, "REG_SZ"
Else
	' Display the command to restore the default printer if /S switch was used
	WScript.Echo "Use the following command to restore the default printer:" & vbCrLf _
	           & "CSCRIPT  //NoLogo  """ & strScriptName & """" & vbCrLf
End If
' Done
Set wshShell = Nothing


' Create a script to restore the default printer
Function CreateScript( myScript, myDefPrn )
	Dim objFSO, objScriptFile
	Const ForWriting    = 2
	Const TristateFalse = 0
	CreateScript = True
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
	On Error Resume Next
	Set objScriptFile = objFSO.OpenTextFile( myScript, ForWriting, True, TristateFalse )
	If Err Then CreateScript = False
	objScriptFile.WriteLine "Set wshShell = CreateObject( ""WScript.Shell"" )"
	If Err Then CreateScript = False
	objScriptFile.WriteLine "wshShell.RegWrite """ & strRegVal & """, """ & myDefPrn & """, ""REG_SZ"""
	If Err Then CreateScript = False
	objScriptFile.WriteLine "Set wshShell = Nothing"
	If Err Then CreateScript = False
	On Error Goto 0
	Set objScriptFile = Nothing
	Set objFSO        = Nothing
End Function


' Display a help message
Sub Syntax( )
	If blnDebug Then
		strMsg = strMsg & "Breakpoint " & intBreak & vbCrLf & vbCrLf
	Else
		strMsg = ""
	End If
	strMsg = strMsg _
	       & "Print2.vbs,  Version 1.00 for Windows 2000 and later" _
	       & vbCrLf _
	       & "Temporarily swap the default printer for programs that only support printing" _
	       & vbCrLf _
	       & "to the default printer (""Print""), not to other printers (""PrintTo"")." _
	       & vbCrLf & vbCrLf _
	       & "Usage:   PRINT2.VBS  printer  [ options ]  [ printprog  [ printprogargs ]]" _
	       & vbCrLf & vbCrLf _
	       & "Where:   printer  is the name of the temporary default printer" _
	       & vbCrLf _
	       & "         options  can be a combination of these switches:" _
	       & vbCrLf _
	       & "                  [ /D:seconds | /P | /S:scriptname ] [ /K:keystroke ]" _
	       & vbCrLf _
	       & "                  /D   restore default printer after specified delay in seconds" _
	       & vbCrLf _
	       & "                  /P   wait for confirmation to restore the default printer" _
	       & vbCrLf _
	       & "                  /S   create a script that will restore the default printer" _
	       & vbCrLf _
	       & "                  /K   send keystroke to printprog after 5 seconds" _
	       & vbCrLf _
	       & "                       (use VBScript's SendKeys( ) syntax for keystroke)" _
	       & vbCrLf _
	       & "         printprog  [ printprogargs ]  optional command to print a file;" _
	       & vbCrLf _
	       & "                                       if not specified, /D or /P or /S" _
	       & vbCrLf _
	       & "                                       is required and /K is not allowed" _
	       & vbCrLf & vbCrLf _
	       & "Example: Print ""test.xps"" on ""HP LaserJet"" using Microsoft's XPS Viewer" _
	       & vbCrLf _
	       & "         PRINT2.VBS ""HP LaserJet"" /D:10 /K:""{ENTER}"" XpsRchVw.exe test.xps /P" _
	       & vbCrLf & vbCrLf _
	       & "Written by Rob van der Woude" _
	       & vbCrLf _
	       & "http://www.robvanderwoude.com"
	WScript.Echo strMsg
	WScript.Quit 1
End Sub


' Validate the specified delay
Function ValidateDelay( myArgStr )
	ValidateDelay = 0
	' Check if mutually exclusive or repeated arguments were used
	If lngDelay > 0 Or blnPause Or strScriptName <> "" Then
		Syntax
	Else
		lngDelay      = Mid( myArgStr, 4 )
		If IsNumeric( lngDelay ) Then
			lngDelay = CLng( 1000 * lngDelay )
			intValidArgs  = intValidArgs + 1
		Else
			Syntax
		End If
		ValidateDelay = lngDelay
	End If
End Function


' Validate /K (keystroke) argument
Function ValidateKeyStroke( myArgStr )
	ValidateKeyStroke = ""
	' Check if repeated arguments were used
	If strKeyStroke <> "" Then Syntax
	If Trim( Mid( myArgStr, 4 ) ) = "" Then
		Syntax
	Else
		ValidateKeyStroke = Mid( myArgStr, 4 )
		intValidArgs = intValidArgs + 1
	End if
End Function


' Validate the specified restore script path and check if it can be created
Function ValidateScript( myArgStr )
	Dim blnErr, intPos, objFSO, objScript, strFolder, strScript
	ValidateScript = ""
	' Check if mutually exclusive or repeated arguments were used
	If lngDelay > 0 Or blnPause Or strScriptName <> "" Then Syntax

	blnErr = False

	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
	strScript = Mid( myArgStr, 4 )

	' Check if parent folder exists
	If InStr( strScript, "\" ) Then
		intPos    = InStrRev( strScript, "\" )
		strFolder = Left( strScript, intPos - 1 )
		If Not objFSO.FolderExists( strFolder ) Then blnErr = True
	End If

	' Check if file can be created
	On Error Resume Next
	Set objScript = objFSO.CreateTextFile( strScript, True, False )
	If Err Then blnErr = True
	objScript.Close
	Set objScript = Nothing
	On Error Goto 0

	' Close object and return result
	Set objFSO = Nothing
	If blnErr Then
		Syntax
	Else
		intValidArgs   = intValidArgs + 1
		ValidateScript = strScript
	End If
End Function