获取EXE文件版本号

sudeping_ok 2008-02-11 08:07:31

MsgBox App.Major & "." & App.Minor & "." & App.Revision
可以得到程序自身EXE文件的版本号，我希望能通过输入文件路径的方式来获得其他EXE文件的版本号，请高人赐教

...全文

152 7 打赏收藏转发到动态举报

写回复

用AI写文章

7 条回复

切换为时间正序

请发表友善的回复…

发表回复

ZOU_SEAFARER 2008-02-15

打赏
举报

楼住你是猪，给你形成的代码都不好好分析

用户　昵称 2008-02-11

打赏
举报



  Private Sub Form_Load()

          'Source   ->   MS   Knowledge   Base

          'set   the   file

          Filename = "kernel32.dll"

          Directory = "c:\windows\system32\"

          FullFileName = Directory + Filename

          'set   graphics   mode   to   persistent

          Me.AutoRedraw = True

          'retrieve   the   information

          DisplayVerInfo

          'show   the   results

          Me.Print "Full   filename:   " + FullFileName

          Me.Print "File   version:   " + FileVer

          Me.Print "Product   version:   " + ProdVer

          Me.Print "File   flags:   " + FileFlags

          Me.Print "File   OS:   " + FileOS

          Me.Print "File   type:   " + FileType + IIf(FileSubType = "", "", "   (" + FileSubType + ")")

  End Sub

用户　昵称 2008-02-11

打赏
举报



Option Explicit



  Private Type VS_FIXEDFILEINFO

        dwSignature   As Long

        dwStrucVersionl   As Integer             '     e.g.   =   &h0000   =   0

        dwStrucVersionh   As Integer             '     e.g.   =   &h0042   =   .42

        dwFileVersionMSl   As Integer           '     e.g.   =   &h0003   =   3

        dwFileVersionMSh   As Integer           '     e.g.   =   &h0075   =   .75

        dwFileVersionLSl   As Integer           '     e.g.   =   &h0000   =   0

        dwFileVersionLSh   As Integer           '     e.g.   =   &h0031   =   .31

        dwProductVersionMSl   As Integer     '     e.g.   =   &h0003   =   3

        dwProductVersionMSh   As Integer     '     e.g.   =   &h0010   =   .1

        dwProductVersionLSl   As Integer     '     e.g.   =   &h0000   =   0

        dwProductVersionLSh   As Integer     '     e.g.   =   &h0031   =   .31

        dwFileFlagsMask   As Long                   '     =   &h3F   for   version   "0.42"

        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

  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)

  Dim Filename     As String, Directory       As String, FullFileName       As String

  Dim StrucVer     As String, FileVer       As String, ProdVer       As String

  Dim FileFlags     As String, FileOS       As String, FileType       As String, FileSubType       As String

  Private Sub DisplayVerInfo()

        Dim rc     As Long, lDummy       As Long, sBuffer()       As Byte

        Dim lBufferLen     As Long, lVerPointer       As Long, udtVerBuffer       As VS_FIXEDFILEINFO

        Dim lVerbufferLen     As Long

        '***   Get   size   ****

        lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)

        If lBufferLen < 1 Then

              MsgBox "No   Version   Info   available!"

              Exit Sub

        End If

        '****   Store   info   to   udtVerBuffer   struct   ****

        ReDim sBuffer(lBufferLen)

        rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))

        rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)

        MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)

        '****   Determine   Structure   Version   number   -   NOT   USED   ****

        StrucVer = Format$(udtVerBuffer.dwStrucVersionh) & "." & Format$(udtVerBuffer.dwStrucVersionl)

        '****   Determine   File   Version   number   ****

        FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)

        '****   Determine   Product   Version   number   ****

        ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)

        '****   Determine   Boolean   attributes   of   File   ****



        FileFlags = ""

        If udtVerBuffer.dwFileFlags And VS_FF_DEBUG Then FileFlags = "Debug   "

        If udtVerBuffer.dwFileFlags And VS_FF_PRERELEASE Then FileFlags = FileFlags & "PreRel   "

        If udtVerBuffer.dwFileFlags And VS_FF_PATCHED Then FileFlags = FileFlags & "Patched   "

        If udtVerBuffer.dwFileFlags And VS_FF_PRIVATEBUILD Then FileFlags = FileFlags & "Private   "

        If udtVerBuffer.dwFileFlags And VS_FF_INFOINFERRED Then FileFlags = FileFlags & "Info   "

        If udtVerBuffer.dwFileFlags And VS_FF_SPECIALBUILD Then FileFlags = FileFlags & "Special   "

        If udtVerBuffer.dwFileFlags And VFT2_UNKNOWN Then FileFlags = FileFlags + "Unknown   "

        '****   Determine   OS   for   which   file   was   designed   ****

        Select Case udtVerBuffer.dwFileOS

              Case VOS_DOS_WINDOWS16

                  FileOS = "DOS-Win16"

              Case VOS_DOS_WINDOWS32

                  FileOS = "DOS-Win32"

              Case VOS_OS216_PM16

                  FileOS = "OS/2-16   PM-16"

              Case VOS_OS232_PM32

                  FileOS = "OS/2-16   PM-32"

              Case VOS_NT_WINDOWS32

                  FileOS = "NT-Win32"

              Case Else

                  FileOS = "Unknown"

        End Select

        Select Case udtVerBuffer.dwFileType

              Case VFT_APP

                    FileType = "App"

              Case VFT_DLL

                    FileType = "DLL"

              Case VFT_DRV

                    FileType = "Driver"

                    Select Case udtVerBuffer.dwFileSubtype

                          Case VFT2_DRV_PRINTER

                                FileSubType = "Printer   drv"

                          Case VFT2_DRV_KEYBOARD

                                FileSubType = "Keyboard   drv"

                          Case VFT2_DRV_LANGUAGE

                                FileSubType = "Language   drv"

                          Case VFT2_DRV_DISPLAY

                                FileSubType = "Display   drv"

                          Case VFT2_DRV_MOUSE

                                FileSubType = "Mouse   drv"

                          Case VFT2_DRV_NETWORK

                                FileSubType = "Network   drv"

                          Case VFT2_DRV_SYSTEM

                                FileSubType = "System   drv"

                          Case VFT2_DRV_INSTALLABLE

                                FileSubType = "Installable"

                          Case VFT2_DRV_SOUND

                                FileSubType = "Sound   drv"

                          Case VFT2_DRV_COMM

                                FileSubType = "Comm   drv"

                          Case VFT2_UNKNOWN

                                FileSubType = "Unknown"

                    End Select

              Case VFT_FONT

                    FileType = "Font"

                    Select Case udtVerBuffer.dwFileSubtype

                          'Case VFT_FONT_RASTER

                          '      FileSubType = "Raster   Font"

                          'Case VFT_FONT_VECTOR

                          '      FileSubType = "Vector   Font"

                          'Case VFT_FONT_TRUETYPE

                          '      FileSubType = "TrueType   Font"

                    End Select

              Case VFT_VXD

                    FileType = "VxD"

              Case VFT_STATIC_LIB

                    FileType = "Lib"

              Case Else

                    FileType = "Unknown"

        End Select

  End Sub

