获取程序的版本信息 --- VB

取自病毒防火墙里的代码，获取到启动项后，需要根据路径获取到程序的版本信息，后来网上找了一些代码都不能用，经过自己努力终于解决了问题，也发现了API示例里的问题所在。

大致需要3个函数GetFileVersionInfoSize，GetFileVersionInfo，VerQueryValue

API的解释为：

-------------------------------------------------------GetFileVersionInfoSize

【操作系统】
Win9X:Yes
WinNT:Yes
【说明】
针对包含了版本资源的一个文件，判断容纳文件版本信息需要一个多大的缓冲区
【返回值】
Long，容纳文件的版本资源所需的缓冲区长度。如文件不包含版本信息，则返回一个0值。会设置GetLastError
【其它】
lpdwHandle参数在win32中已经放弃
【参数表】
lptstrFilename - String，包含了版本资源的一个文件的名字
lpdwHandle ----- Long，在这个变量中载入0值

---------------------------------------------------------------------------------------------------------------------------------------------------------------------

-------------------------------------------------------GetFileVersionInfo

【操作系统】
Win9X:Yes
WinNT:Yes
【说明】
从支持版本标记的一个模块里获取文件版本信息
【返回值】
Long，非零表示成功，零表示失败。会设置GetLastError
【其它】
请看vb的api文本查看器中的声明：Declare Function
(ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As
Any) As Long
【参数表】
lptstrFilename - String，欲从中载入版本信息的一个文件的名字
dwHandle ------- Long，win32中未用
dwLen ---------- Long，由lpData参数指定的字节数组或缓冲区的大小。用GetFileVersionInfoSize函数判断要求的缓冲区长度有多大
lpData --------- Byte，指定一个字节缓冲区的第一个字节。该缓冲区用于装载文件的版本信息

---------------------------------------------------------------------------------------------------------------------------------------------------------------------

-------------------------------------------------------VerQueryValue

【操作系统】
Win9X:Yes
WinNT:Yes
【说明】
这个函数用于从版本资源中获取信息。调用这个函数前，必须先用GetFileVersionInfo函数获取版本资源信息。这个函数会检查资源信息，并将需要的数据复制到一个缓冲区里
【返回值】
Long，TRUE（非零）表示成功，如请求的信息不存在，或pBlock不属于有效版本信息，那就返回一个零
【其它】
从vb的api文本查看器复制的声明如下：
(pBlock As Any, ByVal lpSubBlock As String, ByVal lplpBuffer As Long, puLen As Long) As
Long
【参数表】
pBlock --------- Byte，指定一个内存块第一个字节的地址。这个内存块包含了由GetFileVersionInfo函数取回的版本数据信息
lpSubBlock ----- String，下述值之一：
"\"
获取文件的VS_FIXEDFILEINFO结构
"\VarFileInfo\Translation"
获取文件的翻译表
"\StringFileInfo\...."
获取文件的字串信息。参考注解
lplpBuffer ----- Long，指定一个Long变量的地址，该变量用于装载一个缓冲区的地址。请求的版本信息最终会装载到那个缓冲区里
puLen ---------- Long，指定由lplpBuffer参数引用的数据值的长度，以字节为单位

---------------------------------------------------------------------------------------------------------------------------------------------------------------------

流程为GetFileVersionInfoSize获取到文件信息的SIZE返回一个long，然后根据值调用GetFileVersionInfo将信息复制到一个缓冲区里，最后就是调用VerQueryValue从缓冲区中取得需要的信息，具体的看MSDN。

然后给了一个例子：

——————————————————————————————————————————————————————————————-

'Example Name: Determining the Cipher Strength of IE
'------------------------------------------------------------------------------
'
' Form Code
'
'------------------------------------------------------------------------------
Option Explicit
Private Type VS_FIXEDFILEINFO
   dwSignature As Long
   dwStrucVersion As Long
   dwFileVersionMS As Long
   dwFileVersionLS As Long
   dwProductVersionMS As Long
   dwProductVersionLS As Long
   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 GetSystemDirectory Lib "kernel32" _
   Alias "GetSystemDirectoryA" _
  (ByVal lpBuffer As String, _
   ByVal nSize As Long) As Long
