Re: File attributes
- From: Alan <Alan@xxxxxxxxxxxxxxxxxxxxxxxxx>
- Date: Thu, 14 Dec 2006 13:38:01 -0800
Bob
Fantastic ... Many thanks for all your help ... this works as expected ...
just need to put it into my required format
Many Thanks for your persistence
NickHK ... very much obliged for the pointer
Kind Regards and festive greetings !!
"Bob Phillips" wrote:
If you trace Randy's article back to Karl Peterson, you can get this simple.
class, and use code like so to get it
Dim cVersion As clsFileversion
Set cVersion = New clsFileversion
cVersion.FullPathName = "C:\Program Files\Tools\system\DSO
File\dsofile.dll"
MsgBox cVersion.FileVersion
MsgBox cVersion.ProductVersion
' *********************************************************************
' Copyright ©1995-2001 Karl E. Peterson, All Rights Reserved
' http://www.mvps.org/vb
' *********************************************************************
' You are free to use this code within your own applications, but you
' are expressly forbidden from selling or otherwise distributing this
' source code without prior written consent.
' *********************************************************************
Option Explicit
'
' API declarations
'
Private Declare Function GetFullPathName Lib "kernel32" Alias
"GetFullPathNameA" ( _
ByVal lpFileName As String, _
ByVal nBufferLength As Long, _
ByVal lpBuffer As String, _
lpFilePart 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 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, _
lplpBuffer 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 Function GetSystemDirectory Lib "kernel32" Alias
"GetSystemDirectoryA" ( _
ByVal Path As String, _
ByVal cbBytes As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare Function lstrlenA Lib "kernel32" ( _
ByVal lpString As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" ( _
ByVal lpString As Long) As Long '
' API structures.
'
Private Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer ' e.g. = &h0000 = 0
dwStrucVersionh As Integer ' e.g. = &h0042 = .42
dwFileVersionMSl As Integer ' e.g. = &h0003 = 3
dwFileVersionMSh As Integer ' e.g. = &h0075 = .75
dwFileVersionLSl As Integer ' e.g. = &h0000 = 0
dwFileVersionLSh As Integer ' e.g. = &h0031 = .31
dwProductVersionMSl As Integer ' e.g. = &h0003 = 3
dwProductVersionMSh As Integer ' e.g. = &h0010 = .1
dwProductVersionLSl As Integer ' e.g. = &h0000 = 0
dwProductVersionLSh As Integer ' e.g. = &h0031 = .31
dwFileFlagsMask As Long ' = &h3F for version "0.42"
dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE
dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16
dwFileType As Long ' e.g. VFT_DRIVER
dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD
dwFileDateMS As Long ' e.g. 0
dwFileDateLS As Long ' e.g. 0
End Type
'
' API constants.
'
Private Const MAX_PATH = 260
' ----- VS_VERSION.dwFileFlags -----
Private Const VS_FFI_SIGNATURE = &HFEEF04BD
Private Const VS_FFI_STRUCVERSION = &H10000
Private Const VS_FFI_FILEFLAGSMASK = &H3F&
' ----- VS_VERSION.dwFileFlags -----
Private Const VS_FF_DEBUG = &H1
Private Const VS_FF_PRERELEASE = &H2
Private Const VS_FF_PATCHED = &H4
Private Const VS_FF_PRIVATEBUILD = &H8
Private Const VS_FF_INFOINFERRED = &H10
Private Const VS_FF_SPECIALBUILD = &H20
' ----- VS_VERSION.dwFileOS -----
Private Const VOS_UNKNOWN = &H0
Private Const VOS_DOS = &H10000
Private Const VOS_OS216 = &H20000
Private Const VOS_OS232 = &H30000
Private Const VOS_NT = &H40000
Private Const VOS_DOS_WINDOWS16 = &H10001
Private Const VOS_DOS_WINDOWS32 = &H10004
Private Const VOS_OS216_PM16 = &H20002
Private Const VOS_OS232_PM32 = &H30003
Private Const VOS_NT_WINDOWS32 = &H40004
' ----- VS_VERSION.dwFileType -----
Private Const VFT_UNKNOWN = &H0
Private Const VFT_APP = &H1
Private Const VFT_DLL = &H2
Private Const VFT_DRV = &H3
Private Const VFT_FONT = &H4
Private Const VFT_VXD = &H5
Private Const VFT_STATIC_LIB = &H7
' **** VS_VERSION.dwFileSubtype for VFT_WINDOWS_FONT ****
Private Const VFT2_FONT_RASTER = &H1&
Private Const VFT2_FONT_VECTOR = &H2&
Private Const VFT2_FONT_TRUETYPE = &H3&
' ----- VS_VERSION.dwFileSubtype for VFT_WINDOWS_DRV -----
Private Const VFT2_UNKNOWN = &H0
Private Const VFT2_DRV_PRINTER = &H1
Private Const VFT2_DRV_KEYBOARD = &H2
Private Const VFT2_DRV_LANGUAGE = &H3
Private Const VFT2_DRV_DISPLAY = &H4
Private Const VFT2_DRV_MOUSE = &H5
Private Const VFT2_DRV_NETWORK = &H6
Private Const VFT2_DRV_SYSTEM = &H7
Private Const VFT2_DRV_INSTALLABLE = &H8
Private Const VFT2_DRV_SOUND = &H9
Private Const VFT2_DRV_COMM = &HA
'
' Member variables.
'
Private m_PathName As String
Private m_Available As Boolean
Private m_StrucVer As String ' Structure Version - NOT USED
Private m_FileVer As String ' File Version
Private m_ProdVer As String ' Product Version
Private m_FileFlags As String ' Boolean attributes of file
Private m_FileOS As String ' OS file is designed for
Private m_FileType As String ' Type of file
Private m_FileSubType As String ' Sub-type of file
Private m_VerLanguage As String
Private m_VerComments As String
Private m_VerCompany As String
Private m_VerDescription As String
Private m_VerFileVer As String
Private m_VerInternalName As String
Private m_VerCopyright As String
Private m_VerTrademarks As String
Private m_VerOrigFilename As String
Private m_VerProductName As String
Private m_VerProductVer As String
Private m_VerPrivateBuild As String
Private m_VerSpecialBuild As String
Private m_VerTrademarks1 As String
Private m_VerTrademarks2 As String
Public Enum VersionInfoStrings
viPredefinedFirst = 0
viLanguage = 0
viComments = 1
viCompanyName = 2
viFileDescription = 3
viFileVersion = 4
viInternalName = 5
viLegalCopyright = 6
viLegalTrademarks = 7
viOriginalFilename = 8
viProductName = 9
viProductVersion = 10
viPrivateBuild = 11
viSpecialBuild = 12
viLegalTrademarks1 = 13 'Used by Office apps only?
viLegalTrademarks2 = 14 'Used by Office apps only?
viPredefinedLast = 14
End Enum
' ********************************************
' Initialize and Terminate
' ********************************************
Private Sub Class_Initialize()
'
' All member variables can be left to defaults.
'
End Sub
Private Sub Class_Terminate()
'
' No special cleanup required.
'
End Sub
' ********************************************
' Public Properties
' ********************************************
Public Property Let FullPathName(ByVal NewVal As String)
Dim Buffer As String
Dim nFilePart As Long
Dim nRet As Long
'
' Retrieve fully qualified path/name specs.
'
Buffer = Space(MAX_PATH)
nRet = GetFullPathName(NewVal, Len(Buffer), Buffer, nFilePart)
If nRet Then
m_PathName = Left(Buffer, nRet)
Refresh
End If
End Property
Public Property Get FullPathName() As String
' Returns fully-qualified path/name spec.
FullPathName = m_PathName
End Property
Public Property Get Available() As Boolean
' Returns whether version information is available
Available = m_Available
End Property
' ********************************************
' Standard Version Information
' ********************************************
Public Property Get FileFlags() As String
FileFlags = m_FileFlags
End Property
Public Property Get FileOS() As String
FileOS = m_FileOS
End Property
Public Property Get FileType() As String
FileType = m_FileType
End Property
Public Property Get FileSubType() As String
FileSubType = m_FileSubType
End Property
Public Property Get VerFile() As String
VerFile = m_FileVer
End Property
Public Property Get VerProduct() As String
VerProduct = m_ProdVer
End Property
Public Property Get VerStructure() As String
VerStructure = m_StrucVer
End Property
' ********************************************
' Better Version Information
' ********************************************
Public Property Get PredefinedName(ByVal Which As VersionInfoStrings) As
String
Select Case Which
Case viLanguage
PredefinedName = "Language"
Case viComments
PredefinedName = "Comments"
Case viCompanyName
PredefinedName = "Company Name"
Case viFileDescription
PredefinedName = "File Description"
Case viFileVersion
PredefinedName = "File Version"
Case viInternalName
PredefinedName = "Internal Name"
Case viLegalCopyright
PredefinedName = "Legal Copyright"
Case viLegalTrademarks
PredefinedName = "Legal Trademarks"
Case viOriginalFilename
PredefinedName = "Original Filename"
Case viProductName
PredefinedName = "Product Name"
Case viProductVersion
PredefinedName = "Product Version"
Case viPrivateBuild
PredefinedName = "Private Build"
Case viSpecialBuild
PredefinedName = "Special Build"
Case viLegalTrademarks1
PredefinedName = "LegalTrademarks1"
Case viLegalTrademarks2
PredefinedName = "LegalTrademarks2"
End Select
End Property
- References:
- Re: File attributes
- From: Bob Phillips
- Re: File attributes
- From: Alan
- Re: File attributes
- From: Bob Phillips
- Re: File attributes
- From: Alan
- Re: File attributes
- From: Bob Phillips
- Re: File attributes
- Prev by Date: Re: Macro delete line
- Next by Date: Re: VBA UDF Calculation (not)
- Previous by thread: Re: File attributes
- Next by thread: Re: File attributes
- Index(es):
Relevant Pages
|
Loading