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

page last uploaded: 2017-04-06, 13:33