?
Solved

DLL Version & Language

Posted on 2006-05-07
3
Medium Priority
?
1,083 Views
Last Modified: 2008-01-09
Hi experts,

Is there a way I can programmatically find out the version information for a DLL/OCX file, along with its language?

thanks.
0
Comment
Question by:sramesh2k
  • 2
3 Comments
 
LVL 22

Accepted Solution

by:
danaseaman earned 500 total points
ID: 16627942
'In Form:
Option Explicit

Dim VI      As New VersionInfo

Private Sub Form_Load()
   VI.FileName = "D:\WINDOWS\system32\msvbvm60.dll"
   Debug.Print "GenericLangName = ", VI.GenericLangName
   Debug.Print "FileVersion = ", VI.FileVersion
   
   
End Sub

'----------------
'ClassModule "ersionInfo"

Option Explicit

Private Const adhcClassName = "VersionInfo"
Private Const LOCALE_ICALENDARTYPE = &H1009
Private Const LOCALE_IOPTIONALCALENDAR = &H100B
Private Const LOCALE_ICENTURY = &H24
Private Const LOCALE_ICOUNTRY = &H5
Private Const LOCALE_ICURRDIGITS = &H19
Private Const LOCALE_ICURRENCY = &H1B
Private Const LOCALE_IDATE = &H21
Private Const LOCALE_IDAYLZERO = &H26
Private Const LOCALE_IDEFAULTCODEPAGE = &HB
Private Const LOCALE_IDEFAULTCOUNTRY = &HA
Private Const LOCALE_IDEFAULTLANGUAGE = &H9
Private Const LOCALE_IDIGITS = &H11
Private Const LOCALE_IINTLCURRDIGITS = &H1A
Private Const LOCALE_ILANGUAGE = &H1
Private Const LOCALE_ILDATE = &H22
Private Const LOCALE_ILZERO = &H12
Private Const LOCALE_IMEASURE = &HD
Private Const LOCALE_IMONLZERO = &H27
Private Const LOCALE_INEGCURR = &H1C
Private Const LOCALE_INEGSEPBYSPACE = &H57
Private Const LOCALE_INEGSIGNPOSN = &H53
Private Const LOCALE_INEGSYMPRECEDES = &H56
Private Const LOCALE_IPOSSEPBYSPACE = &H55
Private Const LOCALE_IPOSSIGNPOSN = &H52
Private Const LOCALE_IPOSSYMPRECEDES = &H54
Private Const LOCALE_ITIME = &H23
Private Const LOCALE_ITLZERO = &H25
Private Const LOCALE_NOUSEROVERRIDE = &H80000000
Private Const LOCALE_S1159 = &H28
Private Const LOCALE_S2359 = &H29
Private Const LOCALE_SABBREVCTRYNAME = &H7
Private Const LOCALE_SABBREVDAYNAME1 = &H31
Private Const LOCALE_SABBREVDAYNAME2 = &H32
Private Const LOCALE_SABBREVDAYNAME3 = &H33
Private Const LOCALE_SABBREVDAYNAME4 = &H34
Private Const LOCALE_SABBREVDAYNAME5 = &H35
Private Const LOCALE_SABBREVDAYNAME6 = &H36
Private Const LOCALE_SABBREVDAYNAME7 = &H37
Private Const LOCALE_SABBREVLANGNAME = &H3
Private Const LOCALE_SABBREVMONTHNAME1 = &H44
Private Const LOCALE_SABBREVMONTHNAME10 = &H4D
Private Const LOCALE_SABBREVMONTHNAME11 = &H4E
Private Const LOCALE_SABBREVMONTHNAME12 = &H4F
Private Const LOCALE_SABBREVMONTHNAME13 = &H100F
Private Const LOCALE_SABBREVMONTHNAME2 = &H45
Private Const LOCALE_SABBREVMONTHNAME3 = &H46
Private Const LOCALE_SABBREVMONTHNAME4 = &H47
Private Const LOCALE_SABBREVMONTHNAME5 = &H48
Private Const LOCALE_SABBREVMONTHNAME6 = &H49
Private Const LOCALE_SABBREVMONTHNAME7 = &H4A
Private Const LOCALE_SABBREVMONTHNAME8 = &H4B
Private Const LOCALE_SABBREVMONTHNAME9 = &H4C
Private Const LOCALE_SCOUNTRY = &H6
Private Const LOCALE_SCURRENCY = &H14
Private Const LOCALE_SDATE = &H1D
Private Const LOCALE_SDAYNAME1 = &H2A
Private Const LOCALE_SDAYNAME2 = &H2B
Private Const LOCALE_SDAYNAME3 = &H2C
Private Const LOCALE_SDAYNAME4 = &H2D
Private Const LOCALE_SDAYNAME5 = &H2E
Private Const LOCALE_SDAYNAME6 = &H2F
Private Const LOCALE_SDAYNAME7 = &H30
Private Const LOCALE_SDECIMAL = &HE
Private Const LOCALE_SENGCOUNTRY = &H1002
Private Const LOCALE_SENGLANGUAGE = &H1001
Private Const LOCALE_SGROUPING = &H10
Private Const LOCALE_SINTLSYMBOL = &H15
Private Const LOCALE_SLANGUAGE = &H2
Private Const LOCALE_SLIST = &HC
Private Const LOCALE_SLONGDATE = &H20
Private Const LOCALE_SMONDECIMALSEP = &H16
Private Const LOCALE_SMONGROUPING = &H18
Private Const LOCALE_SMONTHNAME1 = &H38
Private Const LOCALE_SMONTHNAME10 = &H41
Private Const LOCALE_SMONTHNAME11 = &H42
Private Const LOCALE_SMONTHNAME12 = &H43
Private Const LOCALE_SMONTHNAME2 = &H39
Private Const LOCALE_SMONTHNAME3 = &H3A
Private Const LOCALE_SMONTHNAME4 = &H3B
Private Const LOCALE_SMONTHNAME5 = &H3C
Private Const LOCALE_SMONTHNAME6 = &H3D
Private Const LOCALE_SMONTHNAME7 = &H3E
Private Const LOCALE_SMONTHNAME8 = &H3F
Private Const LOCALE_SMONTHNAME9 = &H40
Private Const LOCALE_SMONTHOUSANDSEP = &H17
Private Const LOCALE_SNATIVECTRYNAME = &H8
Private Const LOCALE_SNATIVEDIGITS = &H13
Private Const LOCALE_SNATIVELANGNAME = &H4
Private Const LOCALE_SNEGATIVESIGN = &H51
Private Const LOCALE_SPOSITIVESIGN = &H50
Private Const LOCALE_SSHORTDATE = &H1F
Private Const LOCALE_STHOUSAND = &HF
Private Const LOCALE_STIME = &H1E
Private Const LOCALE_STIMEFORMAT = &H1003
'
Private Enum GLITypes
   gliICALENDARTYPE = &H1009
   gliIOPTIONALCALENDAR = &H100B
   gliICENTURY = &H24
   gliICOUNTRY = &H5
   gliICURRDIGITS = &H19
   gliICURRENCY = &H1B
   gliIDATE = &H21
   gliIDAYLZERO = &H26
   gliIDEFAULTCODEPAGE = &HB
   gliIDEFAULTCOUNTRY = &HA
   gliIDEFAULTLANGUAGE = &H9
   gliIDIGITS = &H11
   gliIINTLCURRDIGITS = &H1A
   gliILANGUAGE = &H1
   gliILDATE = &H22
   gliILZERO = &H12
   gliIMEASURE = &HD
   gliIMONLZERO = &H27
   gliINEGCURR = &H1C
   gliINEGSEPBYSPACE = &H57
   gliINEGSIGNPOSN = &H53
   gliINEGSYMPRECEDES = &H56
   gliIPOSSEPBYSPACE = &H55
   gliIPOSSIGNPOSN = &H52
   gliIPOSSYMPRECEDES = &H54
   gliITIME = &H23
   gliITLZERO = &H25
   gliNOUSEROVERRIDE = &H80000000
   gliS1159 = &H28
   gliS2359 = &H29
   gliSABBREVCTRYNAME = &H7
   gliSABBREVDAYNAME1 = &H31
   gliSABBREVDAYNAME2 = &H32
   gliSABBREVDAYNAME3 = &H33
   gliSABBREVDAYNAME4 = &H34
   gliSABBREVDAYNAME5 = &H35
   gliSABBREVDAYNAME6 = &H36
   gliSABBREVDAYNAME7 = &H37
   gliSABBREVLANGNAME = &H3
   gliSABBREVMONTHNAME1 = &H44
   gliSABBREVMONTHNAME10 = &H4D
   gliSABBREVMONTHNAME11 = &H4E
   gliSABBREVMONTHNAME12 = &H4F
   gliSABBREVMONTHNAME13 = &H100F
   gliSABBREVMONTHNAME2 = &H45
   gliSABBREVMONTHNAME3 = &H46
   gliSABBREVMONTHNAME4 = &H47
   gliSABBREVMONTHNAME5 = &H48
   gliSABBREVMONTHNAME6 = &H49
   gliSABBREVMONTHNAME7 = &H4A
   gliSABBREVMONTHNAME8 = &H4B
   gliSABBREVMONTHNAME9 = &H4C
   gliSCOUNTRY = &H6
   gliSCURRENCY = &H14
   gliSDATE = &H1D
   gliSDAYNAME1 = &H2A
   gliSDAYNAME2 = &H2B
   gliSDAYNAME3 = &H2C
   gliSDAYNAME4 = &H2D
   gliSDAYNAME5 = &H2E
   gliSDAYNAME6 = &H2F
   gliSDAYNAME7 = &H30
   gliSDECIMAL = &HE
   gliSENGCOUNTRY = &H1002
   gliSENGLANGUAGE = &H1001
   gliSGROUPING = &H10
   gliSINTLSYMBOL = &H15
   gliSLANGUAGE = &H2
   gliSLIST = &HC
   gliSLONGDATE = &H20
   gliSMONDECIMALSEP = &H16
   gliSMONGROUPING = &H18
   gliSMONTHNAME1 = &H38
   gliSMONTHNAME10 = &H41
   gliSMONTHNAME11 = &H42
   gliSMONTHNAME12 = &H43
   gliSMONTHNAME2 = &H39
   gliSMONTHNAME3 = &H3A
   gliSMONTHNAME4 = &H3B
   gliSMONTHNAME5 = &H3C
   gliSMONTHNAME6 = &H3D
   gliSMONTHNAME7 = &H3E
   gliSMONTHNAME8 = &H3F
   gliSMONTHNAME9 = &H40
   gliSMONTHOUSANDSEP = &H17
   gliSNATIVECTRYNAME = &H8
   gliSNATIVEDIGITS = &H13
   gliSNATIVELANGNAME = &H4
   gliSNEGATIVESIGN = &H51
   gliSPOSITIVESIGN = &H50
   gliSSHORTDATE = &H1F
   gliSTHOUSAND = &HF
   gliStimE = &H1E
   gliSTIMEFORMAT = &H1003
