Source code for chkpath.vbs

```
Option Explicit
```
```
 
```

Dim arrDedup, arrDup, arrPATH, dicDriveTypes

```
Dim blnLocal, blnVerbose
```
```
Dim i, intArgs
```
```
Dim wshNetwork
```

Dim strComputer, strLocalHost, strScriptVer

```
 
```
```
strScriptVer = "2.11"
```
```
 
```

Set wshNetwork = CreateObject( "WScript.Network" )

strLocalHost = UCase( wshNetwork.ComputerName )

```
Set wshNetwork = Nothing
```
```
 
```
```
blnLocal    = False
```
```
blnVerbose  = False
```
```
strComputer = strLocalHost
```
```
 
```
```
With WScript.Arguments.Named
```
```
	intArgs = 0
```
```
	If .Exists( "V" ) Then
```
```
		blnVerbose = True
```
```
		intArgs    = intArgs + 1
```
```
	End If
```
```
	If .Exists( "L" ) Then
```
```
		blnLocal = True
```
```
		intArgs  = intArgs + 1
```
```
	End If
```
```
	If Not intArgs = .Count Then Syntax
```
```
End With
```
```
 
```
```
With WScript.Arguments.Unnamed
```
```
	If .Count = 0 Then
```
```
		CheckPath strComputer, True
```
```
		CheckPath strComputer, False
```
```
	Else
```
```
		For i = 0 To .Count - 1
```
```
			If Ping( .Item(i) ) Then
```

				strComputer = UCase( ComputerName( .Item(i) ) )

```
				' Always check System PATH
```
```
				CheckPath strComputer, True
```

				' Check User PATH only on local computer

				If strComputer = strLocalHost Then CheckPath strComputer, False

```
			End If
```
```
		Next
```
```
	End If
```
```
End With
```
```
 
```
```
 
```
```
 
```
```
 
```
```
Sub CheckPath( myComputer, isSysVar )
```
```
	Dim dicPATH
```

	Dim intCommaPos, intDriveType, intDuplicate, intEmpty, intInvalid, intMaxLen, intMaxExp, intRemovable

	Dim colInstances, objFSO, objInstance, objWMIService, wshShell

	Dim strConnect, strDriveType, strErrors, strExp, strKey, strKeyU, strMsg, strPATH, strQuery, strResult, strUserName, strVal, strValU, strVarType, strVerify

```
 
```
```
	intDuplicate = 0
```
```
	intEmpty     = 0
```
```
	intInvalid   = 0
```
```
	intMaxLen    = 0
```
```
	intMaxExp    = 0
```
```
	intRemovable = 0
```
```
	strMsg       = ""
```
```
 
```

	strConnect = "winmgmts://" & myComputer & "/root/CIMV2"

```
	If isSysVar Then
```

		strQuery   = "SELECT * FROM Win32_Environment WHERE Name=""PATH"" And SystemVariable=TRUE"

```
		strVarType = "System"
```
```
	Else
```

		strUserName = Replace( UserName( myComputer ), "\", "\\" )

		strQuery    = "SELECT * FROM Win32_Environment WHERE Caption=""" & strUserName & "\\PATH"" And SystemVariable=FALSE"

```
		strVarType  = "User"
```
```
	End If
```
```
 
```

	' Dictionary object to store the drive type for each drive letter

	Set dicDriveTypes = CreateObject( "Scripting.Dictionary" )

```
	dicDriveTypes.RemoveAll
```
```
 
```
```
'	On Error Resume Next
```
```
 
```

	Set objWMIService = GetObject( strConnect )

```
	If Err Then
```

		WScript.Echo myComputer & ":" & vbTab & "Error connecting to WMI service"

```
	Else
```

		Set colInstances  = objWMIService.ExecQuery( strQuery )

```
		If Err Then
```

			WScript.Echo myComputer & ":" & vbTab & "Error retrieving WMI data"

```
		Else
```
```
			If colInstances.Count = 1 Then
```

				Set objFSO   = CreateObject( "Scripting.FileSystemObject" )

				Set wshShell = CreateObject( "WScript.Shell" )

				Set dicPATH  = CreateObject( "Scripting.Dictionary" )

```
 
```
```
				' Read the PATH variable
```

				For Each objInstance In colInstances

					strPATH = objInstance.VariableValue

```
				Next
```

				' Determine the entries' maximum length

				For Each strVal In Split( strPATH, ";" )

```
					If Len( strVal ) > intMaxLen Then
```
```
						intMaxLen = Len( strVal )
```
```
					End If
```
```
					If InStr( strVal, "%" ) > 0 Then
```

						If Len( wshShell.ExpandEnvironmentStrings( strVal ) ) > intMaxExp Then

							intMaxExp = Len( wshShell.ExpandEnvironmentStrings( strVal ) )

```
						End If
```
```
					End If
```
```
				Next
```
```
				intMaxLen = intMaxLen + 2
```
```
				intMaxExp = intMaxExp + 2
```
```
				If blnVerbose Then
```

					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & strVarType & " PATH entries:" & vbCrLf

					If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then

						strMsg = strMsg & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strVarType ) + 14, "=" ) & vbCrLf

