(view source code of getproductversion.vbs as plain text)
Option Explicit
Dim objFSO, strExt, strFile
If WScript.Arguments.Named.Count > 0 Then Syntax
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
With WScript.Arguments.Unnamed
If .Count = 1 Then
strFile = objFSO.GetAbsolutePathName( .Item(0) )
If objFSO.FileExists( strFile ) Then
strExt = LCase( objFSO.GetExtensionName( strFile ) )
If strExt = "hta" Then
WScript.Echo GetHTAVersion( strFile )
ElseIf strExt = "msi" Then
WScript.Echo GetMSIProductVersion( strFile )
Else
WScript.Echo GetProductVersion( strFile )
End If
Else
Syntax
End If
Else
Syntax
End If
End With
Set objFSO = Nothing
Function GetHTAVersion( myHTA )
Dim objHTA, objMatch, objMatches, objRE, strHTA, strVer
strVer = ""
Set objHTA = objFSO.OpenTextFile( myHTA )
strHTA = objHTA.ReadAll( )
objHTA.Close
Set objHTA = Nothing
Set objRE = New RegExp
objRE.Global = True
objRE.IgnoreCase = True
objRE.Pattern = "<HTA:APPLICATION[^>]+VERSION=""([^""]*)""[^>]*/>"
If objRE.Test( strHTA ) Then
Set objMatches = objRE.Execute( strHTA )
If objMatches.Count > 0 Then
If objMatches(0).Submatches.Count > 0 Then
GetHTAVersion = objMatches.Item(0).Submatches(0)
End If
End If
Set objMatches = Nothing
End If
Set objRE = Nothing
End Function
Function GetMSIProductVersion( myFile )
' Code by Arnout Grootveld
' http://stackoverflow.com/a/328710
Const msiOpenDatabaseModeReadOnly = 0
Dim objMSI, objDB, objView, strVersion
GetMSIProductVersion = ""
Set objMSI = CreateObject( "WindowsInstaller.Installer" )
Set objDB = objMSI.OpenDataBase( myFile, msiOpenDatabaseModeReadOnly )
Set objView = objDB.OpenView( "SELECT `Value` FROM `Property` WHERE `Property` = 'ProductVersion'" )
Call objView.Execute( )
strVersion = objView.Fetch( ).StringData(1)
' Replace commas by dots
strVersion = Replace( strVersion, ",", "." )
' Remove spaces
strVersion = Replace( strVersion, " ", "" )
GetMSIProductVersion = strVersion
End Function
Function GetProductVersion( myFile )
' Based on code by Maputi on StackOverflow.com:
' http://stackoverflow.com/a/2990698
Dim arrTranslations
Dim i
Dim objFolder, objFolderItem, objShell
Dim strFileName, strPropertyName, strParentFolder, strVersion
' Note that property names are language dependent, so you may have to add the lower case property name for your own language
Set arrTranslations = CreateObject( "System.Collections.ArrayList" )
arrTranslations.Add "product version" ' English
arrTranslations.Add "productversie" ' Dutch
strVersion = ""
strFileName = objFSO.GetFileName( myFile )
strParentFolder = objFSO.GetParentFolderName( myFile )
Set objShell = CreateObject( "Shell.Application" )
Set objFolder = objShell.Namespace( strParentFolder )
Set objFolderItem = objFolder.ParseName( strFileName )
For i = 0 To 300
strPropertyName = objFolder.GetDetailsOf( objFolder.Items, i )
If arrTranslations.Contains( LCase( strPropertyName ) ) Then
' Product Version
strVersion = objFolder.GetDetailsOf( objFolderItem, i )
If strVersion = "" Then
' File Version
strVersion = objFSO.GetFileVersion( myFile )
End If
Exit For
End If
Next
Set objFolderItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing
Set arrTranslations = Nothing
' Replace commas by dots
strVersion = Replace( strVersion, ",", "." )
' Remove spaces
strVersion = Replace( strVersion, " ", "" )
GetProductVersion = strVersion
End Function
Sub Syntax
Dim strMsg
strMsg = "GetProductVersion.vbs, Version 1.02" _
& vbCrLf _
& "Return the product version for a specified file (dll, exe, hta or msi)" _
& vbCrLf & vbCrLf _
& "Usage: CSCRIPT.EXE //NoLogo GetProductVersion.vbs filename" _
& vbCrLf & vbCrLf _
& "Where: ""filename"" is the file whose product version we want to determine" _
& vbCrLf & vbCrLf _
& "Credits: General product version by Maputi on StackOverflow.com:" _
& vbCrLf _
& " http://stackoverflow.com/a/2990698" _
& vbCrLf _
& " MSI product version by Arnout Grootveld on StackOverflow.com:" _
& vbCrLf _
& " http://stackoverflow.com/a/328710" _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" _
& vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit 1
End Sub
page last modified: 2024-04-16; loaded in 0.0097 seconds