如何获取EXE文件的描述信息。

Question

网上查到的是VB的代码，求DELPHI版的代码。谢谢！

Answer 1

你参考下 
?   GetVersionInfo   ( "c:\windows\explorer.exe "   ,efviFileVersion) 
?   GetVersionInfo   ( "c:\windows\explorer.exe "   ,efviFileDescription) 
?   GetVersionInfo   ( "c:\windows\explorer.exe "   ,efviCompanyName) 
'/************************************************************************** 
'                                   版权所有   (c),   2004   -   2xxx,   绿豆XX室 
' 
'   ************************       模   块   名       :mduVersionInfo******************** 
'版   本   号:   V1.0 
'作         者:   超级绿豆 
'生成日期:   2004年03月07日 
'最近修改: 
'功能描述: 
'函数列表: 
'修改历史: 
'日         期:   2004年03月07日 
'修改人员:   超级绿豆 
'修改内容:   生成 
'******************************************************************************/ 
' 
Option   Explicit 
'本模块名称 
Private   Const   THIS_MODULE_NAME   As   String   =   "mduVersionInfo " Public   Declare   Function   GetFileVersionInfoSize   Lib   "version.dll "   Alias   "GetFileVersionInfoSizeA "   (ByVal   lptstrFilename   As   String,   lpdwHandle   As   Long)   As   Long 
Public   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 
Public   Declare   Function   VerQueryValue   Lib   "version.dll "   Alias   "VerQueryValueA "   (ByVal   pBlock   As   Long,   ByVal   lpSubBlock   As   String,   lplpBuffer   As   Long,   puLen   As   Long)   As   Long Public   g_FileVersionInfoEntryNames(12)   As   String Public   Const   FLAG_FVIENS_INITIALIZED   As   String   =   "999 " Public   Enum   eFileVersionInfoEntryNames 
        efviComments   =   0 
        efviInternalName 
        efviProductName 
        efviCompanyName 
        efviLegalCopyright 
        efviProductVersion 
        efviFileDescription 
        efviLegalTrades 
        efviPrivateBuild 
        efviFileVersion 
        efviOriginalFilename 
        efviSpecialBuild 
        efviInitializedFlag 
End   Enum Private   Declare   Sub   CopyMemory   Lib   "kernel32 "   Alias   "RtlMoveMemory "   (Destination   As   Any,   Source   As   Any,   ByVal   Length   As   Long) 
Public   Function   GetVersionInfoFromResVerBytes(bVersionBlock()   As   Byte,   ByVal   lEntryName   As   eFileVersionInfoEntryNames)   As   String 
        On   Error   GoTo   Error_Handler 
        Dim   i   As   Long 
        Dim   lVersionSize   As   Long 
        Dim   pBlock()   As   Byte,   SubBlock   As   String 
        Dim   lpTranslate   As   Long,   bTranslate()   As   Byte 
        Dim   lSizeOflpTranslate   As   Long 
        Dim   lplpBuffer()   As   Byte,   puLen   As   Long,   lpBuffer   As   Long 
        
        'lVersionSize   =   GetFileVersionInfoSize(sFileName,   0&) 
        'If   lVersionSize   <=   0   Then   Exit   Function 
        
        Call   InitFileVersionInfoNames 
        
        'ReDim   pBlock(lVersionSize   -   1) 
        'Call   GetFileVersionInfo(sFileName,   0&,   lVersionSize,   pBlock(0)) 
        pBlock   =   bVersionBlock 
        
        VerQueryValue   VarPtr(pBlock(0)),   "\\VarFileInfo\\Translation ",   lpTranslate,   lSizeOflpTranslate 
        ReDim   bTranslate(lSizeOflpTranslate   -   1) 
        CopyMemory   bTranslate(0),   ByVal   lpTranslate,   lSizeOflpTranslate 
        
        For   i   =   1   To   lSizeOflpTranslate   /   (UBound(bTranslate)   +   1) 
                SubBlock   =   "\\StringFileInfo\\ " 
                SubBlock   =   SubBlock   &   Byte2Hex(bTranslate(),   0,   1,   True) 
                SubBlock   =   SubBlock   &   Byte2Hex(bTranslate(),   2,   3,   True) 
                SubBlock   =   SubBlock   &   "\\ "   &   g_FileVersionInfoEntryNames(lEntryName) 
        
                VerQueryValue   VarPtr(pBlock(0)),   SubBlock,   lpBuffer,   puLen 
                If   lpBuffer   <>   0   And   puLen   <>   0   Then 
                        ReDim   lplpBuffer(puLen   -   1) 
                        CopyMemory   lplpBuffer(0),   ByVal   lpBuffer,   puLen 
                        ReDim   Preserve   lplpBuffer(InStrB(lplpBuffer,   ChrB(0))   -   2) 
                        GetVersionInfoFromResVerBytes   =   StrConv(lplpBuffer,   vbUnicode) 
                End   If 
        Next         Exit   Function 
