1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
| Private Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer
dwStrucVersionh As Integer
dwFileVersionMSl As Integer
dwFileVersionMSh As Integer
dwFileVersionLSl As Integer
dwFileVersionLSh As Integer
dwProductVersionMSl As Integer
dwProductVersionMSh As Integer
dwProductVersionLSl As Integer
dwProductVersionLSh As Integer
dwFileFlagsMask As Long
dwFileFlags As Long
dwFileOS As Long
dwFileType As Long
dwFileSubtype As Long
dwFileDateMS As Long
dwFileDateLS As Long
End Type
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 Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)
Private Function ShowMeExecInfo(ByVal ExecFilename As String) As String
Dim strFileStructureVersion As String
Dim strFileVersion As String
Dim strProductVersion As String
Dim strInfos As String
Dim lngReturns As Long
Dim lngDummy As Long
Dim strBuffer() As Byte
Dim lngBufferLen As Long
Dim lVerPointer As Long
Dim udtVerBuffer As VS_FIXEDFILEINFO
Dim lVerbufferLen As Long
lngBufferLen = GetFileVersionInfoSize(ExecFilename, lngDummy)
If lngBufferLen < 1 Then
ShowMeExecInfo = "Aucune information sur le fichier n'est disponible!"
Exit Function
End If
ReDim strBuffer(lngBufferLen)
lngReturns = GetFileVersionInfo(ExecFilename, 0&, lngBufferLen, strBuffer(0))
lngReturns = VerQueryValue(strBuffer(0), "\", lVerPointer, lVerbufferLen)
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
strFileStructureVersion = Format$(udtVerBuffer.dwStrucVersionh) & "." & Format$(udtVerBuffer.dwStrucVersionl)
strFileVersion = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
strProductVersion = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)
strInfos = "Exécutable: " + ExecFilename
strInfos = strInfos & vbCrLf & "Version de l'exécutable: " + strFileVersion
strInfos = strInfos & vbCrLf & "Version du produit: " + strProductVersion
ShowMeExecInfo = strInfos
End Function
Private Sub GetVersionExe()
Dim strFilename As String
Dim strFileInfos As String
strFilename = "C:\Program Files\Microsoft Office\Office\Winword.exe"
strFileInfos = ShowMeExecInfo(strFilename)
Debug.Print strFileInfos
End Sub |
Partager