Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 517
  • Last Modified:

hta/vbs script help

I have found an HTA script that allows users to select a print server from a drop-down, then select the desired printer from a sub list.  I was trying to figure out a way to change the displayed sever name to something that is a little easier for the users to recognize.
For example:" Server01"  in the list would display as "Chicago".  Sorry for not crediting the writer of the script, their name was not listed.  Here is the script, thanks in advance
-Bob-
<head>
	<title>FD Printer Share Enumerator</title>
	<HTA:APPLICATION 
	     APPLICATIONNAME="FD Printer Share Enumerator"
	     SCROLL="no"
	     SINGLEINSTANCE="yes"
	     WINDOWSTATE="normal"
	>
	
	<script language='vbs'>
	<!--
	Option Explicit
		
	Dim arrServerNames, strServerNames
	strServerNames = "SERVER01;SERVER02;SERVER03;SERVER04"
	arrServerNames = Split(strServerNames,";")

    Sub Window_OnLoad

		Dim intWidth, intHeight
		intWidth = 600
		intHeight = 500
		Me.ResizeTo intWidth, intHeight
	    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
	    
		lstAllServers.Style.Width = 300
    	lstPrinters.Style.Width = 300
    	
		Dim strAppPath

		strAppPath = Mid(Document.URL, 8, InStrRev(Document.URL, "\") - 8)
		If Left(strAppPath, 2) = "\\" Then
			MsgBox "This page is being run from a UNC path.  Please map a drive to " & vbCrLf & _
			"""" & strAppPath & """" & vbCrLf & " or any share before this location, and run the application from a network drive."
			Window.Close
		End If
		
		Create_Server_Name_Array

    End Sub
		
	Sub Create_Server_Name_Array
		Dim objSelectOption, intServerCount
		
		For intServerCount = LBound(arrServerNames) To UBound(arrServerNames)
			Set objSelectOption = Document.CreateElement("OPTION")
			objSelectOption.Text = arrServerNames(intServerCount)
			objSelectOption.Value = arrServerNames(intServerCount)
			lstAllServers.Add objSelectOption
		Next
		
	End Sub

	Sub EnumPrinters
		Dim strComputer, objWMIService, colItems, objItem, objSelectOption
		Const HKEY_LOCAL_MACHINE = &H80000002
		Const wbemFlagReturnImmediately = &h10
		Const wbemFlagForwardOnly = &h20
		strComputer = lstAllServers.value
		Reset_Printers
		If strComputer <> " --- Select Option --- " Then
			If Ping(strComputer) = True Then
				'On Error Resume Next
				Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
				Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
				If Err.Number <> 0 Then
					MsgBox "Could not connect to " & strComputer
					Err.Clear
					On Error GoTo 0
				Else
					For Each objItem In colItems
						Set objSelectOption = Document.CreateElement("OPTION")
						objSelectOption.Text = objItem.Name
						objSelectOption.Value = objItem.ShareName
						lstPrinters.Add objSelectOption
					Next
				End If
			Else
				MsgBox strComputer & " is offline.  Cannot obtain printer list."
			End If
		End If
	End Sub

	Sub Reset_Printers
		Dim objOption, objNewOption
		For Each objOption In lstPrinters.Options
			lstPrinters.Remove(objOption.Index)
		Next
		Set objNewOption = Document.CreateElement("OPTION")
		objNewOption.Text = " --- Select Option --- "
		objNewOption.Value = " --- Select Option --- "
		lstPrinters.Add(objNewOption)
	End Sub

	Sub Connect_Selected_Printer
		Dim strShareName, objNetwork
		strShareName = lstPrinters.value
		If strShareName = " --- Select Option --- " Then
			MsgBox "Please select a printer"
		Else
			Set objNetwork = CreateObject("WScript.Network")
			objNetwork.AddWindowsPrinterConnection "\\" & lstAllServers.value & "\" & strShareName
			If chkSetDefault.Checked = True Then
				objNetwork.SetDefaultPrinter "\\" & lstAllServers.value & "\" & strShareName
			End If
			MsgBox "Printer has been added."
		End If
	End Sub
	
	Function Ping(strComputer)
		Dim objShell, boolCode
		Set objShell = CreateObject("WScript.Shell")
		boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
		If boolCode = 0 Then
			Ping = True
		Else
			Ping = False
		End If
	End Function

	-->
	</script>

</head>

<body>

	<br><br><br>
	<table width='80%' height='90%' align='center' border='0' cellpadding="0" cellpadding="0">
		<tr>
			<td colspan=2 align='center'>
				<font face='Arial' size='5'><u>FD Printer Share Enumerator</u></font>
			</td>
		</tr>
		<tr>
			<td>
				<font face='Arial' size='4'>Servers:</font>
			</td>
			<td>
			    <select size='1' name='lstAllServers' onChange='vbs:EnumPrinters'>
			    	<option id="opt_select" value=" --- Select Option --- "> --- Select Option --- </option>
				</select>
			</td>
		</tr>
		<tr>
			<td>
				<font face='Arial' size='4'>Printers:</font>
			</td>
			<td>
			    <select size='1' name='lstPrinters'>
			    	<option id="opt_select" value=" --- Select Option --- "> --- Select Option --- </option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='center' colspan="2">
				<input type='checkbox' name='chkSetDefault'> Set as default
			</td>
		</tr>
		<tr>
			<td align='center' colspan="2">
				<input type='button' value='Connect Selected Printer' name='btnConnectPrinter'  onClick='vbs:Connect_Selected_Printer'>
			</td>
		</tr>
	</table>

</body>

Open in new window

0
BRamskill
Asked:
BRamskill
  • 4
  • 2
1 Solution
 
RobSampsonCommented:
Hi, you could do this reasonably easily by using pairs of elements in the array. For example, you can use
strServerNames = "SERVER01;Chicago;SERVER02;New York;SERVER03;Los Angeles;SERVER04;Seattle"

And then use Step 2 in the arrays For loop.

I can help you further with that if you need.

Rob.
0
 
BRamskillAuthor Commented:
Hi Rob,

If you don't mind, that would be great if you could show me how it would look in the script (kinda new at this).

Thanks

-B-
0
 
RobSampsonCommented:
Looking at it now, it looks like the type of code I would write, so I'm pretty I would have made this one for EE a while back ;-)

Anyway, I have changed line 15 from:
      strServerNames = "SERVER01;SERVER02;SERVER03;SERVER04"

to
      strServerNames = "SERVER01;Chicago;SERVER02;New York;SERVER03;Los Angeles;SERVER04;Seattle"

then changed line 45 from
            For intServerCount = LBound(arrServerNames) To UBound(arrServerNames)

to
            For intServerCount = LBound(arrServerNames) To UBound(arrServerNames) - 1 Step 2

and finally changed line 47 from
                  objSelectOption.Text = arrServerNames(intServerCount)

to
                  objSelectOption.Text = arrServerNames(intServerCount + 1)


This should work for you now.

Regards,

Rob.

<head>
	<title>FD Printer Share Enumerator</title>
	<HTA:APPLICATION 
	     APPLICATIONNAME="FD Printer Share Enumerator"
	     SCROLL="no"
	     SINGLEINSTANCE="yes"
	     WINDOWSTATE="normal"
	>
	
	<script language='vbs'>
	<!--
	Option Explicit
		
	Dim arrServerNames, strServerNames
	strServerNames = "SERVER01;Chicago;SERVER02;New York;SERVER03;Los Angeles;SERVER04;Seattle"
	arrServerNames = Split(strServerNames,";")

    Sub Window_OnLoad

		Dim intWidth, intHeight
		intWidth = 600
		intHeight = 500
		Me.ResizeTo intWidth, intHeight
	    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
	    
		lstAllServers.Style.Width = 300
    	lstPrinters.Style.Width = 300
    	
		Dim strAppPath

		strAppPath = Mid(Document.URL, 8, InStrRev(Document.URL, "\") - 8)
		If Left(strAppPath, 2) = "\\" Then
			MsgBox "This page is being run from a UNC path.  Please map a drive to " & vbCrLf & _
			"""" & strAppPath & """" & vbCrLf & " or any share before this location, and run the application from a network drive."
			Window.Close
		End If
		
		Create_Server_Name_Array

    End Sub
		
	Sub Create_Server_Name_Array
		Dim objSelectOption, intServerCount
		
		For intServerCount = LBound(arrServerNames) To UBound(arrServerNames) - 1 Step 2
			Set objSelectOption = Document.CreateElement("OPTION")
			objSelectOption.Text = arrServerNames(intServerCount + 1)
			objSelectOption.Value = arrServerNames(intServerCount)
			lstAllServers.Add objSelectOption
		Next
		
	End Sub

	Sub EnumPrinters
		Dim strComputer, objWMIService, colItems, objItem, objSelectOption
		Const HKEY_LOCAL_MACHINE = &H80000002
		Const wbemFlagReturnImmediately = &h10
		Const wbemFlagForwardOnly = &h20
		strComputer = lstAllServers.value
		Reset_Printers
		If strComputer <> " --- Select Option --- " Then
			If Ping(strComputer) = True Then
				'On Error Resume Next
				Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
				Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
				If Err.Number <> 0 Then
					MsgBox "Could not connect to " & strComputer
					Err.Clear
					On Error GoTo 0
				Else
					For Each objItem In colItems
						Set objSelectOption = Document.CreateElement("OPTION")
						objSelectOption.Text = objItem.Name
						objSelectOption.Value = objItem.ShareName
						lstPrinters.Add objSelectOption
					Next
				End If
			Else
				MsgBox strComputer & " is offline.  Cannot obtain printer list."
			End If
		End If
	End Sub

	Sub Reset_Printers
		Dim objOption, objNewOption
		For Each objOption In lstPrinters.Options
			lstPrinters.Remove(objOption.Index)
		Next
		Set objNewOption = Document.CreateElement("OPTION")
		objNewOption.Text = " --- Select Option --- "
		objNewOption.Value = " --- Select Option --- "
		lstPrinters.Add(objNewOption)
	End Sub

	Sub Connect_Selected_Printer
		Dim strShareName, objNetwork
		strShareName = lstPrinters.value
		If strShareName = " --- Select Option --- " Then
			MsgBox "Please select a printer"
		Else
			Set objNetwork = CreateObject("WScript.Network")
			objNetwork.AddWindowsPrinterConnection "\\" & lstAllServers.value & "\" & strShareName
			If chkSetDefault.Checked = True Then
				objNetwork.SetDefaultPrinter "\\" & lstAllServers.value & "\" & strShareName
			End If
			MsgBox "Printer has been added."
		End If
	End Sub
	
	Function Ping(strComputer)
		Dim objShell, boolCode
		Set objShell = CreateObject("WScript.Shell")
		boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
		If boolCode = 0 Then
			Ping = True
		Else
			Ping = False
		End If
	End Function

	-->
	</script>

</head>

<body>

	<br><br><br>
	<table width='80%' height='90%' align='center' border='0' cellpadding="0" cellpadding="0">
		<tr>
			<td colspan=2 align='center'>
				<font face='Arial' size='5'><u>FD Printer Share Enumerator</u></font>
			</td>
		</tr>
		<tr>
			<td>
				<font face='Arial' size='4'>Servers:</font>
			</td>
			<td>
			    <select size='1' name='lstAllServers' onChange='vbs:EnumPrinters'>
			    	<option id="opt_select" value=" --- Select Option --- "> --- Select Option --- </option>
				</select>
			</td>
		</tr>
		<tr>
			<td>
				<font face='Arial' size='4'>Printers:</font>
			</td>
			<td>
			    <select size='1' name='lstPrinters'>
			    	<option id="opt_select" value=" --- Select Option --- "> --- Select Option --- </option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='center' colspan="2">
				<input type='checkbox' name='chkSetDefault'> Set as default
			</td>
		</tr>
		<tr>
			<td align='center' colspan="2">
				<input type='button' value='Connect Selected Printer' name='btnConnectPrinter'  onClick='vbs:Connect_Selected_Printer'>
			</td>
		</tr>
	</table>

</body>

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
RobSampsonCommented:
Hi, not sure if you saw my comment here. Did this help?

Rob.
0
 
BRamskillAuthor Commented:
Works like a charm!  Thanks for the help!!!
0
 
RobSampsonCommented:
No problem. Thanks for the grade.
0

Featured Post

[Webinar On Demand] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now