How to Retrieve a File's "Product Version" in VBScript - vbscript

I have a VBScript that checks for the existence of a file in a directory on a remote machine. I am looking to retrieve the "Product Version" for said file (NOT "File Version"), but I can't seem to figure out how to do that in VBScript.
I'm currently using Scripting.FileSystemObject to check for the existence of the file.
Thanks.

I use a function that is slightly modified from the previous example. The function takes the path and file name and returns the "Product Version"
Function GetProductVersion (sFilePath, sProgram)
Dim FSO,objShell, objFolder, objFolderItem, i
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFilePath & "\" & sProgram) Then
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(sFilePath)
Set objFolderItem = objFolder.ParseName(sProgram)
Dim arrHeaders(300)
For i = 0 To 300
arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
'WScript.Echo i &"- " & arrHeaders(i) & ": " & objFolder.GetDetailsOf(objFolderItem, i)
If lcase(arrHeaders(i))= "product version" Then
GetProductVersion= objFolder.GetDetailsOf(objFolderItem, i)
Exit For
End If
Next
End If
End Function
I've found that the position of the attributes has occasionally changes (not sure why) in XP and Vista so I look for the "product version" attribute and exit the loop once it's found. The commented out line will show all the attributes and a value if available

You can use the Shell.Namespace to get the extended properties on a file, one of which is the Product Version. The GetDetailsOf function should work. You can test with the following code to get an idea:
Dim fillAttributes(300)
Set shell = CreateObject("Shell.Application")
Set folder = shell.Namespace("C:\Windows")
Set file = folder.ParseName("notepad.exe")
For i = 0 to 299
Wscript.Echo i & vbtab & fillAttributes(i) _
& ": " & folder.GetDetailsOf(file, i)
Next
One thing to be aware of:
The extended properties of a file differs between versions of Windows. Hence, the product version index numbers changes based on the version of Windows you are using. You can use the code above to determine what they are. From my testing, I believe they are as follows:
Window XP - 39
Windows Vista - 252
Windows 7 - 268
Windows 2008 R2 SP1 - 271
Windows 2012 R2 - 285
You may also find the following post helpful.

The product version can be retrieved directly with the ExtendedProperty method.
function GetProductVersion(Path)
dim shell, file
set shell = CreateObject("Shell.Application")
const ssfDesktop = 0
set file = shell.Namespace(ssfDesktop).ParseName(Path)
if not (file is nothing) then
GetProductVersion = _
file.ExtendedProperty("System.Software.ProductVersion")
end if
end function
By contrast with a couple of older answers,
This does not require looping over an unknown or arbitrary number of columns with GetDetailsOf.
This uses the canonical name of the property, not the display name. One can also use the FMTID and PID: "{0CEF7D53-FA64-11D1-A203-0000F81FEDEE} 8".
This avoids the need to split the path into directory and name, by starting at the root (desktop) namespace.

' must explicitly declare all variables
Option Explicit
' declare global variables
Dim aFileFullPath, aDetail
' set global variables
aFileFullPath = "C:\Windows\Notepad.exe"
aDetail = "Product Version"
' display a message with file location and file detail
WScript.Echo ("File location: " & vbTab & aFileFullPath & vbNewLine & _
aDetail & ": " & vbTab & fGetFileDetail(aFileFullPath, aDetail))
' make global variable happy. set them free
Set aFileFullPath = Nothing
Set aDetail = Nothing
' get file detail function. created by Stefan Arhip on 20111026 1000
Function fGetFileDetail(aFileFullPath, aDetail)
' declare local variables
Dim pvShell, pvFileSystemObject, pvFolderName, pvFileName, pvFolder, pvFile, i
' set object to work with files
Set pvFileSystemObject = CreateObject("Scripting.FileSystemObject")
' check if aFileFullPath provided exists
If pvFileSystemObject.FileExists(aFileFullPath) Then
' extract only folder & file from aFileFullPath
pvFolderName = pvFileSystemObject.GetFile(aFileFullPath).ParentFolder
pvFileName = pvFileSystemObject.GetFile(aFileFullPath).Name
' set object to work with file details
Set pvShell = CreateObject("Shell.Application")
Set pvFolder = pvShell.Namespace(pvFolderName)
Set pvFile = pvFolder.ParseName(pvFileName)
' in case detail is not detected...
fGetFileDetail = "Detail not detected"
' parse 400 details for given file
For i = 0 To 399
' if desired detail name is found, set function result to detail value
If uCase(pvFolder.GetDetailsOf(pvFolder.Items, i)) = uCase(aDetail) Then
fGetFileDetail = pvFolder.GetDetailsOf(pvFile, i)
End If
Next
' if aFileFullPath provided do not exists
Else
fGetFileDetail = "File not found"
End If
' make local variable happy. set them free
Set pvShell = Nothing
Set pvFileSystemObject = Nothing
Set pvFolderName = Nothing
Set pvFileName = Nothing
Set pvFolder = Nothing
Set pvFile = Nothing
Set i = Nothing
End Function