End Enum

' Error Constants.
'
' This value was chosen arbitrarily,
' as a base for the other errors.
Private Const adhcErrBase = vbObjectError + 19560516
Private Const adhcErrNoModuleHandle = adhcErrBase + 1
Private Const adhcErrNoModule = adhcErrBase + 2
Private Const adhcErrNoFileName = adhcErrBase + 3
Private Const adhcErrNoVersionInfoSize = adhcErrBase + 4
Private Const adhcErrNoVersionInfo = adhcErrBase + 5
Private Const adhcErrNoLangCPInfo = adhcErrBase + 6
Private Const adhcNoFixedFileInfo = adhcErrBase + 7
Private Const adhcErrUnknown = adhcErrBase + 8

'
' UDTs and Enums for fixed file version info.
'
' Language Return Values
' To save Public space, most of these are commented out.
' If your situation involves checking for more of these, uncomment the
' ones you care about. There are others, as well, that aren't
' listed here.
Public Enum adhLanguageValue
    ' lvArabic = 1025                    'Arabic
    ' lvBulgarian = 1026                 'Bulgarian
    ' lvCatalan = 1027                   'Catalan
    ' lvTraditionalChinese = 1028        'Traditional Chinese
    ' lvCzech = 1029                     'Czech
    ' lvDanish = 1030                    'Danish
    lvGerman = 1031                      'German
    ' lvGreek = 1032                     'Greek
    lvUSEnglish = 1033                   'U.S. English
    ' lvCastilianSpanish = 1034          'Castilian Spanish
    ' lvFinnish = 1035                   'Finnish
    lvFrench = 1036                      'French
    ' lvHebrew = 1037                    'Hebrew
    ' lvHungarian = 1038                 'Hungarian
    ' lvIcelandic = 1039                 'Icelandic
    lvItalian = 1040                     'Italian
    ' lvJapanese = 1041                  'Japanese
    ' lvKorean = 1042                    'Korean
    ' lvDutch = 1043                     'Dutch
    ' lvNorwegianBokmål = 1044           'Norwegian - Bokmål
    ' lvPolish = 1045                    'Polish
    lvBrazilianPortuguese = 1046       'Brazilian Portuguese
    ' lvRhaetoRomanic = 1047             'Rhaeto-Romanic
    ' lvRomanian = 1048                  'Romanian
    ' lvRussian = 1049                   'Russian
    ' lvCroatoSerbian = 1050             'Croato-Serbian (Latin)
    ' lvSlovak = 1051                    'Slovak
    ' lvAlbanian = 1052                  'Albanian
    ' lvSwedish = 1053                   'Swedish
    ' lvThai = 1054                      'Thai
    ' lvTurkish = 1055                   'Turkish
    ' lvUrdu = 1056                      'Urdu
    ' lvBahasa = 1057                    'Bahasa
    ' lvSimplifiedChinese = 2052         'Simplified Chinese
    ' lvSwissGerman = 2055               'Swiss German
    lvUKEnglish = 2057                   'U.K. English
    lvMexicanSpanish = 2058              'Mexican Spanish
    ' lvBelgianFrench = 2060             'Belgian French
    ' lvSwissItalian = 2064              'Swiss Italian
    ' lvBelgianDutch = 2067              'Belgian Dutch
    ' lvNorwegianNynorsk = 2068          'Norwegian - Nynorsk
    ' lvPortuguese = 2070                'Portuguese
    ' lvSerboCroatian = 2074             'Serbo-Croatian (Cyrillic)
    ' lvCanadianFrench = 3084            'Canadian French
    ' lvSwissFrench = 4108               'Swiss French
