Getting a files' version ID using code

Seems like the GetFileVersionInfo API call should do it...along with GetFileVersionInfoSize.

You can use scriting do do this quite handily.
1. Add "Microsoft Scripting Runtime" to your references
2. Try this code:

Dim fso As New FileSystemObject
Dim sVer As String

sVer = fso.GetFileVersion("c:\winnt\system32\comdlg32.ocx")

Ahhh...a good use for FSO!  Looks like a winner to me!

Hi
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long

Public Function GetVersionInfo(ByVal ResName As String) As String
   Dim arrVerInfo() As Byte
   Dim arrInfoName As Variant
   Dim arrLang(3) As Byte
   Dim sLang As String
   Dim dwBytes As Long
   Dim lpBuffer As Long
   Dim s As String
   Dim sText As String
   s = String(MAX_STRING, 0)
   Call GetModuleFileName(hModule, s, MAX_STRING)
   s = TrimNULL(s)
   dwBytes = GetFileVersionInfoSize(s, lpBuffer)
   ReDim arrVerInfo(0 To dwBytes - 1)
   Call GetFileVersionInfo(s, 0, dwBytes, arrVerInfo(0))
   arrInfoName = Array("OriginalFilename", "InternalName", "FileVersion", "FileDescription", "ProductName", "ProductVersion", "CompanyName", "LegalCopyright")
   Call VerQueryValue(arrVerInfo(0), "\VarFileInfo\Translation", lpBuffer, dwBytes)
   Call CopyMemory(arrLang(0), ByVal lpBuffer, dwBytes)
   sLang = ZeroPad(Hex(arrLang(1)), 2) & ZeroPad(Hex(arrLang(0)), 2) & ZeroPad(Hex(arrLang(3)), 2) & ZeroPad(Hex(arrLang(2)), 2)
   For i = 0 To UBound(arrInfoName) - 1
       Call VerQueryValue(arrVerInfo(0), "\StringFileInfo\" & sLang & "\" & CStr(arrInfoName(i)), lpBuffer, dwBytes)
       s = StrFromPtrA(lpBuffer)
       If s <> "" Then sText = sText & arrInfoName(i) & ":" & vbCrLf & vbTab & s & vbNewLine
   Next i
   GetVersionInfo = Trim(sText)
End Function

Cheers

Oops, sorry, above code is from my Resource Viewer sample (http://www.freevbcode.com/ShowCode.Asp?ID=3091)

Some addition:

Private Declare Function CopyStringA Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long
Public Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long

Public Function StrFromPtrA(ByVal lpszA As Long, Optional nSize As Long = 0) As String
   Dim s As String, bTrim As Boolean
   If nSize = 0 Then
      nSize = lstrlenA(lpszA)
      bTrim = True
   End If
   s = String(nSize, Chr$(0))
   CopyStringA s, ByVal lpszA
   If bTrim Then s = TrimNULL(s)
   StrFromPtrA = s
End Function

'And changes:
Public Function GetVersionInfo(ByVal sFileName As String) As String '<<<CHANGED
'======Remove this=========
   s = String(MAX_STRING, 0)
   Call GetModuleFileName(hModule, s, MAX_STRING)
   s = TrimNULL(s)
'==========================
'=========Changed==========
   dwBytes = GetFileVersionInfoSize(sFileName, lpBuffer)
   ReDim arrVerInfo(0 To dwBytes - 1)
   Call GetFileVersionInfo(sFileName, 0, dwBytes, arrVerInfo(0))
'==========================

Cheers

Ark,

The code doesn't compile.

Variable not defined SFileName on this line:
dwBytes = GetFileVersionInfoSize(SFilename, lpBuffer)

From where should I source SFileName?

I'm also missing the sub "CopyMemory".

And Missing "ZeroPad"

And TrimNull

This is what I have:


Option Explicit

Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Function CopyStringA Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long

Public Function GetVersionInfo(ByVal ResName As String) As String
  Dim arrVerInfo() As Byte
  Dim arrInfoName As Variant
  Dim arrLang(3) As Byte
  Dim sLang As String
  Dim dwBytes As Long
  Dim lpBuffer As Long
  Dim s As String
  Dim sText As String
  Dim sfilename As String
  Dim i As Long
 
  dwBytes = GetFileVersionInfoSize(sfilename, lpBuffer)
  ReDim arrVerInfo(0 To dwBytes - 1)
  Call GetFileVersionInfo(sfilename, 0, dwBytes, arrVerInfo(0))
 
  arrInfoName = Array("OriginalFilename", "InternalName", "FileVersion", "FileDescription", "ProductName", "ProductVersion", "CompanyName", "LegalCopyright")
  Call VerQueryValue(arrVerInfo(0), "\VarFileInfo\Translation", lpBuffer, dwBytes)
  Call CopyMemory(arrLang(0), ByVal lpBuffer, dwBytes)
  sLang = ZeroPad(Hex(arrLang(1)), 2) & ZeroPad(Hex(arrLang(0)), 2) & ZeroPad(Hex(arrLang(3)), 2) & ZeroPad(Hex(arrLang(2)), 2)
  For i = 0 To UBound(arrInfoName) - 1
      Call VerQueryValue(arrVerInfo(0), "\StringFileInfo\" & sLang & "\" & CStr(arrInfoName(i)), lpBuffer, dwBytes)
      s = StrFromPtrA(lpBuffer)
      If s <> "" Then sText = sText & arrInfoName(i) & ":" & vbCrLf & vbTab & s & vbNewLine
  Next i
  GetVersionInfo = Trim(sText)
End Function


Public Function StrFromPtrA(ByVal lpszA As Long, Optional nSize As Long = 0) As String
  Dim s As String, bTrim As Boolean
  If nSize = 0 Then
     nSize = lstrlenA(lpszA)
     bTrim = True
  End If
  s = String(nSize, Chr$(0))
  CopyStringA s, ByVal lpszA
  If bTrim Then s = TrimNULL(s)
  StrFromPtrA = s
End Function

Thanks Again

trkcorp,

Please go here to collect some points relating to this question
https://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=visualbasic&qid=20276784