```
					End If
```
```
				End If
```

				' Split it into separate entries and add these to the dictionary object

				For Each strVal In Split( strPATH, ";" )

```
					If Len( Trim( strVal ) ) = 0 Then
```
```
						intEmpty = intEmpty + 1
```
```
					Else
```

						strKey       = wshShell.ExpandEnvironmentStrings( strVal )

```
						strKeyU      = UCase( strKey )
```
```
						strValU      = UCase( strVal )
```

						intDriveType = DriveTypeInt( myComputer, strVal )

						strDriveType = DriveTypeStr( intDriveType )

```
						If strKeyU = strValU Then
```
```
							strExp = ""
```
```
						Else
```

							strExp = "=>  """ & strKey & """"

```
						End If
```

						strVerify = Pad( strVal, intMaxLen + 4, """", """" ) & Pad( strExp, intMaxExp + 8, "", "" ) & Pad( strDriveType, 18, "(", ")" )

```
						strResult = "OK"
```

						If intDriveType <> 3 And intDriveType <> 6 Then

```
							If blnLocal Then
```

								strMsg    = strMsg & """" & strVal & """ is not on a local fixed disk" & vbCrLf

								strResult = "ERROR: not a local fixed disk"

```
								intInvalid = intInvalid + 1
```
```
							Else
```

								strResult = "WARNING: not a local fixed disk"