End Enum

Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersionl As Integer         '  e.g. 0x00000042 = "0
    dwStrucVersionh As Integer         '  e.g. 0x00000042 = ".42"
    dwFileVersionMSl As Integer        '  e.g. 0x00030075 = "3"
    dwFileVersionMSh As Integer        '  e.g. 0x00030075 = ".75"
    dwFileVersionLSl As Integer        '  e.g. 0x00000031 = "0"
    dwFileVersionLSh As Integer        '  e.g. 0x00000031 = ".31"
    dwProductVersionMSl As Integer     '  e.g. 0x00030010 = "3"
    dwProductVersionMSh As Integer     '  e.g. 0x00030010 = ".10"
    dwProductVersionLSl As Integer     '  e.g. 0x00000031 = "0"
    dwProductVersionLSh As Integer     '  e.g. 0x00000031 = ".31"
    dwFileFlagsMask As Long            '  = 0x3F
    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

Public Enum adhFileFlags
    VS_FF_DEBUG = &H1&
    VS_FF_PRERELEASE = &H2&
    VS_FF_PATCHED = &H4&
    VS_FF_PRIVATEBUILD = &H8&
    VS_FF_SPECIALBUILD = &H20&
End Enum

Public Enum adhTargetOS
    VOS_UNKNOWN = &H0&
    VOS__BASE = &H0&
    VOS__WINDOWS16 = &H1&
    VOS__PM16 = &H2&
    VOS__PM32 = &H3&
    VOS__WINDOWS32 = &H4&
    VOS_DOS = &H10000
    VOS_OS216 = &H20000
    VOS_OS232 = &H30000
    VOS_NT = &H40000
       
    ' Combinations of previous values.
    VOS_DOS_WINDOWS16 = &H10001
    VOS_DOS_WINDOWS32 = &H10004
    VOS_NT_WINDOWS32 = &H40004
    VOS_OS216_PM16 = &H20002
    VOS_OS232_PM32 = &H30003
