Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for searchmsi.vbs

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

  1. Option Explicit
  2.  
  3. Dim blnLiteral, blnRegEx, blnValid
  4. Dim i
  5. Dim objFile, objFSO, objMSI, objMSIDB, objRE
  6. Dim strAllContent, strFolder, strFilter, strLine, strResult
  7.  
  8. Const msiOpenDatabaseModeReadOnly = 0 
  9. Const msiOpenDatabaseModeTransact = 1
  10. Const msiOpenDatabaseModeListScript = 5 
  11.  
  12. strFilter  = ""
  13. blnLiteral = False
  14. blnRegEx   = False
  15.  
  16. With WScript.Arguments
  17. 	If .Unnamed.Count = 0 Then Syntax
  18. 	If .Unnamed.Count > 0 Then
  19. 		strFolder = .Unnamed(0)
  20. 	End If
  21. 	If .Unnamed.Count > 1 Then Syntax
  22. 	If .Named.Count = 1 Then
  23. 		If .Named.Exists( "R" ) Then
  24. 			blnRegEx  = True
  25. 			strFilter = .Named( "R" )
  26. 		ElseIf .Named.Exists( "F" ) Then
  27. 			blnLiteral = True
  28. 			strFilter  = .Named( "F" )
  29. 		Else
  30. 			Syntax
  31. 		End If
  32. 	End If
  33. 	If .Named.Count > 1 Then Syntax
  34. End With
  35.  
  36. Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  37. Set objMSI = CreateObject( "WindowsInstaller.Installer" )
  38. If blnRegEx Then
  39. 	Set objRE  = New RegExp
  40. 	objRE.Pattern    = strFilter
  41. 	objRE.IgnoreCase = True
  42. End If
  43.  
  44. With objFSO
  45. 	If .FolderExists( strFolder ) Then
  46. 		strAllContent = SearchFolder( strFolder, "msi" )
  47. 		strResult     = ""
  48. 		For Each strLine In Split( strAllContent, vbCrLf )
  49. 			blnValid = False
  50. 			If Trim( strLine ) <> "" Then
  51. 				If blnLiteral Then
  52. 					If InStr( LCase( Split( strLine, vbTab )(1) ), LCase( strFilter ) ) Then
  53. 						blnValid = True
  54. 					End If
  55. 				ElseIf blnRegEx Then
  56. 					If objRE.Test( Split( strLine, vbTab )(1) ) Then
  57. 						blnValid = True
  58. 					End If
  59. 				Else
  60. 					blnValid = True
  61. 				End If
  62. 				If blnValid Then strResult = strResult & strLine & vbCrLf
  63. 			End If
  64. 		Next
  65. 	Else
  66. 		Syntax
  67. 	End If
  68. End With
  69.  
  70. WScript.Echo strResult
  71.  
  72. Set objRE  = Nothing
  73. Set objFSO = Nothing
  74. Set objMSI = Nothing
  75.  
  76.  
  77. Sub CheckError
  78. Dim strMsg, strErrorRecord
  79. If Err = 0 Then Exit Sub
  80. strMsg = Err.Source & " " & Hex(Err) & ": " & Err.Description
  81. If Not installer Is Nothing Then
  82. 	Set strErrorRecord = installer.LastErrorRecord
  83. 	If Not strErrorRecord Is Nothing Then
  84. 		strMsg = strMsg & vbCrLf & strErrorRecord.FormatText
  85. 	End If
  86. End If
  87. Wscript.Echo strMsg
  88. Wscript.Quit 2
  89. End Sub
  90.  
  91.  
  92. Function SearchFolder( strFolder, strExt )
  93. 	SearchFolder = ""
  94. 	Dim objFile, objFolder, strResult
  95. 	For Each objFile In objFSO.GetFolder( strFolder ).Files
  96. 		If LCase( objFSO.GetExtensionName( objFile.Name ) ) = LCase( strExt ) Then
  97. 			strResult = strResult & ViewMSIFile( objFile.Path ) & vbCrLf
  98. 		End If
  99. 	Next
  100. 	For Each objFolder In objFSO.GetFolder( strFolder ).SubFolders
  101. 		strResult = strResult & SearchFolder( objFolder.Path, strExt ) & vbCrLf
  102. 	Next
  103. 	SearchFolder = strResult
  104. End Function
  105.  
  106.  
  107. Function ViewMSIFile( strMSIFile )
  108. 	Dim objMSIDB, objRecord, objView, strResult
  109. 	ViewMSIFile = ""
  110. 	Set objMSIDB = objMSI.OpenDataBase( strMSIFile, msiOpenDatabaseModeReadOnly ) : CheckError
  111. 	Set objView =  objMsiDB.Openview( "Select FileName From File" ) : CheckError
  112. 	objView.Execute : CheckError
  113. 	Set objRecord = objView.Fetch
  114. 	strResult = ""
  115. 	Do Until objRecord Is Nothing
  116. 		If InStr( objRecord.StringData(1), "|" ) Then
  117. 			strResult = strResult & strMSIFile & vbTab & Split( objRecord.StringData(1), "|" )(1) & vbCrLf
  118. 		Else
  119. 			strResult = strResult & strMSIFile & vbTab & objRecord.StringData(1)
  120. 		End If
  121. 		Set objRecord = objView.Fetch
  122. 	Loop
  123. 	Set objRecord = Nothing
  124. 	Set objView   = Nothing
  125. 	Set objMSIDB  = Nothing
  126. 	ViewMSIFile = strResult
  127. End Function
  128.  
  129.  
  130. Sub Syntax
  131. 	Dim strMsg
  132. 	strMsg = vbCrLf _
  133. 	       & "SearchMSIs.vbs,  Version 1.01\n" _
  134. 	       & "List all MSI files in a folder and its subfolders,\n" _
  135. 	       & "and optionally search them for the specified file(s).\n\n" _
  136. 	       & "Usage:   CSCRIPT.EXE  //NoLogo  SearchMSIs.vbs  folder  [ /F:file | /R:regex ]\n\n" _
  137. 	       & "Where:   folder    is the ""root"" folder where the search starts\n" _
  138. 	       & "         /F:file   specifies (part of) the file name(s) to search for (literal)\n" _
  139. 	       & "         /R:regex  like /F:file, but using a regular expression instead of\n" _
  140. 	       & "                   a literal search string\n\n" _
  141. 	       & "Note:    DO use CSCRIPT.EXE rather than WSCRIPT.EXE, as the latter MAY\n" _
  142. 	       & "         not be able to handle the huge amount of output.\n\n" _
  143. 	       & "Credits: Based on ListMSI.vbs by Adriaan Westra\n" _
  144. 	       & "         http://www.westphil.nl/content/index.php?\n" _
  145. 	       & "         option=com_content&view=article&id=46&Itemid=64\n\n" _
  146. 	       & "Example: Find all MSI files in D:\WDK or its subfolders containing *devcon*\n" _
  147. 	       & "         CSCRIPT.EXE //NoLogo SearchMSIs.vbs D:\WDK /F:devcon\n\n" _
  148. 	       & "Resulting output:\n" _
  149. 	       & "         D:\WDK\setupsamples.msi       devcon.cpp\n" _
  150. 	       & "         D:\WDK\setupsamples.msi       devcon.h\n" _
  151. 	       & "         D:\WDK\setupsamples.msi       devcon.htm\n" _
  152. 	       & "         D:\WDK\setupsamples.msi       devcon.rc\n" _
  153. 	       & "         D:\WDK\setuptools_ia64fre.msi devcon.exe\n" _
  154. 	       & "         D:\WDK\setuptools_x64fre.msi  devcon.exe\n" _
  155. 	       & "         D:\WDK\setuptools_x86fre.msi  devcon.exe\n\n" _
  156. 	       & "Written by Rob van der Woude\n" _
  157. 	       & "http://www.robvanderwoude.com"
  158. 	WScript.Echo Replace( strMsg, "\n", vbCrLf )
  159. 	On Error Resume Next
  160. 	Set objRE  = Nothing
  161. 	Set objFSO = Nothing
  162. 	Set objMSI = Nothing
  163. 	On Error Goto 0
  164. 	WScript.Quit 1
  165. End Sub
  166.  

page last uploaded: 2017-07-06, 12:37