Error_Handler: 
        '自定义错误处理         '调用默认错误处理函数 
        Call   DefaultErrorHandler(THIS_MODULE_NAME) 
End   Function 
Public   Function   GetVersionInfo(ByVal   sFileName   As   String,   ByVal   lEntryName   As   eFileVersionInfoEntryNames)   As   String 
        On   Error   GoTo   Error_Handler 
        Dim   i   As   Long 
        Dim   lVersionSize   As   Long 
        Dim   pBlock()   As   Byte,   SubBlock   As   String 
        Dim   lpTranslate   As   Long,   bTranslate()   As   Byte 
        Dim   lSizeOflpTranslate   As   Long 
        Dim   lplpBuffer()   As   Byte,   puLen   As   Long,   lpBuffer   As   Long 
        
        lVersionSize   =   GetFileVersionInfoSize(sFileName,   0&) 
        If   lVersionSize   <=   0   Then   Exit   Function 
        
        Call   InitFileVersionInfoNames 
        
        ReDim   pBlock(lVersionSize   -   1) 
        Call   GetFileVersionInfo(sFileName,   0&,   lVersionSize,   pBlock(0)) 
        
        VerQueryValue   VarPtr(pBlock(0)),   "\\VarFileInfo\\Translation ",   lpTranslate,   lSizeOflpTranslate 
        ReDim   bTranslate(lSizeOflpTranslate   -   1) 
        CopyMemory   bTranslate(0),   ByVal   lpTranslate,   lSizeOflpTranslate 
        
        For   i   =   1   To   lSizeOflpTranslate   /   (UBound(bTranslate)   +   1) 
                SubBlock   =   "\\StringFileInfo\\ " 
                SubBlock   =   SubBlock   &   Byte2Hex(bTranslate(),   0,   1,   True) 
                SubBlock   =   SubBlock   &   Byte2Hex(bTranslate(),   2,   3,   True) 
                SubBlock   =   SubBlock   &   "\\ "   &   g_FileVersionInfoEntryNames(lEntryName) 
        
                VerQueryValue   VarPtr(pBlock(0)),   SubBlock,   lpBuffer,   puLen 
                If   lpBuffer   <>   0   And   puLen   <>   0   Then 
                        ReDim   lplpBuffer(puLen   -   1) 
                        CopyMemory   lplpBuffer(0),   ByVal   lpBuffer,   puLen 
                        ReDim   Preserve   lplpBuffer(InStrB(lplpBuffer,   ChrB(0))   -   2) 
                        GetVersionInfo   =   StrConv(lplpBuffer,   vbUnicode) 
                End   If 
        Next         Exit   Function 
Error_Handler: 
        '自定义错误处理         '调用默认错误处理函数 
        Call   DefaultErrorHandler(THIS_MODULE_NAME) 
