Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for chkpath.vbs

(view source code of chkpath.vbs as plain text)

  1. Option Explicit
  2.  
  3. Dim arrDedup, arrDup, arrPATH, dicDriveTypes
  4. Dim blnLocal, blnVerbose
  5. Dim i, intArgs
  6. Dim wshNetwork
  7. Dim strComputer, strLocalHost, strScriptVer
  8.  
  9. strScriptVer = "2.11"
  10.  
  11. Set wshNetwork = CreateObject( "WScript.Network" )
  12. strLocalHost = UCase( wshNetwork.ComputerName )
  13. Set wshNetwork = Nothing
  14.  
  15. blnLocal    = False
  16. blnVerbose  = False
  17. strComputer = strLocalHost
  18.  
  19. With WScript.Arguments.Named
  20. 	intArgs = 0
  21. 	If .Exists( "V" ) Then
  22. 		blnVerbose = True
  23. 		intArgs    = intArgs + 1
  24. 	End If
  25. 	If .Exists( "L" ) Then
  26. 		blnLocal = True
  27. 		intArgs  = intArgs + 1
  28. 	End If
  29. 	If Not intArgs = .Count Then Syntax
  30. End With
  31.  
  32. With WScript.Arguments.Unnamed
  33. 	If .Count = 0 Then
  34. 		CheckPath strComputer, True
  35. 		CheckPath strComputer, False
  36. 	Else
  37. 		For i = 0 To .Count - 1
  38. 			If Ping( .Item(i) ) Then
  39. 				strComputer = UCase( ComputerName( .Item(i) ) )
  40. 				' Always check System PATH
  41. 				CheckPath strComputer, True
  42. 				' Check User PATH only on local computer
  43. 				If strComputer = strLocalHost Then CheckPath strComputer, False
  44. 			End If
  45. 		Next
  46. 	End If
  47. End With
  48.  
  49.  
  50.  
  51.  
  52. Sub CheckPath( myComputer, isSysVar )
  53. 	Dim dicPATH
  54. 	Dim intCommaPos, intDriveType, intDuplicate, intEmpty, intInvalid, intMaxLen, intMaxExp, intRemovable
  55. 	Dim colInstances, objFSO, objInstance, objWMIService, wshShell
  56. 	Dim strConnect, strDriveType, strErrors, strExp, strKey, strKeyU, strMsg, strPATH, strQuery, strResult, strUserName, strVal, strValU, strVarType, strVerify
  57.  
  58. 	intDuplicate = 0
  59. 	intEmpty     = 0
  60. 	intInvalid   = 0
  61. 	intMaxLen    = 0
  62. 	intMaxExp    = 0
  63. 	intRemovable = 0
  64. 	strMsg       = ""
  65.  
  66. 	strConnect = "winmgmts://" & myComputer & "/root/CIMV2"
  67. 	If isSysVar Then
  68. 		strQuery   = "SELECT * FROM Win32_Environment WHERE Name=""PATH"" And SystemVariable=TRUE"
  69. 		strVarType = "System"
  70. 	Else
  71. 		strUserName = Replace( UserName( myComputer ), "\", "\\" )
  72. 		strQuery    = "SELECT * FROM Win32_Environment WHERE Caption=""" & strUserName & "\\PATH"" And SystemVariable=FALSE"
  73. 		strVarType  = "User"
  74. 	End If
  75.  
  76. 	' Dictionary object to store the drive type for each drive letter
  77. 	Set dicDriveTypes = CreateObject( "Scripting.Dictionary" )
  78. 	dicDriveTypes.RemoveAll
  79.  
  80. '	On Error Resume Next
  81.  
  82. 	Set objWMIService = GetObject( strConnect )
  83. 	If Err Then
  84. 		WScript.Echo myComputer & ":" & vbTab & "Error connecting to WMI service"
  85. 	Else
  86. 		Set colInstances  = objWMIService.ExecQuery( strQuery )
  87. 		If Err Then
  88. 			WScript.Echo myComputer & ":" & vbTab & "Error retrieving WMI data"
  89. 		Else
  90. 			If colInstances.Count = 1 Then
  91. 				Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  92. 				Set wshShell = CreateObject( "WScript.Shell" )
  93. 				Set dicPATH  = CreateObject( "Scripting.Dictionary" )
  94.  
  95. 				' Read the PATH variable
  96. 				For Each objInstance In colInstances
  97. 					strPATH = objInstance.VariableValue
  98. 				Next
  99. 				' Determine the entries' maximum length
  100. 				For Each strVal In Split( strPATH, ";" )
  101. 					If Len( strVal ) > intMaxLen Then
  102. 						intMaxLen = Len( strVal )
  103. 					End If
  104. 					If InStr( strVal, "%" ) > 0 Then
  105. 						If Len( wshShell.ExpandEnvironmentStrings( strVal ) ) > intMaxExp Then
  106. 							intMaxExp = Len( wshShell.ExpandEnvironmentStrings( strVal ) )
  107. 						End If
  108. 					End If
  109. 				Next
  110. 				intMaxLen = intMaxLen + 2
  111. 				intMaxExp = intMaxExp + 2
  112. 				If blnVerbose Then
  113. 					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & strVarType & " PATH entries:" & vbCrLf
  114. 					If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
  115. 						strMsg = strMsg & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strVarType ) + 14, "=" ) & vbCrLf
  116. 					End If
  117. 				End If
  118. 				' Split it into separate entries and add these to the dictionary object
  119. 				For Each strVal In Split( strPATH, ";" )
  120. 					If Len( Trim( strVal ) ) = 0 Then
  121. 						intEmpty = intEmpty + 1
  122. 					Else
  123. 						strKey       = wshShell.ExpandEnvironmentStrings( strVal )
  124. 						strKeyU      = UCase( strKey )
  125. 						strValU      = UCase( strVal )
  126. 						intDriveType = DriveTypeInt( myComputer, strVal )
  127. 						strDriveType = DriveTypeStr( intDriveType )
  128. 						If strKeyU = strValU Then
  129. 							strExp = ""
  130. 						Else
  131. 							strExp = "=>  """ & strKey & """"
  132. 						End If
  133. 						strVerify = Pad( strVal, intMaxLen + 4, """", """" ) & Pad( strExp, intMaxExp + 8, "", "" ) & Pad( strDriveType, 18, "(", ")" )
  134. 						strResult = "OK"
  135. 						If intDriveType <> 3 And intDriveType <> 6 Then
  136. 							If blnLocal Then
  137. 								strMsg    = strMsg & """" & strVal & """ is not on a local fixed disk" & vbCrLf
  138. 								strResult = "ERROR: not a local fixed disk"
  139. 								intInvalid = intInvalid + 1
  140. 							Else
  141. 								strResult = "WARNING: not a local fixed disk"
  142. 							End If
  143. 						ElseIf Trim( strKey ) = "" Then
  144. 							strMsg     = strMsg & "Invalid entry in " & strVarType & " PATH: """ & strVal & """" & vbCrLf
  145. 							strResult  = "ERROR: empty"
  146. 							intInvalid = intInvalid + 1
  147. 						ElseIf objFSO.FolderExists( strKey ) Then
  148. 							If dicPATH.Exists( strKeyU ) Then
  149. 								intDuplicate = intDuplicate + 1
  150. 								If UCase( dicPATH.Item( strKeyU ) ) = strValU Then
  151. 									strMsg    = strMsg & "Duplicate entry in " & strVarType & " PATH: """ & strVal & """" & vbCrLf
  152. 									strResult = "ERROR: duplicate"
  153. 								Else
  154. 									strMsg    = strMsg & "Duplicate expanded entries in " & strVarType & " PATH: """ & dicPATH.Item( strKeyU ) & """ and """ & strVal & """" & vbCrLf
  155. 									strResult = "ERROR: duplicate"
  156. 								End If
  157. 								If Not strKeyU = strValU Then
  158. 									dicPATH.Item( strKeyU ) = strVal
  159. 									strResult = "ERROR: duplicate"
  160. 								End If
  161. 							Else
  162. 								dicPATH.Add strKeyU, strVal
  163. 							End If
  164. 						Else
  165. 							strMsg     = strMsg & "Invalid entry in " & strVarType & " PATH: """ & strVal & """" & vbCrLf
  166. 							strResult  = "ERROR: folder not found"
  167. 							intInvalid = intInvalid + 1
  168. 						End If
  169. 						strVerify = strVerify & "(" & strResult & ")"
  170. 						If blnVerbose Then
  171. 							strMsg = strMsg & myComputer & ":" & vbTab & strVerify & vbCrLf
  172. 						End If
  173. 					End If
  174. 				Next
  175. 				' Check if any corrections should be made
  176. 				If intDuplicate + intEmpty + intInvalid = 0 Then
  177. 					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
  178. 						strMsg = strMsg & vbCrLf & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strVarType ) + 65, "=" )
  179. 					End If
  180. 					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & "No duplicate or empty entries, nor invalid folders found in " & strVarType & " PATH" & vbCrLf
  181. 					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
  182. 						strMsg = strMsg & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strVarType ) + 65, "=" ) & vbCrLf
  183. 					End If
  184. 				Else
  185. 					' Display the suggested correction(s)
  186. 					strErrors = intDuplicate & " duplicate, " & intEmpty & " empty and " & intInvalid & " invalid entries found in " & strVarType & " PATH"
  187. 					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
  188. 						strMsg = strMsg & vbCrLf & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strErrors ), "=" )
  189. 					End If
  190. 					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & strErrors & vbCrLf
  191. 					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
  192. 						strMsg = strMsg & String( Len( myComputer ) + 1, "=" ) & vbTab & String( Len( strErrors ), "=" ) & vbCrLf
  193. 					End If
  194. 					strMsg = strMsg _
  195. 					       & vbCrLf _
  196. 					       & myComputer & ":" & vbTab & "Current   " & strVarType & " PATH: " & strPATH _
  197. 					       & vbCrLf & vbCrLf _
  198. 					       & myComputer & ":" & vbTab & "Suggested " & strVarType & " PATH: " & Join( dicPATH.Items, ";" ) _
  199. 					       & vbCrLf
  200. 					' Ask for confirmation
  201. 					WScript.Echo strMsg
  202. 					strMsg = ""
  203. 					If Confirm( "Do you want to apply the suggested changes to " & myComputer & "'s " & strVarType & " PATH? [yN]" ) Then
  204. 						For Each objInstance In colInstances
  205. 							' Set the new PATH value
  206. 							objInstance.VariableValue = Join( dicPATH.Items, ";" )
  207. 							' Apply the changes permanently
  208. 							objInstance.Put_
  209. 							' Display the result
  210. 							strMsg = vbCrLf _
  211. 							       & myComputer & ":" & vbTab & "Old " & strVarType & " PATH: " & strPATH _
  212. 							       & vbCrLf _
  213. 							       & myComputer & ":" & vbTab & "New " & strVarType & " PATH: " & objInstance.VariableValue _
  214. 							       & vbCrLf
  215. 						Next
  216. 					End If
  217. 				End If
  218.  
  219. 				Set dicPATH  = Nothing
  220. 				Set wshShell = Nothing
  221. 				Set objFSO   = Nothing
  222. 			Else
  223. 				' Display error message
  224. 				If isSysVar Then
  225. 					' System PATH should NEVER be empty
  226. 					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & "Error retrieving System PATH"
  227. 					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
  228. 						strMsg = strMsg & vbCrLf & String( Len( myComputer ) + 1, "=" ) & vbTab & String( 28, "=" ) & vbCrLf
  229. 					End If
  230. 				Else
  231. 					' User PATH may be empty
  232. 					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
  233. 						strMsg = strMsg & String( Len( myComputer ) + 1, "=" ) & vbTab & String( 22, "=" )
  234. 					End If
  235. 					strMsg = strMsg & vbCrLf & myComputer & ":" & vbTab & "The User PATH is empty"
  236. 					If blnVerbose And UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
  237. 						strMsg = strMsg & vbCrLf & String( Len( myComputer ) + 1, "=" ) & vbTab & String( 22, "=" ) & vbCrLf
  238. 					End If
  239. 				End If
  240. 			End If
  241. 		End If
  242. 		Set colInstances  = Nothing
  243. 	End If
  244. 	Set objWMIService = Nothing
  245. '	Set dicDriveTypes = Nothing
  246.  
  247. 	If Not strMsg = "" Then WScript.Echo strMsg
  248.  
  249. 	On Error Goto 0
  250. End Sub
  251.  
  252.  
  253.  
  254.  
  255. Function ComputerName( myAddress )
  256. 	Dim colInstances, objInstance, objWMIService
  257. 	ComputerName = myAddress
  258. '	On Error Resume Next
  259. 	Set objWMIService = GetObject( "winmgmts://" & myAddress & "/root/CIMV2" )
  260. 	Set colInstances  = objWMIService.ExecQuery( "SELECT * FROM Win32_OperatingSystem" )
  261. 	If colInstances.Count = 1 Then
  262. 		For Each objInstance In colInstances
  263. 			ComputerName = objInstance.CSName
  264. 		Next
  265. 	End If
  266. 	Set colInstances  = Nothing
  267. 	Set objWMIService = Nothing
  268. 	On Error Goto 0
  269. End Function
  270.  
  271.  
  272.  
  273.  
  274. Function Confirm( myPrompt )
  275. 	' Ask a question, return TRUE if answer was Y
  276. 	Dim intAnswer, strAnswer, strEngine
  277. 	Confirm = False
  278. 	strEngine = UCase( Right( WScript.FullName, 12 ) )
  279. 	If strEngine = "\CSCRIPT.EXE" Then
  280. 		' In CSCRIPT we can use Standard Input and Output
  281. 		WScript.StdOut.Write myPrompt & " "
  282. 		strAnswer = UCase( WScript.StdIn.Read(1) )
  283. 		If strAnswer = "Y" Then Confirm = True
  284. 	Else
  285. 		' In other scripting engines we need a MessageBox
  286. 		intAnswer = MsgBox( myPrompt, vbYesNoCancel, "Please Confirm" )
  287. 		If intAnswer = vbYes Then Confirm = True
  288. 	End If
  289. End Function
  290.  
  291.  
  292.  
  293.  
  294. Function DriveTypeInt( myComputer, myPath )
  295. 	Dim intDriveType
  296. 	Dim colInstance, colInstances, objInstance, objRE, objWMIService, wshShell
  297. 	Dim strConnect, strDeviceID, strPath, strQuery
  298.  
  299. 	intDriveType = 0
  300.  
  301. 	Set WshShell = CreateObject( "WScript.Shell" )
  302. 	strPath = wshShell.ExpandEnvironmentStrings( myPath )
  303. 	Set WshShell = Nothing
  304.  
  305. 	If Left( strPath, 2 ) = "\\" Then
  306. 		intDriveType = 7
  307. 	Else
  308. 		strDeviceID = UCase( Left( strPath, 2 ) )
  309. 		Set objRE = New RegExp
  310. 		objRE.Pattern = "^[A-Z]:$"
  311. 		If objRE.Test( strDeviceID ) Then
  312. 			If dicDriveTypes.Exists( strDeviceID ) Then
  313. 				intDriveType = dicDriveTypes.Item( strDeviceID )
  314. 			Else
  315. 				strConnect = "winmgmts://" & myComputer & "/root/CIMV2"
  316. 				strQuery   = "SELECT * FROM Win32_LogicalDisk WHERE DeviceID=""" & strDeviceID & """"
  317. '				On Error Resume Next
  318. 				Set objWMIService = GetObject( strConnect )
  319. 				Set colInstances  = objWMIService.ExecQuery( strQuery )
  320. 				If colInstances.Count > 0 Then
  321. 					For Each objInstance In colInstances
  322. 						intDriveType = objInstance.DriveType
  323. 					Next
  324. 				End If
  325. 				On Error Goto 0
  326. 				dicDriveTypes.Item( strDeviceID ) = intDriveType
  327. 				Set colInstances  = Nothing
  328. 				Set objWMIService = Nothing
  329. 			End If
  330. 		End If
  331. 		Set objRE = Nothing
  332. 	End If
  333. 	DriveTypeInt = intDriveType
  334. End Function
  335.  
  336.  
  337.  
  338.  
  339. Function DriveTypeStr( intDriveType )
  340. 	Dim strDriveType
  341. 	Select Case intDriveType
  342. 		Case 2:
  343. 			strDriveType = "Removable Disk"
  344. 		Case 3:
  345. 			strDriveType = "Local Disk"
  346. 		Case 4:
  347. 			strDriveType = "Network Drive"
  348. 		Case 5:
  349. 			strDriveType = "Compact Disc"
  350. 		Case 6:
  351. 			strDriveType = "RAM Disk"
  352. 		Case 7:
  353. 			strDriveType = "UNC Path"
  354. 		Case Else:
  355. 			strDriveType = "Unknown"
  356. 	End Select
  357. 	DriveTypeStr = strDriveType
  358. End Function
  359.  
  360.  
  361.  
  362.  
  363. Function Pad( myString, myLength, myPrefix, mySuffix )
  364. 	Pad = Left( myPrefix & myString & mySuffix & Space( myLength ), myLength )
  365. End Function
  366.  
  367.  
  368.  
  369.  
  370. Function Ping( myHost )
  371. 	' Try to PING a computer, return TRUE on success
  372. 	Dim objPing
  373. 	Ping = False
  374. '	On Error Resume Next
  375. 	Set objPing = GetObject( "winmgmts:" ).Get( "Win32_PingStatus.Address='" & myHost & "'" )
  376. 	If objPing.StatusCode = 0 Then Ping = True
  377. 	Set objPing = Nothing
  378. 	On Error Goto 0
  379. End Function
  380.  
  381.  
  382.  
  383.  
  384. Sub Syntax( )
  385. 	Dim strMsg
  386. 	strMsg = strMsg & vbCrLf _
  387. 	       & "ChkPath.vbs,  Version " & strScriptVer _
  388. 	       & vbCrLf _
  389. 	       & "Check the PATH variable for duplicate, empty or invalid entries," _
  390. 	       & vbCrLf _
  391. 	       & "and correct any errors found (after prompting for confimation)" _
  392. 	       & vbCrLf & vbCrLf _
  393. 	       & "Usage:   CSCRIPT.EXE CHKPATH.VBS [ ""computer"" [ ""computer"" [...] ] ] [ options ]" _
  394. 	       & vbCrLf & vbCrLf _
  395. 	       & "Where:   ""computer""  optional name(s) or address(es) of computer(s) to be" _
  396. 	       & vbCrLf _
  397. 	       & "                     investigated (default: local computer only)" _
  398. 	       & vbCrLf _
  399. 	       & "Options: /L          allow only Local non-removable drives in PATH" _
  400. 	       & vbCrLf _
  401. 	       & "                     (regard removables and UNC paths as invalid)" _
  402. 	       & vbCrLf _
  403. 	       & "         /V          Verbose output (show individual entries in PATH)" _
  404. 	       & vbCrLf & vbCrLf _
  405. 	       & "Notes:   The System PATH will be checked on all specified computers." _
  406. 	       & vbCrLf _
  407. 	       & "         On the local computer, the current user's User PATH will be checked too." _
  408. 	       & vbCrLf _
  409. 	       & "         If duplicate, empty or invalid entries are found, the script will prompt" _
  410. 	       & vbCrLf _
  411. 	       & "         for confirmation before correcting the errors." _
  412. 	       & vbCrLf & vbCrLf _
  413. 	       & "Written by Rob van der Woude" _
  414. 	       & vbCrLf _
  415. 	       & "http://www.robvanderwoude.com"
  416. 	WScript.Echo strMsg
  417. 	WScript.Quit 1
  418. End Sub
  419.  
  420.  
  421.  
  422.  
  423. Function UserName( myComputer )
  424. 	Dim colInstance, colInstances, objWMIService
  425. 	Dim strConnect, strQuery, strUserName
  426. 	strConnect  = "winmgmts://" & myComputer & "/root/CIMV2"
  427. 	strQuery    = "SELECT * FROM Win32_ComputerSystem"
  428. 	strUserName = ""
  429. '	On Error Resume Next
  430. 	Set objWMIService = GetObject( strConnect )
  431. 	If Err Then
  432. 		WScript.Echo myComputer & ":" & vbTab & "Error connecting to WMI service"
  433. 	Else
  434. 		Set colInstances  = objWMIService.ExecQuery( strQuery )
  435. 		If Err Then
  436. 			WScript.Echo myComputer & ":" & vbTab & "Error retrieving WMI data"
  437. 		Else
  438. 			For Each colInstance In colInstances
  439. 				strUserName = colInstance.UserName
  440. 			Next
  441. 		End If
  442. 	End If
  443. 	Set colInstances  = Nothing
  444. 	Set objWMIService = Nothing
  445. 	On Error Goto 0
  446. 	UserName = strUserName
  447. End Function
  448.  

page last uploaded: 2018-12-04, 10:47