Option Explicit
Private mFN
As String
Private mComments
As String
Private mCompanyName
As String
Private mFileDescription
As String
Private mFileVersion
As String
Private mInternalName
As String
Private mLegalCopyright
As String
Private mLegalTrademarks
As String
Private mOriginalFilename
As String
Private mProductName
As String
Private mProductVersion
As String
Private mPrivateBuild
As String
Private mSpecialBuild
As String
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 GetFileVersionInfoSize
Lib "version.dll"
Alias "GetFileVersionInfoSizeA" (
ByVal lptstrFilename
As String, lpdwHandle
As Long)
As Long
Private Declare Function VerQueryValue
Lib "version.dll"
Alias "VerQueryValueA" (pBlock
As Any,
ByVal lpSubBlock
As String, lpBuffer
As Any, puLen
As Long)
As Long
Private Declare Function VerLanguageName
Lib "kernel32"
Alias "VerLanguageNameA" (
ByVal wLang
As Long,
ByVal szLang
As String,
ByVal nSize
As Long)
As Long
Private Declare Sub CopyMemory
Lib "kernel32"
Alias "RtlMoveMemory" (Destination
As Any, Source
As Any,
ByVal Length
As Long)
Private Type LangCP
wLang
As Integer
wCP
As Integer
End Type
Public Property Get Comments()
As String
Comments = mComments
End Property
Public Property Get CompanyName()
As String
CompanyName = mCompanyName
End Property
Public Property Get FileName()
As String
FileName = mFN
End Property
Public Property Let FileName(
ByVal NewFN
As String)
mFN = NewFN
LoadInfo
End Property
Public Property Get FileVersion()
As String
FileVersion = mFileVersion
End Property
Public Property Get FileDescription()
As String
FileDescription = mFileDescription
End Property
Private Function GetValue(
ByRef DataByte
As Byte, sName
As String)
As String
Dim s$, dwLen&, lPtr&, iInStr&
VerQueryValue DataByte, sName, lPtr, dwLen
s =
String$(dwLen, 0)
CopyMemory
ByVal s,
ByVal lPtr, dwLen
iInStr = InStr(s, vbNullChar)
If iInStr <> 0
Then s = Left$(s, iInStr - 1)
GetValue = s
End Function
Public Property Get InternalName()
As String
InternalName = mInternalName
End Property
Public Property Get LegalCopyright()
As String
LegalCopyright = mLegalCopyright
End Property
Public Property Get LegalTrademarks()
As String
LegalTrademarks = mLegalTrademarks
End Property
Private Sub LoadInfo()
Dim hVer&, b()
As Byte, s$, dwLen&, lcp
As LangCP, lPtr&, sLangStr$
dwLen = GetFileVersionInfoSize(mFN, hVer)
If dwLen = 0
Then Exit Sub
ReDim b(dwLen - 1)
GetFileVersionInfo mFN, hVer, dwLen, b(0)
dwLen = 256
VerQueryValue b(0), "\VarFileInfo\Translation", lPtr, dwLen
s =
String$(dwLen, 0)
CopyMemory lcp,
ByVal lPtr, 4
sLangStr = "\StringFileInfo\"
s = Hex$(lcp.wLang)
sLangStr = sLangStr &
String$(4 -
Len(s), "0"
& s
s = Hex$(lcp.wCP)
sLangStr = sLangStr &
String$(4 -
Len(s), "0"
& s & "\"
mComments = GetValue(b(0), sLangStr & "Comments"
mCompanyName = GetValue(b(0), sLangStr & "CompanyName"
mFileDescription = GetValue(b(0), sLangStr & "FileDescription"
mFileVersion = GetValue(b(0), sLangStr & "FileVersion"
mInternalName = GetValue(b(0), sLangStr & "InternalName"
mLegalCopyright = GetValue(b(0), sLangStr & "LegalCopyright"
mLegalTrademarks = GetValue(b(0), sLangStr & "LegalTrademarks"
mOriginalFilename = GetValue(b(0), sLangStr & "OrgignalFilename"
mPrivateBuild = GetValue(b(0), sLangStr & "PrivateBuild"
mProductName = GetValue(b(0), sLangStr & "ProductName"
mProductVersion = GetValue(b(0), sLangStr & "ProductVersion"
mSpecialBuild = GetValue(b(0), sLangStr & "SpecialBuild"
End Sub
Public Property Get OriginalFilename()
As String
OriginalFilename = mOriginalFilename
End Property
Public Property Get PrivateBuild()
As String
PrivateBuild = mPrivateBuild
End Property
Public Property Get ProductName()
As String
ProductName = mProductName
End Property
Public Property Get ProductVersion()
As String
ProductVersion = mProductVersion
End Property
Public Property Get SpecialBuild()
As String
SpecialBuild = mSpecialBuild
End Property