```
							End If
```
```
						ElseIf Trim( strKey ) = "" Then
```

							strMsg     = strMsg & "Invalid entry in " & strVarType & " PATH: """ & strVal & """" & vbCrLf

```
							strResult  = "ERROR: empty"
```
```
							intInvalid = intInvalid + 1
```

						ElseIf objFSO.FolderExists( strKey ) Then

							If dicPATH.Exists( strKeyU ) Then

```
								intDuplicate = intDuplicate + 1
```

								If UCase( dicPATH.Item( strKeyU ) ) = strValU Then

									strMsg    = strMsg & "Duplicate entry in " & strVarType & " PATH: """ & strVal & """" & vbCrLf

```
									strResult = "ERROR: duplicate"
```
```
								Else
```

									strMsg    = strMsg & "Duplicate expanded entries in " & strVarType & " PATH: """ & dicPATH.Item( strKeyU ) & """ and """ & strVal & """" & vbCrLf

```
									strResult = "ERROR: duplicate"
```
```
								End If
```
```
								If Not strKeyU = strValU Then
```

									dicPATH.Item( strKeyU ) = strVal

```
									strResult = "ERROR: duplicate"
```
```
								End If
```
```
							Else
```
```
								dicPATH.Add strKeyU, strVal
```
```
							End If
```
```
						Else
```

							strMsg     = strMsg & "Invalid entry in " & strVarType & " PATH: """ & strVal & """" & vbCrLf

							strResult  = "ERROR: folder not found"

```
							intInvalid = intInvalid + 1
```
```
						End If
```

						strVerify = strVerify & "(" & strResult & ")"

```
						If blnVerbose Then
```

							strMsg = strMsg & myComputer & ":" & vbTab & strVerify & vbCrLf

```
						End If
```
```
					End If
```
```
				Next
```

				' Check if any corrections should be made

				If intDuplicate + intEmpty + intInvalid = 0 Then

					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then

						strMsg = strMsg & vbCrLf & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strVarType ) + 65, "=" )

```
					End If
```

					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & "No duplicate or empty entries, nor invalid folders found in " & strVarType & " PATH" & vbCrLf

					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then

						strMsg = strMsg & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strVarType ) + 65, "=" ) & vbCrLf

```
					End If
```
```
				Else
```

					' Display the suggested correction(s)

					strErrors = intDuplicate & " duplicate, " & intEmpty & " empty and " & intInvalid & " invalid entries found in " & strVarType & " PATH"

					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then

						strMsg = strMsg & vbCrLf & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strErrors ), "=" )

```
					End If
```

					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & strErrors & vbCrLf

					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then

						strMsg = strMsg & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strErrors ), "=" ) & vbCrLf

```
					End If
```
```
					strMsg = strMsg _
```
```
					       & vbCrLf _
```

					       & myComputer & ":" & vbTab & "Current   " & strVarType & " PATH: " & strPATH _

```
					       & vbCrLf & vbCrLf _
```

					       & myComputer & ":" & vbTab & "Suggested " & strVarType & " PATH: " & Join( dicPATH.Items, ";" ) _

```
					       & vbCrLf
```
```
					' Ask for confirmation
```
```
					WScript.Echo strMsg
```
```
					strMsg = ""
```

					If Confirm( "Do you want to apply the suggested changes to " & myComputer & "'s " & strVarType & " PATH? [yN]" ) Then

						For Each objInstance In colInstances

```
							' Set the new PATH value
```

							objInstance.VariableValue = Join( dicPATH.Items, ";" )

```
							' Apply the changes permanently
```
```
							objInstance.Put_
```
```
							' Display the result
```
```
							strMsg = vbCrLf _
```

							       & myComputer & ":" & vbTab & "Old " & strVarType & " PATH: " & strPATH _

```
							       & vbCrLf _
```

							       & myComputer & ":" & vbTab & "New " & strVarType & " PATH: " & objInstance.VariableValue _

```
							       & vbCrLf
```
```
						Next
```
```
					End If
```
```
				End If
```
```
 
```
```
				Set dicPATH  = Nothing
```
```
				Set wshShell = Nothing
```
```
				Set objFSO   = Nothing
```
```
			Else
```
```
				' Display error message
```
```
				If isSysVar Then
```

					' System PATH should NEVER be empty

					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & "Error retrieving System PATH"

					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then

						strMsg = strMsg & vbCrLf & String( Len( myComputer ) + 1, "=" ) & vbTab & String( 28, "=" ) & vbCrLf

```
					End If
```
```
				Else
```
```
					' User PATH may be empty
```

					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then

						strMsg = strMsg & String( Len( myComputer ) + 1, "=" ) & vbTab & String( 22, "=" )

```
					End If
```

					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & "The User PATH is empty"

					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then

						strMsg = strMsg & vbCrLf & String( Len( myComputer ) + 1, "=" ) & vbTab & String( 22, "=" ) & vbCrLf

```
					End If
```
```
				End If
```
```
			End If
```
```
		End If
```
```
		Set colInstances  = Nothing
```
```
	End If
```
```
	Set objWMIService = Nothing
```
```
'	Set dicDriveTypes = Nothing
```
```
 
```

	If Not strMsg = "" Then WScript.Echo strMsg

```
 
```
```
	On Error Goto 0
```
```
End Sub
```
```
 
```
```
 
```
```
 
```
```
 
```
```
Function ComputerName( myAddress )
```

	Dim colInstances, objInstance, objWMIService

```
	ComputerName = myAddress
```
```
'	On Error Resume Next
```

	Set objWMIService = GetObject( "winmgmts://" & myAddress & "/root/CIMV2" )

	Set colInstances  = objWMIService.ExecQuery( "SELECT * FROM Win32_OperatingSystem" )

```
	If colInstances.Count = 1 Then
```
```
		For Each objInstance In colInstances
```
```
			ComputerName = objInstance.CSName
```
```
		Next
```
```
	End If
```
```
	Set colInstances  = Nothing
```
```
	Set objWMIService = Nothing
```
```
	On Error Goto 0
```
```
End Function
```
```
 
```
```
 
```
```
 
```
```
 
```
```
Function Confirm( myPrompt )
```

	' Ask a question, return TRUE if answer was Y

```
	Dim intAnswer, strAnswer, strEngine
```
```
	Confirm = False
```

	strEngine = UCase( Right( WScript.FullName, 12 ) )

```
	If strEngine = "\CSCRIPT.EXE" Then
```

		' In CSCRIPT we can use Standard Input and Output

```
		WScript.StdOut.Write myPrompt & " "
```

		strAnswer = UCase( WScript.StdIn.Read(1) )

		If strAnswer = "Y" Then Confirm = True

```
	Else
```

		' In other scripting engines we need a MessageBox

		intAnswer = MsgBox( myPrompt, vbYesNoCancel, "Please Confirm" )

		If intAnswer = vbYes Then Confirm = True

```
	End If
```
```
End Function
```
```
 
```
```
 
```
```
 
```
```
 
```

Function DriveTypeInt( myComputer, myPath )

```
	Dim intDriveType
```

	Dim colInstance, colInstances, objInstance, objRE, objWMIService, wshShell

	Dim strConnect, strDeviceID, strPath, strQuery

```
 
```
```
	intDriveType = 0
```
```
 
```

	Set WshShell = CreateObject( "WScript.Shell" )

	strPath = wshShell.ExpandEnvironmentStrings( myPath )

```
	Set WshShell = Nothing
```
```
 
```
```
	If Left( strPath, 2 ) = "\\" Then
```
```
		intDriveType = 7
```
```
	Else
```

		strDeviceID = UCase( Left( strPath, 2 ) )

```
		Set objRE = New RegExp
```
```
		objRE.Pattern = "^[A-Z]:$"
```
```
		If objRE.Test( strDeviceID ) Then
```

			If dicDriveTypes.Exists( strDeviceID ) Then

				intDriveType = dicDriveTypes.Item( strDeviceID )

```
			Else
```

				strConnect = "winmgmts://" & myComputer & "/root/CIMV2"

				strQuery   = "SELECT * FROM Win32_LogicalDisk WHERE DeviceID=""" & strDeviceID & """"

```
'				On Error Resume Next
```

				Set objWMIService = GetObject( strConnect )

				Set colInstances  = objWMIService.ExecQuery( strQuery )

```
				If colInstances.Count > 0 Then
```

					For Each objInstance In colInstances

						intDriveType = objInstance.DriveType

```
					Next
```
```
				End If
```
```
				On Error Goto 0
```

				dicDriveTypes.Item( strDeviceID ) = intDriveType

```
				Set colInstances  = Nothing
```
```
				Set objWMIService = Nothing
```
```
			End If
```
```
		End If
```
```
		Set objRE = Nothing
```
```
	End If
```
```
	DriveTypeInt = intDriveType
```
```
End Function
```
```
 
```
```
 
```
```
 
```
```
 
```
```
Function DriveTypeStr( intDriveType )
```
```
	Dim strDriveType
```
```
	Select Case intDriveType
```
```
		Case 2:
```
```
			strDriveType = "Removable Disk"
```
```
		Case 3:
```
```
			strDriveType = "Local Disk"
```
```
		Case 4:
```
```
			strDriveType = "Network Drive"
```
```
		Case 5:
```
```
			strDriveType = "Compact Disc"
```
```
		Case 6:
```
```
			strDriveType = "RAM Disk"
```
```
		Case 7:
```
```
			strDriveType = "UNC Path"
```
```
		Case Else:
```
```
			strDriveType = "Unknown"
```
```
	End Select
```
```
	DriveTypeStr = strDriveType
```
```
End Function
```
```
 
```
```
 
```
```
 
```
```
 
```

Function Pad( myString, myLength, myPrefix, mySuffix )

	Pad = Left( myPrefix & myString & mySuffix & Space( myLength ), myLength )

```
End Function
```
```
 
```
```
 
```
```
 
```
```
 
```
```
Function Ping( myHost )
```

	' Try to PING a computer, return TRUE on success

```
	Dim objPing
```
```
	Ping = False
```
```
'	On Error Resume Next
```

	Set objPing = GetObject( "winmgmts:" ).Get( "Win32_PingStatus.Address='" & myHost & "'" )

	If objPing.StatusCode = 0 Then Ping = True

```
	Set objPing = Nothing
```
```
	On Error Goto 0
```
```
End Function
```
```
 
```
```
 
```
```
 
```
```
 
```
```
Sub Syntax( )
```
```
	Dim strMsg
```
```
	strMsg = strMsg & vbCrLf _
```

	       & "ChkPath.vbs,  Version " & strScriptVer _

```
	       & vbCrLf _
```

	       & "Check the PATH variable for duplicate, empty or invalid entries," _

```
	       & vbCrLf _
```

	       & "and correct any errors found (after prompting for confimation)" _

```
	       & vbCrLf & vbCrLf _
```

	       & "Usage:   CSCRIPT.EXE CHKPATH.VBS [ ""computer"" [ ""computer"" [...] ] ] [ options ]" _

```
	       & vbCrLf & vbCrLf _
```

	       & "Where:   ""computer""  optional name(s) or address(es) of computer(s) to be" _

```
	       & vbCrLf _
```

	       & "                     investigated (default: local computer only)" _

```
	       & vbCrLf _
```

	       & "Options: /L          allow only Local non-removable drives in PATH" _

```
	       & vbCrLf _
```

	       & "                     (regard removables and UNC paths as invalid)" _

```
	       & vbCrLf _
```

	       & "         /V          Verbose output (show individual entries in PATH)" _

```
	       & vbCrLf & vbCrLf _
```

	       & "Notes:   The System PATH will be checked on all specified computers." _

```
	       & vbCrLf _
```

	       & "         On the local computer, the current user's User PATH will be checked too." _

```
	       & vbCrLf _
```

	       & "         If duplicate, empty or invalid entries are found, the script will prompt" _

```
	       & vbCrLf _
```

	       & "         for confirmation before correcting the errors." _

```
	       & vbCrLf & vbCrLf _
```

	       & "Written by Rob van der Woude" _

```
	       & vbCrLf _
```

	       & "http://www.robvanderwoude.com"

```
	WScript.Echo strMsg
```
```
	WScript.Quit 1
```
```
End Sub
```
```
 
```
```
 
```
```
 
```
```
 
```
```
Function UserName( myComputer )
```

	Dim colInstance, colInstances, objWMIService

```
	Dim strConnect, strQuery, strUserName
```

	strConnect  = "winmgmts://" & myComputer & "/root/CIMV2"

	strQuery    = "SELECT * FROM Win32_ComputerSystem"

```
	strUserName = ""
```
```
'	On Error Resume Next
```

	Set objWMIService = GetObject( strConnect )

```
	If Err Then
```

		WScript.Echo myComputer & ":" & vbTab & "Error connecting to WMI service"

```
	Else
```

		Set colInstances  = objWMIService.ExecQuery( strQuery )

```
		If Err Then
```

			WScript.Echo myComputer & ":" & vbTab & "Error retrieving WMI data"

```
		Else
```
```
			For Each colInstance In colInstances
```
```
				strUserName = colInstance.UserName
```
```
			Next
```
```
		End If
```
```
	End If
```
```
	Set colInstances  = Nothing
```
```
	Set objWMIService = Nothing
```
```
	On Error Goto 0
```
```
	UserName = strUserName
```
```
End Function
```
```
 
```