logo.jpg (4128 bytes)
Home
Main Page
Links
Classical
Popular
Programming
Shareware
Emulation
Opus
Gtr & Fl.
Concerto
Code
Status bar
Math
Perl
Base Address
Meta Script
DHTML
WSC
Programs
Markup
Clipboard

 

You must be using Microsoft Internet Explorer version 4 or greater with JavaScript enabled to properly view this document!"

Try here

The WSHShellInfo component is a Windows Script Component that exposes some functionality of the WshNetwork, WshEnvironment object to any environment that supports COM, such as Microsoft Visual Basic.

Download a sample VB5 project.

Methods

tree_con.gif (913 bytes) EnvVar( strWhere, strWhat )
tree_con.gif (913 bytes) ExpandEnv( strEnv )
tree_con.gif (913 bytes) GetSpecialFolder( strFolder )
tree_con.gif (913 bytes) ComputerName()
tree_con.gif (913 bytes) UserName()
tree_con.gif (913 bytes) UserDomain()
tree_con.gif (913 bytes) GetNetworkDrive( intDriveNum )
tree_con.gif (913 bytes) GetNetworkMapping( intDriveNum )
tree_con.gif (913 bytes) GetNetworkDrives()
tree_con.gif (913 bytes) GetNetworkMappings()
tree_con.gif (913 bytes) MapNetworkDrive( strLocalResource, strRemoteShare, blnUpdateProfile, strUserName, strPassword )
tree_con.gif (913 bytes) RemoveNetworkDrive( strName, blnForce, blnUpdateProfile )
tree_con.gif (913 bytes) GetPrinterPort( intPrinterNum )
tree_con.gif (913 bytes) GetPrinterMapping( intPrinterNum )
tree_con.gif (913 bytes) GetPrinterPorts()
tree_con.gif (913 bytes) GetPrinterMappings()
tree_con.gif (913 bytes) AddPrinterConnection( strLocalResource, strRemoteName, blnUpdateProfile, strUserName, strPassword )
tree_con.gif (913 bytes) AddWindowsPrinterConnectionNT( strPrinterPath )
tree_con.gif (913 bytes) AddWindowsPrinterConnection9x( strPrinterPath, strDriverName, strPort )
tree_con.gif (913 bytes) RemovePrinterConnection( strPrinterName, blnForce, blnUpdateProfile )

Properties

tree_con.gif (913 bytes) NetworkDriveCount
tree_con.gif (913 bytes) ConnectedPrinterCount

Source