End Enum

Public Enum adhFileType
    VFT_UNKNOWN = &H0&
    VFT_APP = &H1&
    VFT_DLL = &H2&
    VFT_DRV = &H3&
    VFT_FONT = &H4&
    VFT_VXD = &H5&
    VFT_STATIC_LIB = &H7&
End Enum

Public Enum adhFileSubType
    VFT2_UNKNOWN = &H0&
    VFT2_DRV_COMM = &HA&
    VFT2_DRV_PRINTER = &H1&
    VFT2_DRV_KEYBOARD = &H2&
    VFT2_DRV_LANGUAGE = &H3&
    VFT2_DRV_DISPLAY = &H4&
    VFT2_DRV_MOUSE = &H5&
    VFT2_DRV_NETWORK = &H6&
    VFT2_DRV_SYSTEM = &H7&
    VFT2_DRV_INSTALLABLE = &H8&
    VFT2_DRV_SOUND = &H9&
    VFT2_DRV_INPUTMETHOD = &HB&
   
    VFT2_FONT_RASTER = &H1&
    VFT2_FONT_TRUETYPE = &H3&
    VFT2_FONT_VECTOR = &H2&
End Enum

'
' API Declarations
'
Private Declare Function GetModuleFileName _
 Lib "kernel32" Alias "GetModuleFileNameA" _
 (ByVal hModule As Long, ByVal lpFileName As String, _
 ByVal nSize As Long) As Long