sudeping_ok 2008-02-11

打赏
举报

Private Sub Form_Load() 以上部分是在通用里？但通用里怎么能有FileFlags = "" 赋值语句？
Private Sub Form_Load() 中DisplayVerInfo是怎么回事？

用户　昵称 2008-02-11

打赏
举报



        FileFlags   =   ""   

        If   udtVerBuffer.dwFileFlags   And   VS_FF_DEBUG   Then   FileFlags   =   "Debug   "   

        If   udtVerBuffer.dwFileFlags   And   VS_FF_PRERELEASE   Then   FileFlags   =   FileFlags   &   "PreRel   "   

        If   udtVerBuffer.dwFileFlags   And   VS_FF_PATCHED   Then   FileFlags   =   FileFlags   &   "Patched   "   

        If   udtVerBuffer.dwFileFlags   And   VS_FF_PRIVATEBUILD   Then   FileFlags   =   FileFlags   &   "Private   "   

        If   udtVerBuffer.dwFileFlags   And   VS_FF_INFOINFERRE   Then   FileFlags   =   FileFlags   &   "Info   "   

        If   udtVerBuffer.dwFileFlags   And   VS_FF_SPECIALBUILD   Then   FileFlags   =   FileFlags   &   "Special   "   

        If   udtVerBuffer.dwFileFlags   And   VFT2_UNKNOWN   Then   FileFlags   =   FileFlags   +   "Unknown   "   

        '****   Determine   OS   for   which   file   was   designed   ****   

        Select   Case   udtVerBuffer.dwFileOS   

              Case   VOS_DOS_WINDOWS16   

                  FileOS   =   "DOS-Win16"   

              Case   VOS_DOS_WINDOWS32   

                  FileOS   =   "DOS-Win32"   

              Case   VOS_OS216_PM16   

                  FileOS   =   "OS/2-16   PM-16"   

              Case   VOS_OS232_PM32   

                  FileOS   =   "OS/2-16   PM-32"   

              Case   VOS_NT_WINDOWS32   

                  FileOS   =   "NT-Win32"   

              Case   other   

                  FileOS   =   "Unknown"   

        End   Select   

        Select   Case   udtVerBuffer.dwFileType   

              Case   VFT_APP   

                    FileType   =   "App"   

              Case   VFT_DLL   

                    FileType   =   "DLL"   

              Case   VFT_DRV   

                    FileType   =   "Driver"   

                    Select   Case   udtVerBuffer.dwFileSubtype   

                          Case   VFT2_DRV_PRINTER   

                                FileSubType   =   "Printer   drv"   

                          Case   VFT2_DRV_KEYBOARD   

                                FileSubType   =   "Keyboard   drv"   

                          Case   VFT2_DRV_LANGUAGE   

                                FileSubType   =   "Language   drv"   

                          Case   VFT2_DRV_DISPLAY   

                                FileSubType   =   "Display   drv"   

                          Case   VFT2_DRV_MOUSE   

                                FileSubType   =   "Mouse   drv"   

                          Case   VFT2_DRV_NETWORK   

                                FileSubType   =   "Network   drv"   

                          Case   VFT2_DRV_SYSTEM   

                                FileSubType   =   "System   drv"   

                          Case   VFT2_DRV_INSTALLABLE   

                                FileSubType   =   "Installable"   

                          Case   VFT2_DRV_SOUND   

                                FileSubType   =   "Sound   drv"   

                          Case   VFT2_DRV_COMM   

                                FileSubType   =   "Comm   drv"   

                          Case   VFT2_UNKNOWN   

                                FileSubType   =   "Unknown"   

                    End   Select   

              Case   VFT_FONT   

                    FileType   =   "Font"   

                    Select   Case   udtVerBuffer.dwFileSubtype   

                          Case   VFT_FONT_RASTER   

                                FileSubType   =   "Raster   Font"   

                          Case   VFT_FONT_VECTOR   

                                FileSubType   =   "Vector   Font"   

                          Case   VFT_FONT_TRUETYPE   

                                FileSubType   =   "TrueType   Font"   

                    End   Select   

              Case   VFT_VXD   

                    FileType   =   "VxD"   

              Case   VFT_STATIC_LIB   

                    FileType   =   "Lib"   

              Case   Else   

                    FileType   =   "Unknown"   

        End   Select   

  End   Sub   

  Private   Sub   Form_Load()   

          'Source   ->   MS   Knowledge   Base   

          'set   the   file   

          Filename   =   "kernel32.dll"   

          Directory   =   "c:\windows\system\"   

          FullFileName   =   Directory   +   Filename   

          'set   graphics   mode   to   persistent   

          Me.AutoRedraw   =   True   

          'retrieve   the   information   

          DisplayVerInfo   

          'show   the   results   

          Me.Print   "Full   filename:   "   +   FullFileName   

          Me.Print   "File   version:   "   +   FileVer   

          Me.Print   "Product   version:   "   +   ProdVer   

          Me.Print   "File   flags:   "   +   FileFlags   

          Me.Print   "File   OS:   "   +   FileOS   

          Me.Print   "File   type:   "   +   FileType   +   IIf(FileSubType   =   "",   "",   "   ("   +   FileSubType   +   ")")   

  End   Sub

