Article ID: 160042
Article Last Modified on 2/10/2005
139491 How To Use Functions in VERSION.DLL - A 32-bit Sample App
Option Explicit
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 GetSystemDirectory Lib "kernel32" _
Alias "GetSystemDirectoryA" _
(ByVal Path As String, _
ByVal cbBytes As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dest As Any, _
ByVal Source As Long, _
ByVal Length As Long)
Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal lpString1 As String, _
ByVal lpString2 As Long) As Long
Private Sub Command1_Click()
Dim Buffer As String
Dim rc As Long
Dim FullFileName As String
'*** We will check the FileDescription of the gdi32.dll****
Buffer = String(255, 0)
rc = GetSystemDirectory(Buffer, Len(Buffer))
Buffer = LCase$(Mid$(Buffer, 1, InStr(Buffer, Chr(0)) - 1))
FullFileName = Buffer & "\gdi32.dll"
Dim lBufferLen As Long, lDummy As Long
'*** Get size ****
lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
If lBufferLen < 1 Then
MsgBox "No Version Info available!"
Exit Sub
End If
Dim sBuffer() As Byte
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(FullFileName, _
0&, _
lBufferLen, _
sBuffer(0))
If rc = 0 Then
MsgBox "GetFileVersionInfo failed."
Exit Sub
End If
Dim lVerPointer As Long
rc = VerQueryValue(sBuffer(0), _
"\VarFileInfo\Translation", _
lVerPointer, _
lBufferLen)
If rc = 0 Then
MsgBox "VerQueryValue failed."
Exit Sub
End If
'lVerPointer is a pointer to four 4 bytes of Hex number,
'first two bytes are language id, and last two bytes are code
'page. However, Lang_Charset_String needs a string of
'4 hex digits, the first two characters correspond to the
'language id and last two the last two character correspond
'to the code page id.
Dim bytebuffer(255) As Byte
MoveMemory bytebuffer(0), lVerPointer, lBufferLen
Dim Lang_Charset_String As String
Dim HexNumber As Long
HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + _
bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
Lang_Charset_String = Hex(HexNumber)
'now we change the order of the language id and code page
'and convert it into a string representation.
'For example, it may look like 040904E4
'Or to pull it all apart:
'04------ = SUBLANG_ENGLISH_USA
'--09---- = LANG_ENGLISH
' ----04E4 = 1252 = Codepage for Windows:Multilingual
Do While Len(Lang_Charset_String) < 8
Lang_Charset_String = "0" & Lang_Charset_String
Loop
List1.Clear
Dim strVersionInfo(7) As String
strVersionInfo(0) = "CompanyName"
strVersionInfo(1) = "FileDescription"
strVersionInfo(2) = "FileVersion"
strVersionInfo(3) = "InternalName"
strVersionInfo(4) = "LegalCopyright"
strVersionInfo(5) = "OriginalFileName"
strVersionInfo(6) = "ProductName"
strVersionInfo(7) = "ProductVersion"
Dim i As Integer
Dim strTemp As String
For i = 0 To 7
Buffer = String(255, 0)
strTemp = "\StringFileInfo\" & Lang_Charset_String _
& "\" & strVersionInfo(i)
rc = VerQueryValue(sBuffer(0), strTemp, _
lVerPointer, lBufferLen)
If rc = 0 Then
MsgBox "VerQueryValue failed at" & i
Exit Sub
End If
lstrcpy Buffer, lVerPointer
Buffer = Mid$(Buffer, 1, InStr(Buffer, Chr(0)) - 1)
List1.AddItem strVersionInfo(i) & ": " & Buffer
Next i
End Sub
Keywords: kbhowto kbapi KB160042