怎样获得DLL自身的版本号？答者等我有分了必加

Question

怎么样才能获得DLL自身的版本号？谢谢

Answer 1

form部分Private Sub DisplayVerInfo()
        '*** 这个子程序获取文件的版本信息 ****
        Dim rc                As Long
        Dim lDummy            As Long
        Dim sBuffer()         As Byte
        Dim lBufferLen        As Long
        Dim lVerPointer       As Long
        Dim udtVerBuffer      As VS_FIXEDFILEINFO
        Dim lVerbufferLen     As Long
        Dim aBuffer()         As Byte
        Dim lAdd              As Long
        Dim astr              As String
        Dim lTran             As Long        '*** Get size ****
        lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
        If lBufferLen < 1 Then
           MsgBox "无法获取文件版本信息!"
           Exit Sub
        End If        '**** 获取文件信息并且保存到udtVerBuffer结构中 ****
        ReDim sBuffer(lBufferLen)
        rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
        rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
        MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
                
        StrucVer = Format$(udtVerBuffer.dwStrucVersionh) & "." & _
           Format$(udtVerBuffer.dwStrucVersionl)        '**** 获得文件版本 ****
        FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." & _
           Format$(udtVerBuffer.dwFileVersionMSl) & "." & _
           Format$(udtVerBuffer.dwFileVersionLSh) & "." & _
           Format$(udtVerBuffer.dwFileVersionLSl)        '**** 获取产品版本 ****
        ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & _
           Format$(udtVerBuffer.dwProductVersionMSl) & "." & _
           Format$(udtVerBuffer.dwProductVersionLSh) & "." & _
           Format$(udtVerBuffer.dwProductVersionLSl)        '**** 获取文件类型 ****
        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 "        '**** 获取文件所适应的操作系统 ****
        Select Case udtVerBuffer.dwFileOS
           Case VOS_WINDOWS32
             FileOS = "Win32位操作系统"
           Case VOS_WINDOWS16
             FileOS = "Win16位操作系统"
           Case VOS_DOS
             FileOS = "DOS操作系统"
           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 = "未知操作系统"
        End Select
        Select Case udtVerBuffer.dwFileType
           Case VFT_APP
              FileType = "应用程序"
           Case VFT_DLL
              FileType = "动态连接库"
           Case VFT_DRV
              FileType = "驱动程序"
              Select Case udtVerBuffer.dwFileSubtype
                 Case VFT2_DRV_PRINTER
                    FileSubType = "打印驱动程序"
                 Case VFT2_DRV_KEYBOARD
                    FileSubType = "键盘驱动程序"
                 Case VFT2_DRV_LANGUAGE
                    FileSubType = "语言模块"
                 Case VFT2_DRV_DISPLAY
                    FileSubType = "显示驱动程序"
                 Case VFT2_DRV_MOUSE
                    FileSubType = "鼠标驱动程序"
                 Case VFT2_DRV_NETWORK
                    FileSubType = "网络驱动程序"
                 Case VFT2_DRV_SYSTEM
                    FileSubType = "系统驱动程序"
                 Case VFT2_DRV_INSTALLABLE
                    FileSubType = "Installable"
                 Case VFT2_DRV_SOUND
                    FileSubType = "声音驱动程序"
                 Case VFT2_DRV_COMM
                    FileSubType = "串行驱动程序"
                 Case VFT2_UNKNOWN
                    FileSubType = "未知驱动程序"
              End Select
           Case VFT_FONT
              FileType = "字体"
              Select Case udtVerBuffer.dwFileSubtype
                 Case VFT_FONT_RASTER
                    FileSubType = "光栅字体"
                 Case VFT_FONT_VECTOR
                    FileSubType = "矢量字体"
                 Case VFT_FONT_TRUETYPE
                    FileSubType = "TrueType字体"
              End Select
           Case VFT_VXD
              FileType = "VxD"
           Case VFT_STATIC_LIB
              FileType = "Lib"
           Case Else
              FileType = "未知"
        End Select

Answer 2