End   Function Private   Function   Byte2Hex(bArray()   As   Byte,   Optional   ByVal   lStart   As   Long   =   0,   Optional   ByVal   lEnd   As   Long   =   -1,   Optional   fReversed   As   Boolean   =   False)   As   String 
        Dim   i   As   Long 
        lStart   =   IIf(lStart   <   0,   0,   lStart) 
        lEnd   =   IIf(lEnd   <   0,   UBound(bArray),   lEnd) 
        
        If   fReversed   Then 
                For   i   =   lEnd   To   lStart   Step   -1 
                        Byte2Hex   =   Byte2Hex   &   Right$( "00 "   &   Hex(bArray(i)),   2) 
                Next 
        Else 
                For   i   =   lStart   To   lEnd 
                        Byte2Hex   =   Byte2Hex   &   Right$( "00 "   &   Hex(bArray(i)),   2) 
                Next 
        End   If 
End   Function Public   Sub   InitFileVersionInfoNames() 
        If   g_FileVersionInfoEntryNames(12)   =   FLAG_FVIENS_INITIALIZED   Then   Exit   Sub 
        g_FileVersionInfoEntryNames(efviComments)   =   "Comments "     '注释 
        g_FileVersionInfoEntryNames(efviCompanyName)   =   "CompanyName "     '公司名 
        g_FileVersionInfoEntryNames(efviProductName)   =   "ProductName "     '产品名 
        g_FileVersionInfoEntryNames(efviProductVersion)   =   "ProductVersion "     '产品版本 
        g_FileVersionInfoEntryNames(efviInternalName)   =   "InternalName "     '内部名称 
        g_FileVersionInfoEntryNames(efviFileDescription)   =   "FileDescription "     '文件描述 
        g_FileVersionInfoEntryNames(efviFileVersion)   =   "FileVersion "     '文件版本 
        g_FileVersionInfoEntryNames(efviOriginalFilename)   =   "OriginalFilename "     '原始文件名 
        g_FileVersionInfoEntryNames(efviSpecialBuild)   =   "SpecialBuild "     '特殊编译号 
        g_FileVersionInfoEntryNames(efviPrivateBuild)   =   "PrivateBuild "     '私有编译号 
        g_FileVersionInfoEntryNames(efviLegalCopyright)   =   "LegalCopyright "     '合法版权 
        g_FileVersionInfoEntryNames(efviLegalTrades)   =   "LegalTrades "     '合法商标 
        g_FileVersionInfoEntryNames(efviInitializedFlag)   =   FLAG_FVIENS_INITIALIZED       '是否已经初始化标记 
End   Sub

Answer 2

