Crashing getfileversioninfo function, what did I do wrong ?

Collapse
This topic is closed.
X
X
 
  • Time
  • Show
Clear All
new posts
  • Fabster

    Crashing getfileversioninfo function, what did I do wrong ?

    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
Working...