取自病毒防火墙里的代码，获取到启动项后，需要根据路径获取到程序的版本信息，后来网上找了一些代码都不能用，经过自己努力终于解决了问题，也发现了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
————————————————————————————————————————————————————————————
还是那句老话，大家玩好！！
2009/6/13 | Tags:VB,编程,原创 | VB编程 | 查看评论(0)