　　 unit untVersion; 
{------------------------------------------------------------------------------- 
*Description：自动获取应用程序的版本信息 
*Create by: Derry Zhang 
*Create on: 2008-11-26 
-------------------------------------------------------------------------------} interface uses 
Windows, Forms, SysUtils; type 
TVersion = class(TObject) 
private 
FCompanyName: string; 
FFileDescription: string; 
FFileVersion: string; 
FInternalName: string; 
FLegalCopyright: string; 
FLegalTradeMarks: string; 
FOriginalFileName: string; 
FProductName: string; 
FProductVersion: string; 
procedure GetCodeVersion; 
public 
constructor Create; 
property CompanyName: string read FCompanyName; 
property FileDescription: string read FFileDescription; 
property FileVersion: string read FFileVersion; 
property InternalName: string read FInternalName; 
property LegalCopyright: string read FLegalCopyright; 
property LegalTradeMarks: string read FLegalTradeMarks; 
property OriginalFileName: string read FOriginalFileName; 
property ProductName: string read FProductName; 
property ProductVersion: string read FProductVersion; 
end; implementation constructor TVersion.Create; 
begin 
GetCodeVersion; 
inherited; 
end; procedure TVersion.GetCodeVersion; 
const 
InfoNum = 9; 
InfoStr: array[1..InfoNum] of string = ( 
'ProductName', 
'ProductVersion', 
'FileDescription', 
'LegalCopyright', 
'FileVersion', 
'CompanyName', 
'LegalTradeMarks', 
'InternalName', 
'OriginalFileName' 
); 
var 
S: string; 
BufSize, Len: DWORD; 
Buf: PChar; 
Value: PChar; 
begin 
S := Application.ExeName; 
BufSize := GetFileVersionInfoSize(PChar(S), BufSize); 
if BufSize > 0 then begin 
Buf := AllocMem(BufSize); 
GetFileVersionInfo(PChar(S), 0, BufSize, Buf); 
//产品名称 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[1]), Pointer(Value), Len) then 
FProductName := Value; //产品版本 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[2]), Pointer(Value), Len) then 
FProductVersion := Value; //文件描述 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[3]), Pointer(Value), Len) then 
FFileDescription := Value; //合法商标 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[4]), Pointer(Value), Len) then 
FLegalCopyright := Value; //文件版本-“关于”对话框中版本栏应该使用 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[5]), Pointer(Value), Len) then 
FFileVersion := Value; //公司名称 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[6]), Pointer(Value), Len) then 
FCompanyName := Value; //合法商标 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[7]), Pointer(Value), Len) then 
FLegalTrades := Value; //内部名称 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[8]), Pointer(Value), Len) then 
FInternalName := Value; //原文件名 
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[9]), Pointer(Value), Len) then 
FOriginalFilename := Value; FreeMem(Buf, BufSize); //OperatingSystem.Caption := GetOSVerInfo; //SystemMemory.Caption := GetMemStat; 
end 
else 
begin 
Application.MessageBox('获取产品信息时遇到致命错误，请尝试重新启动软件。'+ #13 + '若仍未能解决问题，请联系产品服务人员。','错误',MB_OK + MB_ICONSTOP); 
end; 
end; 

Answer 3

绿豆搞的东西，自然是VB下的咧~~~
GetVersionInfo
具体使用，前几天版主 liangqingzhi回复过这个问题，lz可以搜搜~~

Answer 4

版本里的代码已经查到（网上的很多版本有问题，这个写法的好使VersionValue := SFInfo + IntToHex(LoWord(Longint(Translation^)), 4) +IntToHex(HiWord(Longint(Translation^)), 4) + '\';）。
但我发现很多没有版本信息的EXE也有描述信息，这个常规页上的属性信息怎么取？？

Answer 5

你参考下  
? GetVersionInfo ( "c:\windows\explorer.exe " ,efviFileVersion)  
? GetVersionInfo ( "c:\windows\explorer.exe " ,efviFileDescription)  
? GetVersionInfo ( "c:\windows\explorer.exe " ,efviCompanyName)  
'/**************************************************************************  
' 版权所有 (c), 2004 - 2xxx, 绿豆XX室  
'  
' ************************ 模 块 名 :mduVersionInfo********************  
'版 本 号: V1.0  
'作 者: 超级绿豆  
'生成日期: 2004年03月07日  
'最近修改:  
'功能描述:  
'函数列表:  
'修改历史:  
'日 期: 2004年03月07日  
'修改人员: 超级绿豆  
'修改内容: 生成  
'******************************************************************************/  
'  
Option Explicit  
'本模块名称  
Private Const THIS_MODULE_NAME As String = "mduVersionInfo "  Public Declare Function GetFileVersionInfoSize Lib "version.dll " Alias "GetFileVersionInfoSizeA " (ByVal lptstrFilename As String, lpdwHandle As Long) As Long  
Public 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  
Public Declare Function VerQueryValue Lib "version.dll " Alias "VerQueryValueA " (ByVal pBlock As Long, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long  Public g_FileVersionInfoEntryNames(12) As String  Public Const FLAG_FVIENS_INITIALIZED As String = "999 "  Public Enum eFileVersionInfoEntryNames  
  efviComments = 0  
  efviInternalName  
  efviProductName  
  efviCompanyName  
  efviLegalCopyright  
  efviProductVersion  
  efviFileDescription  
  efviLegalTrades  
  efviPrivateBuild  
  efviFileVersion  
  efviOriginalFilename  
  efviSpecialBuild  
  efviInitializedFlag  
End Enum  Private Declare Sub CopyMemory Lib "kernel32 " Alias "RtlMoveMemory " (Destination As Any, Source As Any, ByVal Length As Long)  
Public Function GetVersionInfoFromResVerBytes(bVersionBlock() As Byte, ByVal lEntryName As eFileVersionInfoEntryNames) As String  
  On Error GoTo Error_Handler  
  Dim i As Long  
  Dim lVersionSize As Long  
  Dim pBlock() As Byte, SubBlock As String  
  Dim lpTranslate As Long, bTranslate() As Byte  
  Dim lSizeOflpTranslate As Long  
  Dim lplpBuffer() As Byte, puLen As Long, lpBuffer As Long  
    
  'lVersionSize = GetFileVersionInfoSize(sFileName, 0&)  
  'If lVersionSize <= 0 Then Exit Function  
    
  Call InitFileVersionInfoNames  
    
  'ReDim pBlock(lVersionSize - 1)  
  'Call GetFileVersionInfo(sFileName, 0&, lVersionSize, pBlock(0))  
  pBlock = bVersionBlock  
    
  VerQueryValue VarPtr(pBlock(0)), "\\VarFileInfo\\Translation ", lpTranslate, lSizeOflpTranslate  
  ReDim bTranslate(lSizeOflpTranslate - 1)  
  CopyMemory bTranslate(0), ByVal lpTranslate, lSizeOflpTranslate  
    
  For i = 1 To lSizeOflpTranslate / (UBound(bTranslate) + 1)  
  SubBlock = "\\StringFileInfo\\ "  
  SubBlock = SubBlock & Byte2Hex(bTranslate(), 0, 1, True)  
  SubBlock = SubBlock & Byte2Hex(bTranslate(), 2, 3, True)  
  SubBlock = SubBlock & "\\ " & g_FileVersionInfoEntryNames(lEntryName)  
    
  VerQueryValue VarPtr(pBlock(0)), SubBlock, lpBuffer, puLen  
  If lpBuffer <> 0 And puLen <> 0 Then  
  ReDim lplpBuffer(puLen - 1)  
  CopyMemory lplpBuffer(0), ByVal lpBuffer, puLen  
  ReDim Preserve lplpBuffer(InStrB(lplpBuffer, ChrB(0)) - 2)  
  GetVersionInfoFromResVerBytes = StrConv(lplpBuffer, vbUnicode)  
  End If  
  Next    Exit Function  
Error_Handler:  
  '自定义错误处理    '调用默认错误处理函数  
  Call DefaultErrorHandler(THIS_MODULE_NAME)  
End Function  
Public Function GetVersionInfo(ByVal sFileName As String, ByVal lEntryName As eFileVersionInfoEntryNames) As String  
  On Error GoTo Error_Handler  
  Dim i As Long  
  Dim lVersionSize As Long  
  Dim pBlock() As Byte, SubBlock As String  
  Dim lpTranslate As Long, bTranslate() As Byte  
  Dim lSizeOflpTranslate As Long  
  Dim lplpBuffer() As Byte, puLen As Long, lpBuffer As Long  
    
  lVersionSize = GetFileVersionInfoSize(sFileName, 0&)  
  If lVersionSize <= 0 Then Exit Function  
    
  Call InitFileVersionInfoNames  
    
  ReDim pBlock(lVersionSize - 1)  
  Call GetFileVersionInfo(sFileName, 0&, lVersionSize, pBlock(0))  
    
  VerQueryValue VarPtr(pBlock(0)), "\\VarFileInfo\\Translation ", lpTranslate, lSizeOflpTranslate  
  ReDim bTranslate(lSizeOflpTranslate - 1)  
  CopyMemory bTranslate(0), ByVal lpTranslate, lSizeOflpTranslate  
    
  For i = 综合布线产品1 To lSizeOflpTranslate / (UBound(bTranslate) + 1)  
  SubBlock = "\\StringFileInfo\\ "  
  SubBlock = SubBlock & Byte2Hex(bTranslate(), 0, 1, True)  
  SubBlock = SubBlock & Byte2Hex(bTranslate(), 2, 3, True)  
  SubBlock = SubBlock & "\\ " & g_FileVersionInfoEntryNames(lEntryName