Private Declare Function GetFileVersionInfoSize Lib "version.dll" _
   Alias "GetFileVersionInfoSizeA" _
  (ByVal lptstrFilename As String, _
   lpdwHandle As Long) As Long
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 VerQueryValue Lib "version.dll" _
   Alias "VerQueryValueA" _
  (pBlock As Any, _
   ByVal lpSubBlock As String, _
   FI As Any, _
   nVerSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)
   
Private Declare Function lstrcpyA Lib "kernel32" _
  (ByVal RetVal As String, _
   ByVal Ptr As Long) As Long
                        
Private Declare Function lstrlenA Lib "kernel32" _
  (ByVal Ptr As Any) As Long

Private Sub Command1_Click()
   Label1.Caption = GetIECypherVersion()
   
End Sub

Private Function GetIECypherVersion() As String
   Dim FI As VS_FIXEDFILEINFO
   Dim sBuffer() As Byte
   Dim nBufferSize As Long
   Dim lpBuffer As Long
   Dim nVerSize As Long
   Dim nUnused As Long
   Dim tmpVer As String
   Dim sBlock As String
   Dim sDLLFile As String
   Dim sSysPath As String
   
   sSysPath = GetSystemDir()
   If sSysPath > "" Then
     'set file that has the encryption level
     'info and call to get required size
      sDLLFile = sSysPath & "\schannel.dll"
      nBufferSize = GetFileVersionInfoSize(sDLLFile, nUnused)
      
      ReDim sBuffer(nBufferSize)
      
      If nBufferSize > 0 Then
      
        'get the version info
         Call GetFileVersionInfo(sDLLFile, 0&, nBufferSize, sBuffer(0))
         Call VerQueryValue(sBuffer(0), "\", lpBuffer, nVerSize)
         Call CopyMemory(FI, ByVal lpBuffer, Len(FI))
   
         If VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lpBuffer, nVerSize) Then
            
            If nVerSize Then
               tmpVer = GetPointerToString(lpBuffer, nVerSize)
               tmpVer = Right("0" & Hex(Asc(Mid(tmpVer, 2, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 1, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 4, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 3, 1))), 2)
               sBlock = "\StringFileInfo\" & tmpVer & "\FileDescription"
               
              'Get predefined version resources
               If VerQueryValue(sBuffer(0), sBlock, lpBuffer, nVerSize) Then
               
                  If nVerSize Then
                  
                    'get the file description string
                     tmpVer = GetStrFromPtrA(lpBuffer)
                     
                    'File versions for 40 and 128-bit releases can
                    'be the same, so we have to do a string search
                    'to determine the encryption level. If the file
                    'description contains the line:
                    'PCT/SSL Security Provider (Export Version), its 40-bit.
                    'If it contains the line:
                    'PCT/SSL Security Provider (US and Canada Use Only), its 128-bit.
                    
                     Select Case InStr(1, tmpVer, "(US and Canada Use Only)", vbTextCompare)
                        Case 0:    GetIECypherVersion = "40-bit normal encryption"
                        Case Else: GetIECypherVersion = "128-bit strong encryption"
                     End Select
                     
                  End If  'If nVerSize
               End If  'If VerQueryValue
            End If  'If nVerSize
         End If  'If VerQueryValue
      
      Else
      
         GetIECypherVersion = "schannel.dll is not in the system folder."
      
      End If  'If nBufferSize
   End If  'If sSysPath
End Function

Private Function GetPointerToString(lpString As Long, nBytes As Long) As String
   Dim Buffer As String
   
   If nBytes Then
      Buffer = Space(nBytes)
      CopyMemory ByVal Buffer, ByVal lpString, nBytes
      GetPointerToString = Buffer
   End If
   
End Function

Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
   GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
   
End Function

Private Function GetSystemDir() As String
    Dim nSize As Long
    Dim tmp As String
    
    tmp = Space$(256)
    nSize = Len(tmp)
    Call GetSystemDirectory(tmp, nSize)
    
    GetSystemDir = TrimNull(tmp)
    
