Delphi2007.net 首页

获取文件版本信息  
type  
   TFileInfo  =  packed  record  
       CommpanyName:  string;  
       FileDescription:  string;  
       FileVersion:  string;  
       InternalName:  string;  
       LegalCopyright:  string;  
       LegalTrademarks:  string;  
       OriginalFileName:  string;  
       ProductName:  string;  
       ProductVersion:  string;  
       Comments:  string;  
       VsFixedFileInfo:VS_FIXEDFILEINFO;  
       UserDefineValue:string;  
   end;  
 
function  GetFileVersionInfomation(const  FileName:  string;  var  info:  TFileInfo;UserDefine:string=''):  
   boolean;  
const  
   SFInfo=  '\StringFileInfo\';  
var  
   VersionInfo:  Pointer;  
   InfoSize:  DWORD;  
   InfoPointer:  Pointer;  
   Translation:  Pointer;  
   VersionValue:  string;  
   unused:  DWORD;  
begin  
   unused  :=  0;  
   Result  :=  False;  
   InfoSize  :=  GetFileVersionInfoSize(pchar(FileName),  unused);  
   if  InfoSize  >  0  then  
   begin  
       GetMem(VersionInfo,  InfoSize);  
       Result  :=  GetFileVersionInfo(pchar(FileName),  0,  InfoSize,  VersionInfo);  
       if  Result  then  
       begin  
           VerQueryValue(VersionInfo,  '\VarFileInfo\Translation',  Translation,  InfoSize);  
           VersionValue  :=  SFInfo  +  IntToHex(LoWord(Longint(Translation^)),  4)  +  
               IntToHex(HiWord(Longint(Translation^)),  4)  +  '\';  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'CompanyName'),  InfoPointer,  InfoSize);  
           info.CommpanyName  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'FileDescription'),  InfoPointer,  InfoSize);  
           info.FileDescription  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'FileVersion'),  InfoPointer,  InfoSize);  
           info.FileVersion  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'InternalName'),  InfoPointer,  InfoSize);  
           info.InternalName  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'LegalCopyright'),  InfoPointer,  InfoSize);  
           info.LegalCopyright  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'LegalTrademarks'),  InfoPointer,  InfoSize);  
           info.LegalTrademarks  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'OriginalFileName'),  InfoPointer,  InfoSize);  
           info.OriginalFileName  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'ProductName'),  InfoPointer,  InfoSize);  
           info.ProductName  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'ProductVersion'),  InfoPointer,  InfoSize);  
           info.ProductVersion  :=  string(pchar(InfoPointer));  
           VerQueryValue(VersionInfo,  pchar(VersionValue  +  'Comments'),  InfoPointer,  InfoSize);  
           info.Comments  :=  string(pchar(InfoPointer));  
           if  VerQueryValue(VersionInfo,  '\',  InfoPointer,  InfoSize)  then  
               info.VsFixedFileInfo  :=  TVSFixedFileInfo(InfoPointer^);  
           if  UserDefine<>''  then  
           begin  
               if  VerQueryValue(VersionInfo,pchar(VersionValue+UserDefine),InfoPointer,InfoSize)  then  
                   info.UserDefineValue:=string(pchar(InfoPointer));  
           end;  
       end;  
       FreeMem(VersionInfo);  
   end;  
end;  
 
调用演示：  
 
procedure  TForm1.Button1Click(Sender:  TObject);  
var  
   info:  TFileInfo;  
begin  
   if  OpenDialog1.Execute  then  
   begin  
       if  GetFileVersionInfomation(opendialog1.FileName,  info,'WOW  Version')  then  
       begin  
           Listbox1.Items.Add(OpenDialog1.FileName);  
           ListBox1.Items.Add('Comments:'  +  info.Comments);  
           ListBox1.Items.Add('CommpanyName:'  +  info.CommpanyName);  
           ListBox1.Items.Add('FileDescription:'  +  info.FileDescription);  
           ListBox1.Items.Add('FileVersion:'  +  info.FileVersion);  
           ListBox1.Items.Add('InternalName:'  +  info.InternalName);  
           ListBox1.Items.Add('LegalCopyright:'  +  info.LegalCopyright);  
           ListBox1.Items.Add('LegalTrademarks:'  +  info.LegalTrademarks);  
           ListBox1.Items.Add('OriginalFileName:'  +  info.OriginalFileName);  
           ListBox1.Items.Add('ProductName:'  +  info.ProductName);  
           ListBox1.Items.Add('ProductVersion:'  +  info.ProductVersion);  
           ListBox1.Items.Add('UserDefineValue:'  +  info.UserDefineValue);  
           if  boolean(info.VsFixedFileInfo.dwFileFlags  and  vs_FF_Debug)  then  
             listbox1.Items.Add('Debug:True')  
             else  
             ListBox1.Items.Add('Debug:False');  
           ListBox1.Items.Add('');  
       end;  
   end;  
end;
 
来自CSDN FAQ