Below is a code part I got somewhere and works fine for retrieving a
version from a single file. Now I want to retrieve all .dll, .ocx and
..exe file versions from my harddisk in all directory's. I generate a
array of all those files and then in a loop request the version for
each of those files.
Now it randomly crashes with a error that it cannot write to memory at
location xxxxxx. I cannot find the error and adding 'on error goto
blabla' doesnt help at all. Whats wrong on the code below ?
Many thanks for looking at it,
Fabster
Option Explicit
Declare Function GetFileVersionI nfo Lib "Version.dl l" Alias
"GetFileVersion InfoA" (ByVal lptstrFilename As String, ByVal dwhandle
As Long, ByVal dwlen As Long, lpData As Any) As Long
Declare Function GetFileVersionI nfoSize Lib "Version.dl l" Alias
"GetFileVersion InfoSizeA" (ByVal lptstrFilename As String, lpdwHandle
As Long) As Long
Declare Function VerQueryValue Lib "Version.dl l" Alias
"VerQueryValueA " (pBlock As Any, ByVal lpSubBlock As String,
lplpBuffer As Any, puLen As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMem ory" (dest As
Any, ByVal Source As Long, ByVal Length As Long)
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal
lpString1 As String, ByVal lpString2 As Long) As Long
Public Type FILEPROPERTIE
CompanyName As String
FileDescription As String
FileVersion As String
InternalName As String
LegalCopyright As String
OrigionalFileNa me As String
ProductName As String
ProductVersion As String
End Type
Public Function fileinfo(Option al ByVal PathWithFilenam e As String) As
FILEPROPERTIE
Dim lngBufferlen As Long
Dim lngDummy As Long
Dim lngRc As Long
Dim lngVerPointer As Long
Dim lngHexNumber As Long
Dim bytBuffer() As Byte
Dim bytBuff(255) As Byte
Dim strBuffer As String
Dim strLangCharset As String
Dim strVersionInfo( 7) As String
Dim strTemp As String
Dim intTemp As Integer
On Error GoTo 0
' size
lngBufferlen = GetFileVersionI nfoSize(PathWit hFilename, lngDummy)
If lngBufferlen > 0 Then
ReDim bytBuffer(lngBu fferlen)
lngRc = GetFileVersionI nfo(PathWithFil ename, 0&, lngBufferlen,
bytBuffer(0))
If lngRc <> 0 Then
lngRc = VerQueryValue(b ytBuffer(0),
"\VarFileInfo\T ranslation", lngVerPointer, lngBufferlen)
If lngRc <> 0 Then
'lngVerPointer is a pointer to four 4 bytes of Hex number,
'first two bytes are language id, and last two bytes are
code
'page. However, strLangCharset 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.
MoveMemory bytBuff(0), lngVerPointer, lngBufferlen
lngHexNumber = bytBuff(2) + bytBuff(3) * &H100 + bytBuff(0)
* &H10000 + bytBuff(1) * &H1000000
strLangCharset = Hex(lngHexNumbe r)
'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:Multili ngual
Do While Len(strLangChar set) < 8
strLangCharset = "0" & strLangCharset
Loop
' assign propertienames
strVersionInfo( 0) = "CompanyNam e"
strVersionInfo( 1) = "FileDescriptio n"
strVersionInfo( 2) = "FileVersio n"
strVersionInfo( 3) = "InternalNa me"
strVersionInfo( 4) = "LegalCopyright "
strVersionInfo( 5) = "OriginalFileNa me"
strVersionInfo( 6) = "ProductNam e"
strVersionInfo( 7) = "ProductVersion "
' loop and get fileproperties
For intTemp = 0 To 7
strBuffer = String$(255, 0)
strTemp = "\StringFileInf o\" & strLangCharset & "\" &
strVersionInfo( intTemp)
lngRc = VerQueryValue(b ytBuffer(0), strTemp,
lngVerPointer, lngBufferlen)
If lngRc <> 0 Then
' get and format data
lstrcpy strBuffer, lngVerPointer
strBuffer = Mid$(strBuffer, 1, InStr(strBuffer , Chr(0))
- 1)
strVersionInfo( intTemp) = strBuffer
Else
' property not found
strVersionInfo( intTemp) = "?"
End If
Next intTemp
End If
End If
End If
' assign array to user-defined-type
fileinfo.Compan yName = strVersionInfo( 0)
fileinfo.FileDe scription = strVersionInfo( 1)
fileinfo.FileVe rsion = strVersionInfo( 2)
fileinfo.Intern alName = strVersionInfo( 3)
fileinfo.LegalC opyright = strVersionInfo( 4)
fileinfo.Origio nalFileName = strVersionInfo( 5)
fileinfo.Produc tName = strVersionInfo( 6)
fileinfo.Produc tVersion = strVersionInfo( 7)
End Function
version from a single file. Now I want to retrieve all .dll, .ocx and
..exe file versions from my harddisk in all directory's. I generate a
array of all those files and then in a loop request the version for
each of those files.
Now it randomly crashes with a error that it cannot write to memory at
location xxxxxx. I cannot find the error and adding 'on error goto
blabla' doesnt help at all. Whats wrong on the code below ?
Many thanks for looking at it,
Fabster
Option Explicit
Declare Function GetFileVersionI nfo Lib "Version.dl l" Alias
"GetFileVersion InfoA" (ByVal lptstrFilename As String, ByVal dwhandle
As Long, ByVal dwlen As Long, lpData As Any) As Long
Declare Function GetFileVersionI nfoSize Lib "Version.dl l" Alias
"GetFileVersion InfoSizeA" (ByVal lptstrFilename As String, lpdwHandle
As Long) As Long
Declare Function VerQueryValue Lib "Version.dl l" Alias
"VerQueryValueA " (pBlock As Any, ByVal lpSubBlock As String,
lplpBuffer As Any, puLen As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMem ory" (dest As
Any, ByVal Source As Long, ByVal Length As Long)
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal
lpString1 As String, ByVal lpString2 As Long) As Long
Public Type FILEPROPERTIE
CompanyName As String
FileDescription As String
FileVersion As String
InternalName As String
LegalCopyright As String
OrigionalFileNa me As String
ProductName As String
ProductVersion As String
End Type
Public Function fileinfo(Option al ByVal PathWithFilenam e As String) As
FILEPROPERTIE
Dim lngBufferlen As Long
Dim lngDummy As Long
Dim lngRc As Long
Dim lngVerPointer As Long
Dim lngHexNumber As Long
Dim bytBuffer() As Byte
Dim bytBuff(255) As Byte
Dim strBuffer As String
Dim strLangCharset As String
Dim strVersionInfo( 7) As String
Dim strTemp As String
Dim intTemp As Integer
On Error GoTo 0
' size
lngBufferlen = GetFileVersionI nfoSize(PathWit hFilename, lngDummy)
If lngBufferlen > 0 Then
ReDim bytBuffer(lngBu fferlen)
lngRc = GetFileVersionI nfo(PathWithFil ename, 0&, lngBufferlen,
bytBuffer(0))
If lngRc <> 0 Then
lngRc = VerQueryValue(b ytBuffer(0),
"\VarFileInfo\T ranslation", lngVerPointer, lngBufferlen)
If lngRc <> 0 Then
'lngVerPointer is a pointer to four 4 bytes of Hex number,
'first two bytes are language id, and last two bytes are
code
'page. However, strLangCharset 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.
MoveMemory bytBuff(0), lngVerPointer, lngBufferlen
lngHexNumber = bytBuff(2) + bytBuff(3) * &H100 + bytBuff(0)
* &H10000 + bytBuff(1) * &H1000000
strLangCharset = Hex(lngHexNumbe r)
'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:Multili ngual
Do While Len(strLangChar set) < 8
strLangCharset = "0" & strLangCharset
Loop
' assign propertienames
strVersionInfo( 0) = "CompanyNam e"
strVersionInfo( 1) = "FileDescriptio n"
strVersionInfo( 2) = "FileVersio n"
strVersionInfo( 3) = "InternalNa me"
strVersionInfo( 4) = "LegalCopyright "
strVersionInfo( 5) = "OriginalFileNa me"
strVersionInfo( 6) = "ProductNam e"
strVersionInfo( 7) = "ProductVersion "
' loop and get fileproperties
For intTemp = 0 To 7
strBuffer = String$(255, 0)
strTemp = "\StringFileInf o\" & strLangCharset & "\" &
strVersionInfo( intTemp)
lngRc = VerQueryValue(b ytBuffer(0), strTemp,
lngVerPointer, lngBufferlen)
If lngRc <> 0 Then
' get and format data
lstrcpy strBuffer, lngVerPointer
strBuffer = Mid$(strBuffer, 1, InStr(strBuffer , Chr(0))
- 1)
strVersionInfo( intTemp) = strBuffer
Else
' property not found
strVersionInfo( intTemp) = "?"
End If
Next intTemp
End If
End If
End If
' assign array to user-defined-type
fileinfo.Compan yName = strVersionInfo( 0)
fileinfo.FileDe scription = strVersionInfo( 1)
fileinfo.FileVe rsion = strVersionInfo( 2)
fileinfo.Intern alName = strVersionInfo( 3)
fileinfo.LegalC opyright = strVersionInfo( 4)
fileinfo.Origio nalFileName = strVersionInfo( 5)
fileinfo.Produc tName = strVersionInfo( 6)
fileinfo.Produc tVersion = strVersionInfo( 7)
End Function