End Function

Private Function TrimNull(item As String)
    Dim pos As Integer
   
   'double check that there is a chr$(0) in the string
    pos = InStr(item, Chr$(0))
    If pos Then
          TrimNull = Left$(item, pos - 1)
    Else: TrimNull = item
    End If
  
End Function

————————————————————————————————————————————————————————————

但是运行后报错，停止在

tmpVer = Right("0" & Hex(Asc(Mid(tmpVer, 2, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 1, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 4, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 3, 1))), 2)

这里，大概看了一下，这里的目的是为了获取地址，temVer原始值是乱码，但是获取完后就是一串地址（谁知道微软搞什么飞机，地址都错位写。。。）。temVer是string型，这时候想到地址中如果有00存在，那么string将截止，对了，问题就在这里，string无法显示chr(0)字符。然后将temVer改成一个数组，然后重组，结果OK了。修改后为

         tmpVer = Right("0" & Hex(ssBuffer(1)), 2) & _
                    Right("0" & Hex(ssBuffer(0)), 2) & _
                    Right("0" & Hex(ssBuffer(3)), 2) & _
                    Right("0" & Hex(ssBuffer(2)), 2)

最后就是完整的获取文件版本信息的代码，因为是从程序里摘出来的，所以没有整理成工程，留着给大家自己动手吧。几个API和常量，API VIEW里都有

代码：

————————————————————————————————————————————————————————

'功能获取程序版本信息中的公司和文件描述
'参数strFileName是程序的完整路径，strCompanyName是公司信息，strDescription是文件描述
'那两个信息传递的地址，调用方法为
'dim strCom as string
'dim strDes as string
'GetFileVersion "c:\windows\notepad.exe",strCom,strDes     '获取windows记事本的信息
'debug.print strCom & strDes
Public Sub GetFileVersion(ByVal strFileName As String, ByRef strCompanyName As String, ByRef strDescription As String)   
Dim FI As VS_FIXEDFILEINFO
Dim nBufferSize As Long
Dim sBuffer() As Byte
Dim ssBuffer(3) As Byte
Dim lpBuffer As Long
Dim nVerSize As Long
Dim tmpVer As String
Dim tmpFD As String
Dim tmpCN As String
strCompanyName = vbNullString
strDescription = vbNullString
nBufferSize = GetFileVersionInfoSize(strFileName, 0)
If nBufferSize < 1 Then GoTo Err
ReDim sBuffer(nBufferSize)
GetFileVersionInfo strFileName, 0&, nBufferSize, sBuffer(0)
If VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lpBuffer, nVerSize) Then
     If nVerSize Then
           API_CopyMemory ssBuffer(0), ByVal lpBuffer, nVerSize
           tmpVer = Right("0" & Hex(ssBuffer(1)), 2) & _
                    Right("0" & Hex(ssBuffer(0)), 2) & _
                    Right("0" & Hex(ssBuffer(3)), 2) & _
                    Right("0" & Hex(ssBuffer(2)), 2)
           tmpFD = "\StringFileInfo\" & tmpVer & "\FileDescription"
           tmpCN = "\StringFileInfo\" & tmpVer & "\CompanyName"
           If VerQueryValue(sBuffer(0), tmpFD, lpBuffer, nVerSize) Then
                If nVerSize Then
                    strDescription = String$(lstrlenA(ByVal lpBuffer), 0)
                    lstrcpyA strDescription, ByVal lpBuffer
                End If  'If nVerSize
           End If 'If VerQueryValue
           If VerQueryValue(sBuffer(0), tmpCN, lpBuffer, nVerSize) Then
                If nVerSize Then
                    strCompanyName = String$(lstrlenA(ByVal lpBuffer), 0)
                    lstrcpyA strCompanyName, ByVal lpBuffer
                End If  'If nVerSize
           End If
     End If  'If nVerSize
End If
Err:
Erase sBuffer
Erase ssBuffer
End Sub

————————————————————————————————————————————————————————————

还是那句老话，大家玩好！！