Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for getunins.vbs

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

  1. Option Explicit
  2.  
  3. Const HKEY_LOCAL_MACHINE = &H80000002
  4.  
  5. Dim arrSubKeys
  6. Dim bln64bit, blnFilter, blnRegEx, blnTab
  7. Dim i, int32bit, int64bit, intFound, intValid
  8. Dim colItems, colPings, objItem, objRE, objReg, objStatus, objWMIService
  9. Dim strComputer, strDateZZZ, strFilter, strHive, strKeyZZZ, strKeyPath
  10. Dim strMsg, strNameZZZ, strPrgZZZ, strQuery, strQuietUnstZZZ, strUninstallZZZ, strVersionZZZ
  11.  
  12. bln64bit   = False
  13. blnFilter  = False
  14. blnRegEx   = False
  15. int32bit   = 0
  16. int64bit   = 0
  17. strHive    = HKEY_LOCAL_MACHINE
  18. strMsg     = ""
  19.  
  20. With WScript.Arguments
  21. 	If .Unnamed.Count > 0 Then Syntax
  22. 	intValid = 0
  23. 	If .Named.Exists( "F" ) Then
  24. 		strFilter = .Named.Item( "F" )
  25. 		If strFilter = "" Then Syntax
  26. 		intValid  = intValid + 1
  27. 		blnFilter = True
  28. 		If .Named.Exists( "R" ) Then
  29. 			intValid  = intValid + 1
  30. 			blnRegEx  = True
  31. 			Set objRE = New RegExp
  32. 		End If
  33. 	End If
  34. 	If .Named.Exists( "M" ) Then
  35. 		intValid    = intValid + 1
  36. 		strComputer = Trim( .Named.Item( "M" ) )
  37. 		If strComputer = "" Then Syntax
  38. 	Else
  39. 		strComputer = "."
  40. 	End If
  41. 	If .Named.Exists( "T" ) Then
  42. 		intValid = intValid + 1
  43. 		blnTab   = True
  44. 	Else
  45. 		blnTab   = False
  46. 	End If
  47. 	If .Named.Count <> intValid Then Syntax
  48. End With
  49.  
  50. ' Use custom error handling, just in case the remote computer
  51. ' won't respond or this script runs on a Windows 2000 computer
  52. On Error Resume Next
  53.  
  54. Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
  55. Set colItems      = objWMIService.ExecQuery( "SELECT * FROM Win32_Processor", , 48 )
  56. For Each objItem in colItems
  57. 	If objItem.AddressWidth = 64 Then
  58. 		bln64bit = True
  59. 	End If
  60. Next
  61.  
  62. If strComputer <> "." Then
  63. 	strQuery = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
  64. 	Set colPings      = objWMIService.ExecQuery( strQuery )
  65. 	For Each objStatus in colPings
  66. 		If IsNull( objStatus.StatusCode ) Or objStatus.StatusCode <> 0 Then
  67. 			strMsg = "Computer " & strComputer & " did not respond." & vbCrLf
  68. 			Syntax
  69. 		End If
  70. 	Next
  71. 	Set colPings      = Nothing
  72. 	Set objWMIService = Nothing
  73. End If
  74.  
  75.  
  76. Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/default:StdRegProv" )
  77. If Err Then
  78. 	If strComputer = "." Then
  79. 		strMsg = "Error connecting to the local WMI Standard Registry Provider." & vbCrLf
  80. 	Else
  81. 		strMsg = "Error connecting to " & strComputer & "'s WMI StdReg Provider." & vbCrLf
  82. 	End If
  83. 	Syntax
  84. End If
  85.  
  86. On Error Goto 0
  87.  
  88. If blnTab Then
  89. 	strMsg = """Program Name""" & vbTab & """Program Version""" & vbTab & """Install Date""" & vbTab & """Unique Identifier""" & vbTab & """Uninstall String""" & vbCrLf
  90. End If
  91.  
  92. ' This is where uninstall info for 32-bit apps is stored in 32-bit
  93. ' Windows, or uninstall info for 64-bit apps in 64-bit Windows
  94. strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
  95. intFound   = 0
  96. strMsg     = strMsg & ListApps( strHive, strKeyPath )
  97.  
  98. ' 64-bit check, added after a tip by Christopher A. LaRue
  99. If bln64bit Then
  100. 	' This is where uninstall info for 32-bit apps is stored in 64-bit Windows
  101. 	strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
  102. 	int64bit = intFound
  103. 	intFound = 0
  104. 	strMsg   = strMsg & ListApps( strHive, strKeyPath )
  105. 	int32bit = intFound
  106. 	strMsg = strMsg & vbCrLf & "    " & int64bit & " 64-bit programs and " & int32bit & " 32-bit programs found"
  107. Else
  108. 	strMsg = strMsg & vbCrLf & "    " & intFound & " programs found"
  109. End If
  110.  
  111. WScript.Echo strMsg
  112.  
  113. Set objReg = Nothing
  114. Set objRE  = Nothing
  115.  
  116.  
  117. Function ListApps( myHive, myKeyPath )
  118. 	Dim arrSubKeys
  119. 	Dim strDate, strKey, strName, strPrg, strQuietUnst, strUninstall, strVersion
  120.  
  121. 	ListApps = ""
  122.  
  123. 	objReg.EnumKey myHive, myKeyPath, arrSubKeys
  124.  
  125. 	If UBound( arrSubKeys ) > -1 Then
  126. 		intFound = UBound( arrSubKeys ) + 1
  127.  
  128. 		For i = 0 To UBound( arrSubKeys )
  129. 			strDate      = ""
  130. 			strName      = ""
  131. 			strQuietUnst = ""
  132. 			strUninstall = ""
  133. 			strVersion   = ""
  134. 			strKey = myKeyPath & "\" & arrSubKeys(i)
  135. 			objReg.GetStringValue         myHive, strKey, "DisplayName",          strName
  136. 			objReg.GetStringValue         myHive, strKey, "DisplayVersion",       strVersion
  137. 			objReg.GetStringValue         myHive, strKey, "InstallDate",          strDate
  138. 			objReg.GetExpandedStringValue myHive, strKey, "UninstallString",      strUninstall
  139. 			objReg.GetExpandedStringValue myHive, strKey, "QuietUninstallString", strQuietUnst
  140. 			If Trim( strQuietUnst ) <> "" Then strUninstall = strQuietUnst
  141. 			If blnTab Then
  142. 				strPrg = """" & strName       & """" & vbTab _
  143. 				       & """" & strVersion    & """" & vbTab _
  144. 				       & """" & strDate       & """" & vbTab _
  145. 				       & """" & arrSubKeys(i) & """" & vbTab _
  146. 				       & """" & strUninstall  & """" & vbCrLf
  147. 			Else
  148. 				strPrg = "Program Name      = " & strName       & vbCrLf _
  149. 				       & "Program Version   = " & strVersion    & vbCrLf _
  150. 				       & "Install Date      = " & strDate       & vbCrLf _
  151. 				       & "Unique Identifier = " & arrSubKeys(i) & vbCrLf _ 
  152. 				       & "Uninstall String  = " & strUninstall  & vbCrLf & vbCrLf
  153. 			End If
  154. 			If Trim( strName ) <> "" Then
  155. 				If blnFilter Then
  156. 					If blnRegEx Then
  157. 						objRE.Global     = False
  158. 						objRE.IgnoreCase = True
  159. 						objRE.Pattern    = strFilter
  160. 						If objRE.Test( strName ) Then
  161. 							ListApps = ListApps & strPrg
  162. 						End If
  163. 					Else
  164. 						If InStr( 1, strName, strFilter, vbTextCompare ) Then
  165. 							ListApps = ListApps & strPrg
  166. 						End If
  167. 					End If
  168. 				Else
  169. 					ListApps = ListApps & strPrg
  170. 				End If
  171. 			End If
  172. 		Next
  173. 	End If
  174. End Function
  175.  
  176.  
  177. Sub Syntax
  178. 	strMsg = strMsg & vbCrLf _
  179. 	       & UCase( WScript.ScriptName ) & ",  Version 3.01" _
  180. 	       & vbCrLf _
  181. 	       & "List or search uninstall command lines" _
  182. 	       & vbCrLf & vbCrLf _
  183. 	       & "Usage: CSCRIPT.EXE //NoLogo " & UCase( WScript.ScriptName ) _
  184. 	       & " [/M:""computer""] [/F:""filter"" [/R]] [/T]" _
  185. 	       & vbCrLf & vbCrLf _
  186. 	       & "Where: /M:""computer""  specifies a remote computer to be queried" _
  187. 	       & vbCrLf _
  188. 	       & "                      (default is the local computer)" _
  189. 	       & vbCrLf _
  190. 	       & "       /F:""filter""    narrows down the search result to programs whose" _
  191. 	       & vbCrLf _
  192. 	       & "                      descriptive name contains the string ""filter""" _
  193. 	       & vbCrLf _
  194. 	       & "       /R             interprets the filter string as a regular expression" _
  195. 	       & vbCrLf _
  196. 	       & "       /T             displays tab delimited results (default: list)" _
  197. 	       & vbCrLf & vbCrLf _
  198. 	       & "Written by Rob van der Woude" _
  199. 	       & vbCrLf _
  200. 	       & "http://www.robvanderwoude.com"
  201. 	WScript.Echo strMsg
  202. 	WScript.Quit 1
  203. End Sub
  204.  

page last uploaded: 2017-08-21, 14:26