用户　昵称 2008-02-11

打赏
举报



Const   VS_FFI_SIGNATURE   =   &HFEEF04BD   

  Const   VS_FFI_STRUCVERSION   =   &H10000   

  Const   VS_FFI_FILEFLAGSMASK   =   &H3F&   

  Const   VS_FF_DEBUG   =   &H1   

  Const   VS_FF_PRERELEASE   =   &H2   

  Const   VS_FF_PATCHED   =   &H4   

  Const   VS_FF_PRIVATEBUILD   =   &H8   

  Const   VS_FF_INFOINFERRED   =   &H10   

  Const   VS_FF_SPECIALBUILD   =   &H20   

  Const   VOS_UNKNOWN   =   &H0   

  Const   VOS_DOS   =   &H10000   

  Const   VOS_OS216   =   &H20000   

  Const   VOS_OS232   =   &H30000   

  Const   VOS_NT   =   &H40000   

  Const   VOS__BASE   =   &H0   

  Const   VOS__WINDOWS16   =   &H1   

  Const   VOS__PM16   =   &H2   

  Const   VOS__PM32   =   &H3   

  Const   VOS__WINDOWS32   =   &H4   

  Const   VOS_DOS_WINDOWS16   =   &H10001   

  Const   VOS_DOS_WINDOWS32   =   &H10004   

  Const   VOS_OS216_PM16   =   &H20002   

  Const   VOS_OS232_PM32   =   &H30003   

  Const   VOS_NT_WINDOWS32   =   &H40004   

  Const   VFT_UNKNOWN   =   &H0   

  Const   VFT_APP   =   &H1   

  Const   VFT_DLL   =   &H2   

  Const   VFT_DRV   =   &H3   

  Const   VFT_FONT   =   &H4   

  Const   VFT_VXD   =   &H5   

  Const   VFT_STATIC_LIB   =   &H7   

  Const   VFT2_UNKNOWN   =   &H0   

  Const   VFT2_DRV_PRINTER   =   &H1   

  Const   VFT2_DRV_KEYBOARD   =   &H2   

  Const   VFT2_DRV_LANGUAGE   =   &H3   

  Const   VFT2_DRV_DISPLAY   =   &H4   

  Const   VFT2_DRV_MOUSE   =   &H5   

  Const   VFT2_DRV_NETWORK   =   &H6   

  Const   VFT2_DRV_SYSTEM   =   &H7   

  Const   VFT2_DRV_INSTALLABLE   =   &H8   

  Const   VFT2_DRV_SOUND   =   &H9   

  Const   VFT2_DRV_COMM   =   &HA   

  Private   Type   VS_FIXEDFILEINFO   

        dwSignature   As   Long   

        dwStrucVersionl   As   Integer           '     e.g.   =   &h0000   =   0   

        dwStrucVersionh   As   Integer           '     e.g.   =   &h0042   =   .42   

        dwFileVersionMSl   As   Integer         '     e.g.   =   &h0003   =   3   

        dwFileVersionMSh   As   Integer         '     e.g.   =   &h0075   =   .75   

        dwFileVersionLSl   As   Integer         '     e.g.   =   &h0000   =   0   

        dwFileVersionLSh   As   Integer         '     e.g.   =   &h0031   =   .31   

        dwProductVersionMSl   As   Integer   '     e.g.   =   &h0003   =   3   

        dwProductVersionMSh   As   Integer   '     e.g.   =   &h0010   =   .1   

        dwProductVersionLSl   As   Integer   '     e.g.   =   &h0000   =   0   

        dwProductVersionLSh   As   Integer   '     e.g.   =   &h0031   =   .31   

        dwFileFlagsMask   As   Long                 '     =   &h3F   for   version   "0.42"   

        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   

  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)   

  Dim   Filename   As   String,   Directory   As   String,   FullFileName   As   String   

  Dim   StrucVer   As   String,   FileVer   As   String,   ProdVer   As   String   

  Dim   FileFlags   As   String,   FileOS   As   String,   FileType   As   String,   FileSubType   As   String   

  Private   Sub   DisplayVerInfo()   

        Dim   rc   As   Long,   lDummy   As   Long,   sBuffer()   As   Byte   

        Dim   lBufferLen   As   Long,   lVerPointer   As   Long,   udtVerBuffer   As   VS_FIXEDFILEINFO   

        Dim   lVerbufferLen   As   Long   

        '***   Get   size   ****   

        lBufferLen   =   GetFileVersionInfoSize(FullFileName,   lDummy)   

        If   lBufferLen   <   1   Then   

              MsgBox   "No   Version   Info   available!"   

              Exit   Sub   

        End   If   

        '****   Store   info   to   udtVerBuffer   struct   ****   

        ReDim   sBuffer(lBufferLen)   

        rc   =   GetFileVersionInfo(FullFileName,   0&,   lBufferLen,   sBuffer(0))   

        rc   =   VerQueryValue(sBuffer(0),   "\",   lVerPointer,   lVerbufferLen)   

        MoveMemory   udtVerBuffer,   lVerPointer,   Len(udtVerBuffer)   

        '****   Determine   Structure   Version   number   -   NOT   USED   ****   

        StrucVer   =   Format$(udtVerBuffer.dwStrucVersionh)   &   "."   &   Format$(udtVerBuffer.dwStrucVersionl)   

        '****   Determine   File   Version   number   ****   

        FileVer   =   Format$(udtVerBuffer.dwFileVersionMSh)   &   "."   &   Format$(udtVerBuffer.dwFileVersionMSl)   &   "."   &   Format$(udtVerBuffer.dwFileVersionLSh)   &   "."   &   Format$(udtVerBuffer.dwFileVersionLSl)   

        '****   Determine   Product   Version   number   ****   

        ProdVer   =   Format$(udtVerBuffer.dwProductVersionMSh)   &   "."   &   Format$(udtVerBuffer.dwProductVersionMSl)   &   "."   &   Format$(udtVerBuffer.dwProductVersionLSh)   &   "."   &   Format$(udtVerBuffer.dwProductVersionLSl)   

        '****   Determine   Boolean   attributes   of   File   ****