<?XML version="1.0" standalone="yes" ?>
<?component debug="true" error="true" ?>

	<component id="WSHShellInfo">

		<registration
			description="WSH Shell Object Info"
			progid="WSHShellInfo.Info"
			version="1"
			classid="{CD4BF880-D44F-11d4-BB17-00C0F033CD85}"
		/>

		<public>
			<method name="EnvVar">
				<parameter name="strWhere" />
				<parameter name="strWhat" />
			</method>
			<method name="ExpandEnv">
				<parameter name="strEnv" />
			</method>
			<method name="GetSpecialFolder">
				<parameter name="strFolder" />
			</method>
			<method name="ComputerName" />
			<method name="UserName" />
			<method name="UserDomain" />
			<method name="GetNetworkDrive">
				<parameter name="intDriveNum" />
			</method>
			<method name="GetNetworkMapping">
				<parameter name="intDriveNum" />
			</method>
			<method name="GetNetworkDrives"/>
			<method name="GetNetworkMappings"/>
			<method name="MapNetworkDrive">
				<parameter name="strLocalResource" />
				<parameter name="strRemoteShare" />
				<parameter name="blnUpdateProfile" />
				<parameter name="strUserName" />
				<parameter name="strPassword" />
			</method>
			<method name="RemoveNetworkDrive">
				<parameter name="strName" />
				<parameter name="blnForce" />
				<parameter name="blnUpdateProfile" />
			</method>


		<comment>
		/*
		 * Printer Methods
		 */
		</comment>
			<method name="GetPrinterPort">
				<parameter name="intPrinterNum" />
			</method>
			<method name="GetPrinterMapping">
				<parameter name="intPrinterNum" />
			</method>
			<method name="GetPrinterPorts" />
			<method name="GetPrinterMappings" />
			<method name="AddPrinterConnection">
				<parameter name="strLocalResource" />
				<parameter name="strRemoteName" />
				<parameter name="blnUpdateProfile" />
				<parameter name="strUserName" />
				<parameter name="strPassword" />
			</method>
			<method name="AddWindowsPrinterConnectionNT">
				<parameter name="strPrinterPath" />
			</method>
			<method name="AddWindowsPrinterConnection9x">
				<parameter name="strPrinterPath" />
				<parameter name="strDriverName" />
				<parameter name="strPort"/>
			</method>
			<method name="RemovePrinterConnection">
				<parameter name="strName" />
				<parameter name="blnForce" />
				<parameter name="blnUpdateProfil" />
			</method>
			<method name="SetDefaultPrinter">
				<parameter name="strName" />
			</method>

		<comment>
		/*
		 *	Properties
		 */
		</comment>
			<property name="NetworkDriveCount" get />
			<property name="ConnectedPrinterCount" get />
			<property name="LOG_SUCCESS" get />
			<property name="LOG_ERROR" get />
			<property name="LOG_WARNING" get />
			<property name="LOG_INFORMATION" get />
			<property name="LOG_AUDIT_SUCCESS" get />
			<property name="LOG_AUDIT_FAILURE" get />
		<public>
		
		<script language="VBScript">
		<![CDATA[


			Option Explicit

			Const get_LOG_SUCCESS = 0
			Const get_LOG_ERROR = 1
			Const get_LOG_WARNING = 2
			Const get_LOG_INFORMATION = 4
			Const get_LOG_AUDIT_SUCCESS = 8
			Const get_LOG_AUDIT_FAILURE = 16

			Function EnvVar(strWhere, strWhat)

				Dim wsh : Set wsh = CreateObject("WScript.Shell")
				Dim env : Set env = wsh.Environment(strWhere)
				
				EnvVar = env(strWhat)

				Set env = Nothing
				Set wsh = Nothing

			End Function

			Function ExpandEnv(strEnv)
				
				Dim wsh : Set wsh = CreateObject("WScript.Shell")
				
				ExpandEnv = wsh.ExpandEnvironmentStrings(strEnv)
			
				Set wsh = Nothing

			End Function

			Function GetSpecialFolder(strFolder)

				Dim wsh : Set wsh = CreateObject("WScript.Shell")
				Dim Str

				str = wsh.SpecialFolders(strFolder)

				If Not (str = "") Then
					GetSpecialFolder = Str
				Else
					GetSpecialFolder = "Not available"
				End If

				Set wsh = Nothing

				
			End Function

			Function ComputerName()
				
				Dim net : Set net = CreateObject("WScript.Network")

				ComputerName = net.ComputerName

				Set net = Nothing

			End Function

			Function UserName()
			
				Dim net : Set net = CreateObject("WScript.Network")

				UserName = net.UserName

				Set net = Nothing

			End Function

			Function UserDomain()

				Dim net : Set net = CreateObject("WScript.Network")

				UserDomain = net.UserDomain

				Set net = Nothing

			End Function

	      '''''''''''''''''''''''''''''''''''''''''''''''''''''''
		'	Network Drive Functions
		'
			Function GetNetworkDrive( intDriveNum )

				If Not IsNumeric(intDriveNum) Then
					GetNetworkDrive = "Invalid Drive Number"
					Exit Function
				ElseIf intDriveNum <= 0 Then
					GetNetworkDrive = "Invalid Drive Number"
					Exit Function
				End If

				Dim net	: Set net = CreateObject("WScript.Network")
				Dim d	: Set d = net.EnumNetworkDrives()
				Dim n	: n = d.Count
				
				If intDriveNum > (n / 2) Then
					GetNetworkDrive = "Drive ID Out Of Range"
				Else
					GetNetworkDrive = d.Item( (intDriveNum - 1) * 2 )
				End If
				Set d = Nothing
				Set net = Nothing

			End Function

			Function GetNetworkMapping( intDriveMum )
				
				If Not IsNumeric(intDriveNum) Then
					GetNetworkMapping = "Invalid Drive ID"
					Exit Function
				ElseIf intDriveNum <= 0 Then
					GetNetworkMapping = "Invalid Drive ID"
					Exit Function
				End If

				Dim net	: Set net = CreateObject("WScript.Network")
				Dim d	: Set d = net.EnumNetworkDrives()
				Dim n	: n = d.Count
				If intDriveNum > (n / 2) Then
					GetNetworkMapping = "Drive ID Out Of Range"
				Else
					GetNetworkMapping = d.Item( (intDriveNum + (intDriveNum - 1)) )
				End If
				Set d = Nothing
				Set net = Nothing

			End Function

			Function GetNetworkDrives()
				
				Dim sDrives()
				Dim i, j : j = 0
				Dim net	 : Set net = CreateObject("WScript.Network")
				Dim d	 : Set d = net.EnumNetworkDrives()
				Dim n	 : n = d.Count

				ReDim sDrives( (n / 2) )
				For i = 0 To (n - 2) Step 2
					sDrives(j) = d.Item(i)
					j = j + 1
				Next
				Set d = Nothing
				Set net = Nothing
				GetNetworkDrives = sDrives
				
			End Function

			Function GetNetworkMappings()

				Dim sMaps()
				Dim i, j : j = 0
				Dim net  : Set net = CreateObject("WScript.Network")
				Dim d	 : Set d = net.EnumNetworkDrives()
				Dim n	 : n = d.Count

				ReDim sMaps( (n / 2) )
				For i = 0 To (n - 1) Step 2
					sMaps(j) = d.Item(i)
					j = j + 1
				Next
				Set d = Nothing
				Set net = Nothing
				GetNetworkMappings = sMaps

			End Function

			Function MapDriveToShare( strLocalResource, strRemoteShare, blnUpdateProfile, strUserName, strPassword )

				If CheckString(strLocalResource) = "" Or CheckString(strRemoteShare) = "" Then
					MapDriveToShare = "Invalid Resource Or Share"
					Exit Function
				End If
				blnUpdateProfile = CheckBool(blnUpdateProfile)
				strUserName = CheckString(strUserName)
				strPassword = CheckString(strPassword)

				Dim net : Set net = CreateObject("WScript.Network")
				Call net.MapNetworkDrive(strLocalResource, strRemoteShare, blnUpdateProfile, strUserName, strPassword)
				Set net = Nothing

				If Err.Number <> 0 Then
					MapDriveToShare = Err.Description
				Else
					MapDriveToShare = ""
				End If

			End Function

			Function RemoveNetworkDrive( strName, bForce, blnUpdateProfile )

				If CheckString(strName) = "" Then
					RemoveNetworkDrive = "Invalid Resource Name"
					Exit Function
				End If
				bForce = CheckBool(bForce)
				blnUpdateProfile = CheckBool(blnUpdateProfile)
			
				Dim net : Set net = CreateObject("WScript.Network")
				Call Err.Clear()
				Call net.RemoveNetworkDrive(strName, bForce, blnUpdateProfile)
				Set net = Nothing

				If Err.Number <> 0 Then
					RemoveNetworkDrive = Err.Description
				Else
					RemoveNetworkDrive = ""
				End If

			End Function

 

		'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
		' Printer methods
		'
			Function GetPrinterPort( intPrinterNum )

				If Not IsNumeric(intPrinterNum) Then
					GetPrinterPort = "Invalid Printer ID"
					Exit Function
				End If

				Dim net : Set net = CreateObject("WScript.Network")
				Dim p : Set p = net.EnumPrinterConnections()
				Dim n : n = p.Count

				If n = 0 Then
					GetPrinterPort = "No Printers"
					Exit Function
				ElseIf intPrinterNum > (n / 2) Then

					' This is a problem because of the way that 
					' the Collection returned by EnumPrinterConnections
					' is made up of alternating ports Then mapping info.
					' So there are Collection.Count / 2 ports.
					GetPrinterPort = "Printer ID Out Of Range"
				ElseIf intPrinterNum <= 0 Then
					GetPrinterPort = "Invalid Printer ID"
				Else
					GetPrinterPort = p.Item( (intPrinterNum - 1) * 2 )
				End If
				Set p = Nothing
				Set net = Nothing

			End Function

			Function GetPrinterMapping( intPrinterNum )

				If Not IsNumeric(intPrinterNum) Then
					GetPrinterMapping = "Invalid Printer ID"
					Exit Function
				ElseIf intPrinterNum <= 0 Then
					GetPrinterMapping = "Invalid Printer ID"
					Exit Function
				End If

				Dim net : Set net = CreateObject("Wscript.Network")
				Dim p : Set p = net.EnumPrinterConnections()
				Dim n : n = p.Count

				If n = 0 Then
					GetPrinterMapping = "No Printers"
				ElseIf intPrinterNum > (n / 2) Then
					GetPrinterMapping = "Printer ID Out Of Range"
				Else
					GetPrinterMapping = p.Item( (intPrinterNum + (intPrinterNum - 1)) )
				End If
				Set p = Nothing
				Set net = Nothing

			End Function

			'''''''''''''''''''''''''''''''
			' GetPrinterPorts() And GetPrinterMappings() Each return
			' a Variant containing an Array.
			'
			Function GetPrinterPorts()

				Dim sPorts()
				Dim i, j : j = 0
				Dim net : Set net = CreateObject("WScript.Network")
				Dim p : Set p = net.EnumPrinterConnections()
				Dim n : n = p.Count

				ReDim sPorts( (n / 2) )
				For i = 0 To (n - 2) Step 2
					sPorts(j) = p.Item(i)
					j = j + 1
				Next
				Set p = Nothing
				Set net = Nothing
				GetPrinterPorts = sPorts
								
			End Function

			Function GetPrinterMappings()

				Dim sMaps()
				Dim i, j : j = 0
				Dim net  : Set net = CreateObject("WScript.Network")
				Dim p	 : Set p = net.EnumPrinterConnections()
				Dim n	 : n = p.Count

				ReDim sMaps( (n / 2) )
				For i = 1 To (n - 1) Step 2
					sMaps(j) = p.Item(i)
					j = j + 1
				Next
				Set p = Nothing
				Set net = Nothing
				GetPrinterMappings = sMaps
				
			End Function

			Function AddPrinterConnection( strLocalResource, strRemoteName, blnUpdateProfile, strUserName, strPassword)

				If CheckString(strLocalResource) = "" Or CheckString(strRemoteName) = "" Then
					AddPrinterConnection = "Invalid Resource Or Remote Name"
					Exit Function
				End If

				blnUpdateProfile = CheckBoolean(blnUpdateProfile)
				strUserName = CheckString(strUserName)
				strPassword = CheckString(strPassword)

				Dim net : Set net = CreateObject("WScript.Network")
				Call Err.Clear()
				Call net.AddPrinterConnection(strLocalResource, strRemoteName, blnUpdateProfile, strUserName, strPassword)
				Set net = Nothing
				If Err.Number <> 0 Then
					AddPrinterConnection = Err.Description
				Else
					AddPrinterConnection = ""
				End If

			End Function



			Function AddWindowsPrinterConnectionNT( strPrinterPath )
	
				If CheckString( strPrinterPath ) = "" Then
					AddWindowsPrinterConnectionNT = "Invalid Printer Path"
					Exit Function
				End If

				Dim net : Set net = CreateObject("WScript.Network")
				Call Err.Clear()
				Call net.AddWindowsPrinterConnection( strPrinterPath )
				Set net = Nothing

				If Err.Number <> 0 Then
					AddWindowsPrinterConnectionNT = Err.Description
				Else
					AddWindowsPrinterConnectionNT = ""
				End If

			End Function

			Function AddWindowsPrinterConnection9x( strPrinterPath, strDriverName, strPort )

				If CheckString(strPrinterPath) = "" Or CheckString(strDriverName) = "" Then
					AddWindowsPrinterConnection9x = "Invalid Printer Path Or Driver Name"
					Exit Function
				End If

				Dim net : Set net = CreateObject("WScript.Network")
				Call Err.Clear()
				Call net.AddWindowsPrinterConnection( strPrinterPath, strDriverName, strPort )
				Set net = Nothing

				If Err.Number <> 0 Then
					AddWindowsPrinterConnection9x = Err.Description
				Else
					AddWindowsPrinterConnection9x = "" 
				End If

			End Function

			Function RemovePrinterConnection( strName, blnForce, blnUpdateProfile )
	
				If CheckString(strName) = "" Then
					RemovePrinterConnection = "Invalid Printer Name"
					Exit Function
				End If
				blnForce = CheckBoolean(blnForce)
				blnUpdateProfile = CheckBoolean(blnUpdateProfile)

				Dim net : Set net = CreateObject("WScript.Network")
				Call Err.Clear()
				Call net.RemovePrinterConnection(strName, blnForce, blnUpdateProfile)
				Set net = Nothing
				
				If Err.Number <> 0 Then
					RemovePrinterConnection = Err.Description
				Else
					RemovePrinterConnection = ""
				End If

			End Function

			Function SetDefaultPrinter( strName )

				If CheckString(strName) = "" Then
					SetDefaultPrinter = "Invalid Printer Name"
					Exit Function
				End If

				Dim net : Set net = CreateObject("WScript.Network")
				Call Err.Clear()
				Call net.SetDefaultPrinter(strName)
				Set net = Nothing
			
				If Err.Number <> 0 Then
					SetDefaultPrinter = Err.Description
				Else
					SetDefaultPrinter = ""
				End If

			End Function

		'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
		'	Property Procedures
		'
			Function Get_NetworkDriveCount()

				Dim net : Set net = CreateObject("WScript.Network")
				Dim netDrives : Set netDrives = net.EnumNetworkDrives

				Get_NetworkDriveCount = (netDrives.Count / 2)

				Set netDrives = Nothing
				Set net = Nothing

			End Function
			Function Get_ConnectedPrinterCount()
				
				Dim net : Set net = CreateObject("WScript.Network")
				Dim prnt : Set prnt = net.EnumPrinterConnections()
				Get_ConnectedPrinterCount = (prnt.Count / 2)
				Set prnt = Nothing
				Set net = Nothing

			End Function				
		'''''''''''''''''''''''''''''''''''''''''''''''''''''''
		' Data validation functions used to check the validity
		' of passed in Parameters.
		'
			Function CheckString( s )
				If VarType(s) <> vbString Then
					CheckString = ""
				ElseIf Trim(s) = "" Then
					CheckString = ""
				Else
					CheckString = s
				End If
			End Function

			Function CheckBool( b )
				If VarType(b) <> vbBoolean Then
					If VarType(b) = vbString Then
						If b = "True" Or b = "true" Then
							CheckBool = True
						Else
							CheckBool = False
						End If
					ElseIf IsNumeric(b) Then
						If b <> 0 Then 
							CheckBool = True
						Else
							CheckBool = False
						End If
					Else
						CheckBool = False
					End If
				Else
					CheckBool = b
				End If
			End Function
]]>
		</script>

	</component>


 

Aaron L. Stephanus Do YOU want YOUR choice of a FREE laptop ?