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