Form1.CurrentX = 4
        Form1.CurrentY = 4
        Form1.Print "文件全路径:"
        Form1.CurrentX = 4
        Form1.Print "文件版本:"
        Form1.CurrentX = 4
        Form1.Print "产品版本:"
        Form1.CurrentX = 4
        Form1.Print "文件标志:"
        Form1.CurrentX = 4
        Form1.Print "操作系统:"
        Form1.CurrentX = 4
        Form1.Print "文件类型:"
        Form1.CurrentX = 4
        Form1.Print "文件子类型:"
        Form1.CurrentX = 60
        Form1.CurrentY = 4
        Form1.Print FullFileName
        Form1.CurrentX = 60
        Form1.Print FileVer
        Form1.CurrentX = 60
        Form1.Print ProdVer
        Form1.CurrentX = 60
        Form1.Print FileFlags
        Form1.CurrentX = 60
        Form1.Print FileOS
        Form1.CurrentX = 60
        Form1.Print FileType
        Form1.CurrentX = 60
        Form1.Print FileSubType
        '清除上一次保存的信息
        FullFileName = ""
        FileVer = ""
        ProdVer = ""
        FileFlags = ""
        FileOS = ""
        FileType = ""
        FileSubType = ""
        
        
        ReDim aBuffer(lBufferLen)
        Dim ab As VS_NEWINFO
        
        lVerPointer = 0
        rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
        rc = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lVerPointer, lVerbufferLen)
        MoveMemory lTran, lVerPointer, 4&
        astr = "0" + Hex$(lTran)
        astr = Right$(astr, 4) + Left$(astr, 4)
        rc = VerQueryValue(sBuffer(0), "\StringFileInfo\" + astr + "\FileDescription", lVerPointer, lVerbufferLen)
        MoveMemory ab, lVerPointer, Len(ab)
        Form1.CurrentX = 4
        Form1.Print "文件描述";
        Form1.CurrentX = 60
        Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
        
        rc = VerQueryValue(sBuffer(0), "\StringFileInfo\" + astr + "\ProductName", lVerPointer, lVerbufferLen)
        If rc Then
          MoveMemory ab, lVerPointer, Len(ab)
          Form1.CurrentX = 4
          Form1.Print "产品名称";
          Form1.CurrentX = 60
          Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
        End If
        
        rc = VerQueryValue(sBuffer(0), "\StringFileInfo\" + astr + "\OriginalFilename", lVerPointer, lVerbufferLen)
        If rc Then
          MoveMemory ab, lVerPointer, Len(ab)
          Form1.CurrentX = 4
          Form1.Print "文件原始名";
          Form1.CurrentX = 60
          Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
        End If
        
        rc = VerQueryValue(sBuffer(0), "\StringFileInfo\" + astr + "\InternalName", lVerPointer, lVerbufferLen)
        If rc Then
          MoveMemory ab, lVerPointer, Len(ab)
          Form1.CurrentX = 4
          Form1.Print "文件内部名";
          Form1.CurrentX = 60
          Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
        End If
        
        rc = VerQueryValue(sBuffer(0), "\StringFileInfo\" + astr + "\CompanyName", lVerPointer, lVerbufferLen)
        If rc Then
          MoveMemory ab, lVerPointer, Len(ab)
          Form1.CurrentX = 4
          Form1.Print "公司名称";
          Form1.CurrentX = 60
          Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
        End If
        
        rc = VerQueryValue(sBuffer(0), "\StringFileInfo\" + astr + "\LegalCopyright", lVerPointer, lVerbufferLen)
        If rc Then
          MoveMemory ab, lVerPointer, Len(ab)
          Form1.CurrentX = 4
          Form1.Print "版权所有";
          Form1.CurrentX = 60
          Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
        End If
End SubPrivate Sub Command1_Click()
    Form1.Cls
    CommonDialog1.ShowOpen
    FullFileName = CommonDialog1.Filename
    If FullFileName = "" Then
        Exit Sub
    End If
    Call DisplayVerInfo
End Sub

Answer 3

模块部分     ' **** 全局定义 ****     Public Filename As String
     Public Directory As String
     Public FullFileName As String     Public StrucVer As String
     Public FileVer As String
     Public ProdVer As String
     Public FileFlags As String
     Public FileOS As String
     Public FileType As String
     Public FileSubType As String
    
     Type VS_NEWINFO
        astr As String * 1024
     End Type
     
     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     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
     Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias _
        "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, _
        lpdwHandle As Long) As Long
     Declare Function VerQueryValue Lib "Version.dll" Alias _
        "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
        lplpBuffer As Any, puLen As Long) As Long
     Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (dest As Any, ByVal Source As Long, ByVal length As Long)
     Declare Function GetSystemDirectory Lib "kernel32" Alias _
        "GetSystemDirectoryA" (ByVal Path As String, ByVal cbBytes As Long) As Long
          Public Const VS_FFI_SIGNATURE = &HFEEF04BD
     Public Const VS_FFI_STRUCVERSION = &H10000
     Public Const VS_FFI_FILEFLAGSMASK = &H3F&
     Public Const VS_FF_DEBUG = &H1
     Public Const VS_FF_PRERELEASE = &H2
     Public Const VS_FF_PATCHED = &H4
     Public Const VS_FF_PRIVATEBUILD = &H8
     Public Const VS_FF_INFOINFERRED = &H10
     Public Const VS_FF_SPECIALBUILD = &H20
     Public Const VOS_UNKNOWN = &H0
     Public Const VOS_DOS = &H10000
     Public Const VOS_OS216 = &H20000
     Public Const VOS_OS232 = &H30000
     Public Const VOS_NT = &H40000     Public Const VOS_BASE = &H0
     Public Const VOS_WINDOWS16 = &H1
     Public Const VOS_PM16 = &H2
     Public Const VOS_PM32 = &H3
     Public Const VOS_WINDOWS32 = &H4     Public Const VOS_DOS_WINDOWS16 = &H10001
     Public Const VOS_DOS_WINDOWS32 = &H10004
     Public Const VOS_OS216_PM16 = &H20002
     Public Const VOS_OS232_PM32 = &H30003
     Public Const VOS_NT_WINDOWS32 = &H40004
          Public Const VFT_UNKNOWN = &H0
     Public Const VFT_APP = &H1
     Public Const VFT_DLL = &H2
     Public Const VFT_DRV = &H3
     Public Const VFT_FONT = &H4
     Public Const VFT_VXD = &H5
     Public Const VFT_STATIC_LIB = &H7
     Public Const VFT2_UNKNOWN = &H0
     Public Const VFT2_DRV_PRINTER = &H1
     Public Const VFT2_DRV_KEYBOARD = &H2
     Public Const VFT2_DRV_LANGUAGE = &H3
     Public Const VFT2_DRV_DISPLAY = &H4
     Public Const VFT2_DRV_MOUSE = &H5
     Public Const VFT2_DRV_NETWORK = &H6
     Public Const VFT2_DRV_SYSTEM = &H7
     Public Const VFT2_DRV_INSTALLABLE = &H8
     Public Const VFT2_DRV_SOUND = &H9
     Public Const VFT2_DRV_COMM = &HA