Private Declare Function GetModuleHandle _
 Lib "kernel32" Alias "GetModuleHandleA" _
 (ByVal lpModuleName As String) As Long

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 lstrcpy _
 Lib "kernel32" Alias "lstrcpyA" _
 (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Private Declare Sub RtlMoveMemory _
 Lib "kernel32" _
 (Destination As Any, ByVal Source As Any, ByVal Length As Long)
 
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
'
' Private variables
'
Private mstrModuleName As String
Private mstrFileName As String

' Storage for entire version information
' structure. If this isn't initialized,
' then there's no hope that anything
' else will work.
Private mabytBuffer() As Byte

' The module language and code page info,
' stored as 4 bytes, like this: 040904E4
' (for US English). Unless this value
' has been set, none of the properties
' will work.
Private mstrLangCP As String
 
' Store the fixed file info
' for retrieval with the associated properties.
Private mffi As VS_FIXEDFILEINFO

Public Property Let FileName(Value As String)
    '
    ' Set either ModuleName or FileName,
    ' but not both. Whichever you set
    ' LAST is the one that will take
    ' effect.
    '
    mstrFileName = Value
    '
    ' Now, go get the language info from
    ' this file.
    '
    Call GetLanguageInfo
End Property

Public Property Get FileName() As String
   
    FileName = mstrFileName
   
End Property

Public Property Let ModuleName(Value As String)
    '
    ' Set either ModuleName or FileName,
    ' but not both. Whichever you set
    ' LAST is the one that will take
    ' effect. Setting ModuleName also
    ' sets FileName (the code must actually
    ' open a physical file). You can retrieve
    ' either ModuleName or FileName after
    ' setting the ModuleName property.
    '
    mstrModuleName = Value
    '
    ' Now, go get the language info from
    ' this module.
    '
    Call GetLanguageInfo
End Property

Public Property Get ModuleName() As String
   
    ModuleName = mstrModuleName
   
End Property

Public Property Get LCID() As Long
    'Dim LangID As Long
    ' The primary language identifier associated with
    ' the file. See the adhLanguageValue Enum.
    '
    ' Unless the mstrLangCP string contains
    ' exactly 8 characters, something's wrong.
    '
    ' Take the first four characters, and convert them
    ' into a value.
    '
    If Len(mstrLangCP) = 8 Then
        LCID = Val("&H" & Left$(mstrLangCP, 4))
    End If
End Property

Public Property Get FullName() As String
   FullName = pfGLI(gliSLANGUAGE)
End Property

Public Function GetDayName(DayIndex As Integer, Optional Abbreviate As Boolean = False) As String
   If DayIndex < 1 Or DayIndex > 7 Then
      Err.Raise vbObjectError, "Locale", "Day index out of range (1-7 only)"
      Exit Function
   End If
   Dim aln              As String, dayConst As Long
   If Abbreviate Then dayConst = gliSABBREVDAYNAME1 Else dayConst = gliSDAYNAME1
   dayConst = dayConst + DayIndex - 1
   GetDayName = pfGLI(dayConst)
End Function

Public Function GetMonthName(MonthIndex As Integer, Optional Abbreviate As Boolean = False) As String
   If MonthIndex < 1 Or MonthIndex > 12 Then
      ' Numbers up to 13 allowed for Lunar calendars
      Err.Raise vbObjectError, "Locale", "Month index out of range (1-12 only)"
      Exit Function
   End If
   Dim aln              As String, dayConst As Long
   If Abbreviate Then dayConst = gliSABBREVMONTHNAME1 Else dayConst = gliSMONTHNAME1
   dayConst = dayConst + MonthIndex - 1
   GetMonthName = pfGLI(dayConst)
End Function

Public Property Get GenericLangName() As String
   GenericLangName = pfGLI(gliSENGLANGUAGE)
End Property

Public Property Get AbbrevLangName() As String
   AbbrevLangName = pfGLI(gliSABBREVLANGNAME)
End Property

Public Property Get CurrencyString() As String
   CurrencyString = pfGLI(gliSCURRENCY)
End Property

Public Property Get LongDateFormat() As String
   LongDateFormat = pfGLI(gliSLONGDATE)
End Property

Public Property Get NativeCountryName() As String
   NativeCountryName = pfGLI(gliSNATIVECTRYNAME)
End Property

Public Property Get NativeLangName() As String
   NativeLangName = pfGLI(gliSNATIVELANGNAME)
End Property

Public Property Get ShortDateFormat() As String
   ShortDateFormat = pfGLI(gliSSHORTDATE)
End Property

Public Property Get TimeFormat() As String
   TimeFormat = pfGLI(gliSTIMEFORMAT)
End Property

Public Property Get IntlCurrencyCode() As String
   IntlCurrencyCode = pfGLI(gliSINTLSYMBOL)
End Property

Public Property Get DefaultCodePage() As String
   DefaultCodePage = pfGLI(gliIDEFAULTCODEPAGE)
End Property

Public Property Get NumDigits() As Long
   NumDigits = CInt(pfGLI(LOCALE_IDIGITS))
End Property
   
Public Property Get LeadingZero() As Long
   LeadingZero = CInt(pfGLI(gliILZERO))
End Property

Public Property Get Grouping() As Long
   Grouping = CInt(Left$(pfGLI(gliSGROUPING), 1))
End Property

Public Property Get DecimalSeparator() As String
   DecimalSeparator = Left$(pfGLI(gliSDECIMAL), 1)
End Property

Public Property Get ThousandSeparator() As Long
   ThousandSeparator = Left$(pfGLI(gliSTHOUSAND), 1)
End Property

Public Property Get NegativeOrder() As Long
   NegativeOrder = CInt(pfGLI(gliINEGCURR))
End Property

Public Property Get PositiveOrder() As Long
   PositiveOrder = CInt(pfGLI(gliICURRENCY))
End Property

Public Property Get cSymb() As String
   cSymb = pfGLI(gliSCURRENCY)
End Property

Private Function pfGLI(reqInfo As GLITypes) As String
   Dim aStr As String
   aStr = String(255, Chr(0))
   GetLocaleInfo LCID, reqInfo, aStr, 255
   aStr = Left$(aStr, InStr(1, aStr, Chr(0)) - 1)
   pfGLI = aStr
End Function
Public Property Get CodePage() As Long
    '
    ' A character set that can include numbers, punctuation marks,
    ' and other symbols. Different languages and locales may use
    ' different code pages. For example, the ANSI code page 1252 is
    ' used for American English and most European languages; OEM
    ' code page 932 is used for Japanese Kanji. This property
    ' returns the first code page assigned to the file (an
    ' application may have multiple code pages assigned to it).
    '
    '
    ' Unless the mstrLangCP string contains
    ' exactly 8 characters, something's wrong.
    '
    ' Take the final four characters, and convert them
    ' into a value.
    '
    If Len(mstrLangCP) = 8 Then
        CodePage = Val("&H" & Right$(mstrLangCP, 4))
    End If
   
End Property

Public Property Get CompanyName() As String
    '
    ' Optional. Supplied by the developer. Normally, information
    ' about the company.
    '
    CompanyName = GetValue("CompanyName")
   
End Property

Public Property Get FileDescription() As String
    '
    ' Optional. Supplied by the developer. Normally, information
    ' about the file.
    '
    FileDescription = GetValue("FileDescription")
   
End Property

Public Property Get FileVersion() As String
    '
    ' Optional. Supplied by the developer (in Visual Basic
    ' applications, the developer supplies major, minor, and
    ' revision values individually). Normally contains
    ' information about the version number of the application.
    '
    FileVersion = GetValue("FileVersion")
   
End Property

Public Property Get InternalName() As String
    '
    ' Optional. Supplied by the developer.
    ' Normally, information about the internal
    ' name of the application
    '
    InternalName = GetValue("InternalName")
   
End Property

Public Property Get LegalCopyright() As String
    '
    ' Optional. Supplied by the developer.
    ' Normally, information about the legal copyright
    '
    LegalCopyright = GetValue("LegalCopyright")
   
End Property

Public Property Get OriginalFileName() As String
    '
    ' Optional. Supplied by the developer. Normally,
    ' information about the original file name.
    '
    OriginalFileName = GetValue("OriginalFileName")
   
End Property

Public Property Get ProductName() As String
    '
    ' Optional. Supplied by the developer. Normally,
    ' information about the product name.
    '
    ProductName = GetValue("ProductName")
   
End Property

Public Property Get ProductVersion() As String
    '
    ' Optional. Supplied by the developer. Normally,
    ' information about the product version
    '
    ProductVersion = GetValue("ProductVersion")
   
End Property

Public Property Get LegalTrademarks() As String
    '
    ' Optional. Supplied by the developer. Normally,
    ' information about the legal trademarks.
    '
    LegalTrademarks = GetValue("LegalTrademarks")
   
End Property

Public Property Get LegalTrademarks1() As String
    '
    ' Optional. Supplied by the developer. Normally,
    ' information about the legal trademarks.
    '
    LegalTrademarks1 = GetValue("LegalTrademarks1")
   
End Property

Public Property Get LegalTrademarks2() As String
    '
    ' Optional. Supplied by the developer. Normally,
    ' information about the legal trademarks.
    '
    LegalTrademarks2 = GetValue("LegalTrademarks2")
   
End Property

Public Property Get Comments() As String
    '
    ' Optional. Supplied by the developer. Normally, comments about
    ' the file.
    '
       
    Comments = GetValue("Comments")
   
End Property

Public Property Get PrivateBuild() As String
    '
    ' Optional. Supplied by the developer. Normally,
    ' information about the build if it's private
    '
    PrivateBuild = GetValue("PrivateBuild")
   
End Property

Public Property Get SpecialBuild() As String
    '
    ' Optional. Supplied by the developer. Normally,
    ' information about the build if it's special
    '
    SpecialBuild = GetValue("SpecialBuild")
   
End Property

Public Property Get FileFlagsRaw() As adhFileFlags
    '
    ' Numeric value describing the file which may be combined into
    ' a single number, using the Or operator. You can use the And
    ' operator to determine if a particular flag is set.
    '
    ' FileFlags Value   FileFlagsRaw Value   Description
    ' Debug             VS_FF_DEBUG          File contains debugging information or
    '                                        is compiled with debugging features enabled.
    ' Patched           VS_FF_PATCHED        The file has been modified and is not identical to the
    '                                        original shipping file of the same version number.
    ' Pre -Release      VS_FF_PRERELEASE     The file is a development version, not a
    '                                        commercially released product.
    ' Private           VS_FF_PRIVATEBUILD   The file was not built using standard
    '                                        release procedures. If this flag is set,
    '                                        you should also find data in the
    '                                        PrivateBuild property.
    ' Special           VS_FF_SPECIALBUILD   The file was built by the original company
    '                                        using standard release procedures, but is a
    '                                        variation of the normal file of the same
    '                                        version number. If this flag is set, you
    '                                        should also find data in the SpecialBuild property
    '
    '
    ' Return the file flags, removing any
    ' invalid bits.
    '
    FileFlagsRaw = mffi.dwFileFlags And mffi.dwFileFlagsMask
   
End Property

Public Property Get FileFlags() As String
Dim strOut   As String
Dim lngTemp As adhFileFlags
    '
    ' Text describing the file. See FIGURE 3 for the possible
    ' values, which may be combined into a single string.
    '
    '
    ' Mask off the valid bits.
    '
    lngTemp = mffi.dwFileFlags And mffi.dwFileFlagsMask
   
    If lngTemp And VS_FF_DEBUG Then strOut = strOut & "Debug "
    If lngTemp And VS_FF_PATCHED Then strOut = strOut & "Patched "
    If lngTemp And VS_FF_PRERELEASE Then strOut = strOut & "Pre-release "
    If lngTemp And VS_FF_PRIVATEBUILD Then strOut = strOut & "Private "
    If lngTemp And VS_FF_SPECIALBUILD Then strOut = strOut & "Special "
   
    FileFlags = strOut
End Property

Public Property Get FileOSRaw() As adhTargetOS
    '
    ' Long integer containing information about the target API and
    ' operating system. See the adhTargetOS Enum for more information.
    '
    FileOSRaw = mffi.dwFileOS
   
End Property

Public Property Get FileOS() As String
Dim lngTemp As Long
Dim strOut  As String
    '
    ' Text indicating the targeted API (Win16, PM [Presentation Manager on OS/2]
    ' or Win32) and possibly the target operating system (DOS, OS/2 16, OS/2
    ' 32, or Windows NT).
    '
    lngTemp = mffi.dwFileOS
   
    If lngTemp And VOS__WINDOWS16 Then
        strOut = "Win16 API"
    ElseIf lngTemp And VOS__PM16 Then
        strOut = "PM16 API"
    ElseIf lngTemp And VOS__PM32 Then
        strOut = "PM32 API"
    ElseIf lngTemp And VOS__WINDOWS32 Then
        strOut = "Win32 API"
    Else
        strOut = "Unknown API"
    End If
   
    If lngTemp And VOS_DOS Then
        strOut = strOut & " on DOS"
    ElseIf lngTemp And VOS_OS216 Then
        strOut = strOut & " on OS2/16"
    ElseIf lngTemp And VOS_OS232 Then
        strOut = strOut & " on OS2/32"
    ElseIf lngTemp = VOS_NT Then
        strOut = strOut & " on Windows NT"
    End If
   
    FileOS = strOut
End Property

Public Property Get FileTypeRaw() As adhFileType
    '
    ' One of the long integers included in
    ' the adhFileType Enum.
    '
    FileTypeRaw = mffi.dwFileType
   
End Property

Public Property Get FileType() As String
Dim strOut As String
    '
    ' Text describing the type of file you've selected. The
    ' possible options are Application, DLL, Driver, Font,
    ' Static-link Library, Unknown, or VXD. For more
    ' information about drivers or fonts, see the
    ' FileSubType property.
    '
    Select Case mffi.dwFileType
        Case VFT_APP
            strOut = "Application"
        Case VFT_DLL
            strOut = "DLL"
        Case VFT_DRV
            strOut = "Driver"
        Case VFT_FONT
            strOut = "Font"
        Case VFT_STATIC_LIB
            strOut = "Static-link library"
        Case VFT_UNKNOWN
            strOut = "Unknown"
        Case VFT_VXD
            strOut = "VXD"
    End Select
    FileType = strOut
End Property

Public Property Get FileSubTypeRaw() As adhFileSubType
    '
    ' Long integer containing information about the target API and
    ' operating system. See the adhTargetOS Enum for more information.
    '
    FileSubTypeRaw = mffi.dwFileSubtype
   
End Property

Public Property Get FileSubType() As String
Dim strOut As String
    '
    ' If the file's type (see the FileType property) is a driver or a font,
    ' this contains text describing the driver or font. For drivers, the
    ' possible values are Communications, Display, Input Method, Installable,
    ' Keyboard, Language, Mouse, Network, Printer, Sound, System, or
    ' Unknown. For fonts, the possible values are Raster, TrueType, Vector,
    ' or Unknown.
    '
    ' Retrieve the file subtype, if there is one.
    '
    ' Assume a default value of "Unknown".
    '
    strOut = "Unknown"
   
    Select Case mffi.dwFileType
        Case VFT_APP
        Case VFT_DLL
        Case VFT_DRV
            Select Case mffi.dwFileSubtype
                Case VFT2_DRV_COMM
                    strOut = "Communications"
                Case VFT2_DRV_DISPLAY
                    strOut = "Display"
                Case VFT2_DRV_INPUTMETHOD
                    strOut = "Input Method"
                Case VFT2_DRV_INSTALLABLE
                    strOut = "Installable"
                Case VFT2_DRV_KEYBOARD
                    strOut = "Keyboard"
                Case VFT2_DRV_LANGUAGE
                    strOut = "Language"
                Case VFT2_DRV_MOUSE
                    strOut = "Mouse"
                Case VFT2_DRV_NETWORK
                    strOut = "Network"
                Case VFT2_DRV_PRINTER
                    strOut = "Printer"
                Case VFT2_DRV_SOUND
                    strOut = "Sound"
                Case VFT2_DRV_SYSTEM
                    strOut = "System"
                Case VFT2_UNKNOWN
                    strOut = "Unknown"
            End Select
        Case VFT_FONT
            Select Case mffi.dwFileSubtype
                Case VFT2_FONT_RASTER
                    strOut = "Raster"
                Case VFT2_FONT_TRUETYPE
                    strOut = "TrueType"
                Case VFT2_FONT_VECTOR
                    strOut = "Vector"
                Case VFT2_UNKNOWN
                    strOut = "Unknown"
            End Select
        Case VFT_STATIC_LIB
        Case VFT_UNKNOWN
        Case VFT_VXD
            ' Just return the text, unaltered.
            strOut = mffi.dwFileSubtype
    End Select
    FileSubType = strOut
End Property

Private Function GetValue(strItem As String) As String
Dim strTemp       As String
Dim lngVerPointer As Long
Dim lngBufferLen  As Long
Dim strResult     As String
    '
    ' Once all the version info has been loaded,
    ' the various properties call this function
    ' to retrieve pieces of the version info.
    '
    On Error GoTo HandleErrors
   
    strTemp = "\StringFileInfo\" & mstrLangCP & "\" & strItem
    If VerQueryValue(mabytBuffer(0), strTemp, _
     lngVerPointer, lngBufferLen) <> 0 Then
        '
        ' lngBufferLen contains the length required
        ' in the string buffer. This value includes
        ' the trailing null character. Size
        ' the string buffer big enough to hold all
        ' the characters, but subtract one for the
        ' trailing null character.
        '
        strResult = Space$(lngBufferLen - 1)
        '
        ' Given a pointer (lngVerPointer), copy
        ' the string into strResult (a VB string
        ' variable). Then trim off the bytes,
        ' ending with the vbNullChar the
        ' API call put in.
        '
        Call lstrcpy(strResult, lngVerPointer)
        strResult = adhTrimNull(strResult)
    End If
   
ExitHere:
    GetValue = strResult
    Exit Function
   
HandleErrors:
    '
    ' Many things could go wrong (perhaps
    ' you never specified a module or file name?)
    ' but this class is going to take the
    ' simple route -- any error simply
    ' results in no info passed back.
    '
    strResult = vbNullString
    Resume ExitHere
End Function

Private Sub GetLanguageInfo()
Dim hInst         As Long
Dim lngValue      As Long
Dim lngBufferLen  As Long
Dim lngVerPointer As Long
Dim abytTemp()    As Byte
    '
    ' Retrieve language information from
    ' a file's version info storage.
    '
    If Len(mstrModuleName) > 0 Then
        hInst = GetModuleHandle(mstrModuleName)
       
        If hInst = 0 Then
            '
            ' Something's wrong here if the module isn't in memory!
            '
            Err.Raise adhcErrNoModuleHandle, _
             adhcClassName, "Unable to retrieve module handle."
        End If
        '
        ' The longest path allowed in Windows
        ' is 260 characters.
        '
        mstrFileName = Space(260)
        If GetModuleFileName(hInst, mstrFileName, Len(mstrFileName)) = 0 Then
            '
            ' If you can't get the file name, you're done!
            '
            Err.Raise adhcErrNoModule, _
             adhcClassName, "Unable to retrieve module file name."
        End If
    End If
    '
    ' At this point, whether the user supplied it,
    ' or whether the code just calculated
    ' it, mstrFileName had better contain
    ' some information at this point.
    '
    If Len(mstrFileName) = 0 Then
        Err.Raise adhcErrNoFileName, adhcClassName, _
         "Either you haven't specified a valid file name, or the module you specified can't be associated with a file."
    End If
   
    lngBufferLen = GetFileVersionInfoSize(mstrFileName, lngValue)
    If lngBufferLen = 0 Then
        Err.Raise adhcErrNoVersionInfoSize, adhcClassName, _
         "Unable to retrieve the version info size. Perhaps the module name or file name is invalid."
    End If
   
    ReDim mabytBuffer(0 To lngBufferLen - 1)
    If GetFileVersionInfo(mstrFileName, 0, lngBufferLen, mabytBuffer(0)) = 0 Then
        Err.Raise adhcErrNoVersionInfo, adhcClassName, _
         "Unable to retrieve version information."
    End If
   
    If VerQueryValue(mabytBuffer(0), "\VarFileInfo\Translation", _
     lngVerPointer, lngBufferLen) = 0 Then
        Err.Raise adhcErrNoLangCPInfo, adhcClassName, _
         "Unable to retrieve language and code page information."
    End If
    '
    ' lngVerPointer points to a 4-byte hex value. The first two bytes
    ' are the language ID, and the last two bytes are the code page.
    '
    ReDim abytTemp(0 To lngBufferLen - 1)
    Call RtlMoveMemory(abytTemp(0), lngVerPointer, lngBufferLen)
    '
    ' For American English, the bytes are: 9,4,228,4
    ' The PC swaps the high-order and low-order bytes, so
    ' that's really
    ' 4, 228, 4, 9
    ' or
    ' 04 E4 04 09
    ' 04E4 == 1252, the code page for Windows:Multilingual
    ' 0409 == 1033, US English
    ' If retrieving further information, it must be in the format
    ' lang-codepage, as a hex string, like "040904E4"
    '
    mstrLangCP = _
     ZeroPad(Hex$(abytTemp(1)), 2) & _
     ZeroPad(Hex$(abytTemp(0)), 2) & _
     ZeroPad(Hex$(abytTemp(3)), 2) & _
     ZeroPad(Hex$(abytTemp(2)), 2)

    If mstrLangCP = "00000000" Then
        '
        ' Something has gone wrong, and just
        ' punt and use American English instead.
        '
        mstrLangCP = "040904E4"
    End If
   
    If VerQueryValue(mabytBuffer(0), "\", _
     lngVerPointer, lngBufferLen) = 0 Then
        Err.Raise adhcNoFixedFileInfo, adhcClassName, _
         "Unable to retrieve fixed file version information."
    End If
    Call RtlMoveMemory(mffi, lngVerPointer, lngBufferLen)
End Sub
Private Function adhTrimNull(strVal As String) As String
Dim intPos As Integer
    '
    ' Trim the end of a string, stopping at the first
    ' null character.
    '

    intPos = InStr(1, strVal, vbNullChar)
    Select Case intPos
        Case Is > 1
            adhTrimNull = Left$(strVal, intPos - 1)
        Case 0
            adhTrimNull = strVal
        Case 1
            adhTrimNull = vbNullString
    End Select
   
End Function
Private Function ZeroPad(strValue As String, intLen As String) As String
   
    ZeroPad = Right$(String(intLen, "0") & strValue, intLen)
   
End Function
0
 
LVL 34

Author Comment

by:sramesh2k
ID: 16628045
Thanks danaseaman. Will try it and let you know.
I guess GetLocaleInfo is the one which helps you determine the language.
0
 
LVL 34

Author Comment

by:sramesh2k
ID: 16654725
Thanks, danaseaman.
I'll have to try this in the weekend.
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month14 days, 23 hours left to enroll

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question