Wscript.Echo CreateObject("Scripting.FileSystemObject").GetFileVersion("C:\Windows\notepad.exe")

Related

Waiting while files are zipped in VBScript [duplicate]

I am using VBscript to scan folders, create zip files and add files to them (compress), but as I run my script on folders with a lot of files, I get the following error: "Compressed (zip) Cannot create output file"
my zip handling code is as follows:
Dim objFSO
Set objFSO= CreateObject("Scripting.FileSystemObject"
Function PreformZip(objFile,target,zip_name, number_of_file)
Set shell = CreateObject("WScript.Shell")
zip_target = target + "\" + zip_name +".zip"
If Not objFSO.FileExists(zip_target) Then
MakePathIfNotExist(target)
NewZip(zip_target)
Else
If number_of_file=0 Then
objFSO.DeleteFile(zip_target)
NewZip(zip_target)
End if
End If
Set zipApp = CreateObject("Shell.Application")
aSourceName = Split(objFile, "\")
sSourceName = (aSourceName(Ubound(aSourceName)))
zip_file_count = zipApp.NameSpace(zip_target).items.Count
zipApp.NameSpace(zip_target).Copyhere objFile, 16
On Error Resume Next
sLoop = 0
Do Until zip_file_count < zipApp.NameSpace(zip_target).Items.Count
Wscript.Sleep(100)
sLoop = sLoop + 1
Loop
On Error GoTo 0
End Function
Sub NewZip(zip)
Set new_zip = objFSO.CreateTextFile(zip)
new_zip.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
new_zip.Close
Set new_zip = Nothing
WScript.Sleep(5000)
End Sub
Function MakePathIfNotExist(DirPath)
Dim FSO, aDirectories, sCreateDirectory, iDirectory
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(DirPath) Then
Exit Function
End If
aDirectories = Split(DirPath, "\")
sCreateDirectory = aDirectories(0)
For iDirectory = 1 To UBound(aDirectories)
sCreateDirectory = sCreateDirectory & "\" & aDirectories(iDirectory)
If Not FSO.FolderExists(sCreateDirectory) Then
FSO.CreateFolder(sCreateDirectory)
End If
Next
End Function
Function Recursion(DirectoryPath)
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(DirectoryPath) Then Exit Function
Call Recursion(FSO.GetParentFolderName(DirectoryPath))
FSO.CreateFolder(DirectoryPath)
End Function
I first thought I'm not waiting long enough after creating the zip, but I even tried it with 10 seconds wait after each zip and I still get the same error.
How can I solve it?
If there is no solution, is there an alternative way to make a zip? The script is not only for my own use so I don't want ro relay on a software which needs to be installed?
Although Folder.CopyHere method does not return a value and no notification is given to the calling program to indicate that the copy has completed, you could wait with next code snippet and I hope you can see proper (re)placement in your script:
On Error GoTo 0
zipApp.NameSpace(zip_target).Copyhere objFile _
, 4 +8 +16 +256 +512 +1024
Wscript.Sleep( 100)
On Error GoTo 0
Notice: no waiting Do..Loop, this Wscript.Sleep( 100) is sufficient to zip small files or start progress dialog box in case of huge files - and your script will wait for it...
Notice: no 'On Error Resume Next. Avoid invoking On Error Resume Next if you do not handle errors...
Flags used as follows.
Const FOF_SILENT = &h0004 'ineffective?
Const FOF_RENAMEONCOLLISION = &h0008 'ineffective?
Const FOF_NOCONFIRMATION = &h0010 '
Const FOF_SIMPLEPROGRESS = &h0100 'ineffective?
Const FOF_NOCONFIRMMKDIR = &h0200 '
Const FOF_NOERRORUI = &h0400 '
Unfortunately, in some cases, such as compressed (.zip) files, some option flags may be ignored by design (sic!) by MSDN!
If FOF_SILENT flag ineffective, then user could Cancel zipping process...
If FOF_RENAMEONCOLLISION flag ineffective, then newer file of the same name is not zipped, existing zip file keeps previous version without caution against; only existing folder brings on an extra error message...
Those could be fixed up as well, but it's subject of another question...
Well, after a great amount of research I found out that there is no possible way to fix this problem when using shell to perform zip.
I solved this issue by using za7.exe (7-zip) in the following way:
Dim zipParams
zipParams = "a -tzip"
Dim objShell: Set objShell = CreateObject("WScript.Shell")
command = zip_exe_location + " " + zipParams + " " + zip_target + " " + SourceFile
objShell.Run Command, 0 ,true
the "a" in the zip parameters means "add to file" and -tzip sets the type of the file as zip.

Set package code of MSI using vbscript

I am changing product code, upgrade code and product name of MSI by editing MSI database.
With reference :- http://www.codeproject.com/Articles/383481/Editing-an-MSI-Database
I am able to change all parameters above but unable to change Package Code.
Suggest a way to change package code.
Found a way to do it with vbscript, just out of curiosity:
The "property #9" is the package code (revision number).
Set wi = CreateObject("WindowsInstaller.Installer")
Set summary = wi.SummaryInformation("your.msi", 2)
summary.Property(9) = "{PUT-NEW-GUID-HERE}"
summary.Persist
I'm guessing that the requirement here is to install the same MSI multiple times, which means they need to change that set of guids. However the more normal way to solve that problem is with MSINEWINSTANCE.
https://msdn.microsoft.com/en-us/library/aa370326(v=vs.85).aspx
https://msdn.microsoft.com/en-us/library/aa369528(v=vs.85).aspx
so that you are not changing the base MSI file every time.
Why do you even have the need to set the package code?
Its auto generated during each build.
Take a look at the documentation of the Package element:
http://wixtoolset.org/documentation/manual/v3/xsd/wix/package.html
"The package code GUID for a product or merge module. When compiling a product, this attribute should not be set in order to allow the package code to be generated for each build. When compiling a merge module, this attribute must be set to the modularization guid."
I needed it because MSI created cache in respective package code which restricts us to make another instance of application using MSI so I did this by
using (var database = new Database(#"D:\\Nirvana\\WorkingCopy\\trunk\\proj1\\installer.msi", DatabaseOpenMode.Direct))
{
database.SummaryInfo.RevisionNumber = "{" + Guid.NewGuid() + "}";
}
I extended the Nikolay script for generating a random GUID automatically. The script also support drag and drop and be called through arguments (so you can easily automate it through cscript) and it checks if the file is writable before creating Windows Installer object (if the file is locked by some application, like InstEd, it will throw an error).
Set objArgs = Wscript.Arguments
Set objFso = CreateObject("scripting.filesystemobject")
'iterate through all the arguments passed
' https://community.spiceworks.com/scripts/show/1653-drag-drop-vbscript-framework
For i = 0 to objArgs.count
on error resume next
'try and treat the argument like a folder
Set folder = objFso.GetFolder(objArgs(i))
'if we get an error, we know it is a file
If err.number <> 0 then
'this is not a folder, treat as file
ProcessFile(objArgs(i))
Else
'No error? This is a folder, process accordingly
For Each file In folder.Files
ProcessFile(file)
Next
End if
On Error Goto 0
Next
Function ProcessFile(sFilePath)
' http://www.wisesoft.co.uk/scripts/vbscript_file_modified_date.aspx
' Set objFile = objFSO.GetFile(sFilePath)
' MsgBox "Now processing file: " & CDATE( objFile.DateLastModified)
If Not IsWriteAccessible(sFilePath) Then WScript.Echo "Error persisting summary property stream" : Wscript.Quit 2
'Do something with the file here...
' https://stackoverflow.com/questions/31536349/set-package-code-of-msi-using-vbscript
Set installer = CreateObject("WindowsInstaller.Installer")
Set summary = installer.SummaryInformation(sFilePath, 2)
summary.Property(9) = CreateGuid()
summary.Persist
End Function
' https://stackoverflow.com/questions/968756/how-to-generate-a-guid-in-vbscript
Function CreateGuid()
CreateGuid = Left(CreateObject("Scriptlet.TypeLib").Guid,38)
End Function
' https://stackoverflow.com/questions/12300678/how-can-i-determine-if-a-file-is-locked-using-vbs
Function IsWriteAccessible(sFilePath)
' Strategy: Attempt to open the specified file in 'append' mode.
' Does not appear to change the 'modified' date on the file.
' Works with binary files as well as text files.
' Only 'ForAppending' is needed here. Define these constants
' outside of this function if you need them elsewhere in
' your source file.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
IsWriteAccessible = False
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim nErr : nErr = 0
Dim sDesc : sDesc = ""
Dim oFile : Set oFile = oFso.OpenTextFile(sFilePath, ForAppending)
If Err.Number = 0 Then
oFile.Close
If Err Then
nErr = Err.Number
sDesc = Err.Description
Else
IsWriteAccessible = True
End if
Else
Select Case Err.Number
Case 70
' Permission denied because:
' - file is open by another process
' - read-only bit is set on file, *or*
' - NTFS Access Control List settings (ACLs) on file
' prevents access
Case Else
' 52 - Bad file name or number
' 53 - File not found
' 76 - Path not found
nErr = Err.Number
sDesc = Err.Description
End Select
End If
' The following two statements are superfluous. The VB6 garbage
' collector will free 'oFile' and 'oFso' when this function completes
' and they go out of scope. See Eric Lippert's article for more:
' http://blogs.msdn.com/b/ericlippert/archive/2004/04/28/when-are-you-required-to-set-objects-to-nothing.aspx
'Set oFile = Nothing
'Set oFso = Nothing
On Error GoTo 0
If nErr Then
Err.Raise nErr, , sDesc
End If
End Function

VBS script 'Path not found' error when setting file system folder object reference

I am writing a script to determine the combined size of all instances of a particular subfolder within the profile folder of each user who has logged onto a Windows 2003 server, e.g. all users' desktop folders or all users' local settings folders.
Option Explicit
Dim colSubfolders, intCount, intCombinedSize, objFolder2, objFSO1, objFSO2, objUserFolder, strOutput, objSearchFolder, objSubfolder, strSearchFolder, strSubfolderPath
intCount = 0
intCombinedSize = 0
strSearchFolder = "C:\Documents and Settings\"
Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objSearchFolder = objFSO1.GetFolder(strSearchFolder)
Set colSubfolders = objSearchFolder.SubFolders
For Each objUserFolder in colSubfolders
strSubfolderPath = objUserFolder.Path & "\Desktop\"
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
intCount = intCount + 1
intCombinedSize = intCombinedSize + objSubfolder.Size
Next
MsgBox "Combined size of " & CStr(intCount) & " folders: " & CStr(intCombinedSize / 1048576) & " MB"
This code throws a 'Path not found' error (Code 800A004C) at line 15:
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
If I print out strSubfolderPath, however, I find that all the strings returned are valid directory paths, so I don't understand why I'm getting this error.
I've tried with and without the trailing backslash at the end of the path and I've tried with 8.3 style paths to remove spaces but to no effect.
When I run your code I get the same error.
Upon further inspection, on my computer there is a folder named C:\Documents and Settings\machinename, where machinename is the name of my computer. This folder only contains one subfolder named ASPNet.
I'm guessing you have something similar.
To minimize multiple-backslash confusion, use the FileSystemObject methods consistently instead of relying on string concatenation:
strSubfolderPath = objFSO1.BuildPath(objUserFolder.Path,"Desktop")

How to change file permissions with WMI?

I'm want to do the equivalent of what is described here from a script. Basically, I want to take ownership of the file, and set the permissions to OWNER/Full Control.
It seems to me that using WMI from a vbs script is the most portable way. That is, I'd like to avoid xcacls, icacls and other tools that either require a download, or are supported only on some versions of windows.
After googling around, I found this code for taking ownership:
'connect to WMI namespace on local machine
Set objServices =
GetObject("winmgmts:{impersonationLevel=impersonate}")
'get a reference to data file
strFile = Wscript.Arguments(0)
Set objFile = objServices.Get("CIM_DataFile.Name='" & strFile & "'")
If objFile.TakeOwnership = 0 Then
Wscript.Echo "File ownership successfully changed"
Else
Wscript.Echo "File ownership transfer operation"
End If
The pieces I'm still missing is setting the permissions, and having it work on relative paths.
Since you're already using TakeOwnership in the CIM_DataFile class, I'd assume you could just use ChangeSecurityPermissions to change the permissions, which is in the same class.
And you might be able to use GetAbsolutePathName to convert your relative paths to absolute paths before you use them.
Taking the hints from ho1's answer, I googled around some more, and eventually came up with this:
This script finds the current user SID, then takes ownership and changes the permissions on the file given in argv[0] to Full Control only to current user.
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}")
Function GetCurrentUserSID
' Get user name '
Set colComputer = objWMI.ExecQuery("Select * from Win32_ComputerSystem")
' Looping over one item '
For Each objComputer in colComputer
currentUserName = objComputer.UserName
Next
Set AccountSIDs = GetObject("Winmgmts:").InstancesOf("Win32_AccountSID")
For Each AccountSID In AccountSIDs
AccountKey = AccountSID.Element
Set objAccount = GetObject("Winmgmts:"+AccountKey)
strName = objAccount.Domain & "\" & objAccount.Name
If strName = currentUserName Then ' that's it
SIDKey = AccountSID.Setting
Set SID = GetObject("Winmgmts:" + SIDKey)
GetCurrentUserSID = SID.BinaryRepresentation
Exit For
End If
Next
End Function
Function LimitPermissions(path, SID)
Set objFile = objWMI.Get("CIM_DataFile.Name='" & path & "'")
Set Trustee = GetObject("Winmgmts:Win32_Trustee").SpawnInstance_
Trustee.SID = SID
Set ACE = getObject("Winmgmts:Win32_Ace").Spawninstance_
ACE.AccessMask = 2032127 ' Full Control
ACE.AceFlags = 3
ACE.AceType = 0
ACE.Trustee = Trustee
Set objSecDescriptor = GetObject("Winmgmts:Win32_SecurityDescriptor").SpawnInstance_
objSecDescriptor.DACL = Array(ACE)
objFile.ChangeSecurityPermissions objSecDescriptor, 4
End Function
Function TakeOwnership(path)
Set objFile = objWMI.Get("CIM_DataFile.Name='" & path & "'")
TakeOwnership = objFile.TakeOwnership
End Function
' Main '
strFilename = Wscript.Arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")
path = fso.GetAbsolutePathName(strFilename)
SID = GetCurrentUserSID
TakeOwnership path
LimitPermissions path, SID

How can I get a directory listing of DLLs with ProductName and ProductVersion?

When I look at a directory in Windows Explorer, I can see a ProductName and ProductVersion property for the DLL's in that directory.
I need to export this DLL list with ProductName and ProductVersion into a text file.
If I do c:\>dir *.dll > test.log, the test.log does not have the ProductName and ProductVersion.
Could someone help me to get these properties exported to a file along with the filename?
Even if it is a freeware tool or some other dir switch, that will be useful.
PowerShell is your friend here - and it's freely (as in beer) available from Microsoft.
The following is a one liner to spit out the product name, product version and file name of all the dlls in the windows directory into test.log:
dir c:\windows\*.dll | % {[System.Diagnostics.FileVersionInfo]::GetVersionInfo($_)} | % { $_.ProductName + ", " + $_.ProductVersion + ", " + $_.FileName} > test.log
OK, so it's a long line - but it is still just one line at the command prompt.
PowerShell afficionados will probably be able to condense the above still further. Note that PowerShell allows us to use the .Net base class library (or even your own assemblies) such as System.Diagnostics.FileVersionInfo from the command line!
If you haven't played with PowerShell yet, you have a treat in store - particularly if you are a .Net developer :)
Using VBScript you could do the following:
Set objShell = CreateObject ("Shell.Application")
Set objFolder = objShell.Namespace ("C:\Scripts")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim arrHeaders(40)
For i = 0 to 40
arrHeaders(i) = objFolder.GetDetailsOf (objFolder.Items, i)
Next
For Each strFileName in objFolder.Items
For i = 0 to 40
Wscript.echo arrHeaders(i) & ": " & objFolder.GetDetailsOf (strFileName, i)
Next
Wscript.Echo
Next
You can do this fairly easily with a .NET application.
using System;
using System.Diagnostics;
static class MainClass
{
static void Main(string[] args)
{
FileVersionInfo info = FileVersionInfo.GetVersionInfo("c:\\test.txt");
// Display version information.
Console.WriteLine("Checking File: " + info.FileName);
Console.WriteLine("Product Name: " + info.ProductName);
Console.WriteLine("Product Version: " + info.ProductVersion);
Console.WriteLine("Company Name: " + info.CompanyName);
}
}
Obviously, you'd have to add a function that retrieved all the files in a specified directory.
Adding a VB.Net version to the list:
Sub CreateLog(ByVal Logfile As String, ByVal PathToLog As String, Optional ByVal SearchPattern As String = "*.*")
Dim FileInfo As FileVersionInfo
Dim ret As String = ""
For Each File As String In IO.Directory.GetFiles(PathToLog, SearchPattern)
FileInfo = FileVersionInfo.GetVersionInfo(File)
If FileInfo.ProductName & FileInfo.ProductVersion <> "" Then
ret &= FileInfo.ProductName & ", " & FileInfo.ProductVersion & vbCrLf
End If
Next
IO.File.WriteAllText(Logfile, ret)
End Sub
Call it by: CreateLog("c:\log.txt", "c:\windows", "*.dll")
Edit:Added searchpattern.
I cannot speak to this software at all, but this appears to do what you're looking for:
http://www.softpedia.com/get/Programming/Other-Programming-Files/STRFINFO.shtml
SYNTAX
~~~~~~
StrFInfo[.EXE] ExeDllOcxFileName [Property1 [Property2 ...]]
COMMON PROPERTIES
~~~~~~~~~~~~~~~~~
FileDescription FileVersion InternalName
OriginalFileName ProductName ProductVersion
CompanyName LegalCopyRight $Translation
Interesting, I didn't know this GetDetailsOf function.
I wondered about the arbitrary size...
I am not sure what is the limit, which seem to vary between folders or at least user settings or something, so I made something more flexible:
Set shell = CreateObject("Shell.Application")
Set folder = shell.Namespace("D:\Documents")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each fileName in folder.Items
i = 0
emptyNb = 0
Do
detail = folder.GetDetailsOf(folder.Items, i)
If detail = "" Then
emptyNb = emptyNb + 1
Else
detailValue = folder.GetDetailsOf(fileName, i)
If detailValue <> "" Then
Wscript.Echo i & " " & detail & ": " & detailValue
End If
emptyNb = 0
End If
i = i + 1
Loop While emptyNb < 3 ' Arbirary, adjust as you see fit
detailValue = folder.GetDetailsOf(fileName, -1)
If detailValue <> "" Then
Wscript.Echo "Tooltip:" & vbCrLf & detailValue
End If
Wscript.Echo
Next
To answer the question, you can check when detail is equal to the info you are looking for and only display these values.

Resources