delphi 获取Exe或DLL的文件版本信息

unit VersionInfo;
{* 获取应用程序版本类单元 }

interface

uses Windows,Types,SysUtils,Dialogs;

type
  TExeVersionInfo = class(TObject)
  private
    FHasVerInfo: Boolean;
    FProductName: string;
    FProductVersion: string;
    FFileDescription: string;
    FLegalCopyright: string;
    FFileVersion: string;
    FCompanyName: string;
    FLegalTradeMarks: string;
    FInternalName: string;
    FOriginalFileName: string;
    FFullName: string;
    procedure SetExeOrLibFile(const Value: string);
  protected
    procedure GetVersionInfo;
  public
    property ExeOrLibFile: string read FFullName write SetExeOrLibFile;
    property HasVerInfo: Boolean read FHasVerInfo;
    property ProductName: string read FProductName;
    property ProductVersion: string read FProductVersion;
    property FileDescription: string read FFileDescription;
    property LegalCopyright: string read FLegalCopyright;
    property FileVersion: string read FFileVersion;
    property CompanyName: string read FCompanyName;
    property LegalTradeMarks: string read FLegalTradeMarks;
    property InternalName: string read FInternalName;
    property OriginalFileName: string read FOriginalFileName;
  end;

implementation


procedure TExeVersionInfo.GetVersionInfo;
const
  InfoNum = 9;
  InfoStr: array[1..InfoNum] of string = (
      'ProductName',
      'ProductVersion',
      'FileDescription',
      'LegalCopyright',
      'FileVersion',
      'CompanyName',
      'LegalTradeMarks',
      'InternalName',
      'OriginalFileName');
var
  S, Find: string;
  BufSize, Len, LangCode: DWORD;
  Buf: PChar;
  Value: PChar;
  PLang: Pointer;
begin
  FHasVerInfo := True;
  S := FFullName;
  BufSize := GetFileVersionInfoSize(PChar(S), BufSize);
  if BufSize > 0 then
  begin
    Buf := AllocMem(BufSize);
    GetFileVersionInfo(PChar(S), 0, BufSize, Buf);
    //取语言代码
    VerQueryValue(Buf, PChar('\VarFileInfo\Translation'), PLang, Len);
    LangCode := PDword(PLang)^;
    //生成查找串
    Find := Format('StringFileInfo\%.4x%.4x\', [Word(LangCode), HiWord(LangCode)]);
    //依次查找不同的信息内容
    if VerQueryValue(Buf, PChar(Find + InfoStr[1]), Pointer(Value), Len) then
       FProductName := Value;
    if VerQueryValue(Buf, PChar(Find + InfoStr[2]), Pointer(Value), Len) then
       FProductVersion := Value;
    if VerQueryValue(Buf, PChar(Find + InfoStr[3]), Pointer(Value), Len) then
       FFileDescription := Value;
    if VerQueryValue(Buf, PChar(Find + InfoStr[4]), Pointer(Value), Len) then
       FLegalCopyright := Value;
    if VerQueryValue(Buf, PChar(Find + InfoStr[5]), Pointer(Value), Len) then
       FFileVersion := Value;
    if VerQueryValue(Buf, PChar(Find + InfoStr[6]), Pointer(Value), Len) then
       FCompanyName := Value;
    if VerQueryValue(Buf, PChar(Find + InfoStr[7]), Pointer(Value), Len) then
       FLegalTrademarks := Value;
    if VerQueryValue(Buf, PChar(Find + InfoStr[8]), Pointer(Value), Len) then
       FInternalName := Value;
    if VerQueryValue(Buf, PChar(Find + InfoStr[9]), Pointer(Value), Len) then
       FOriginalFilename := Value;
    FreeMem(Buf, BufSize);
  end else FHasVerInfo := False;
end;

procedure TExeVersionInfo.SetExeOrLibFile(const Value: string);
begin
  FFullName := Value;
  GetVersionInfo;
end;

end.

调用示例：

private
    FInfo: TExeVersionInfo;
    { Private declarations }

procedure TForm1.FormCreate(Sender: TObject);
begin
  FInfo := TExeVersionInfo.Create;
end;

procedure TForm1.btnSelectClick(Sender: TObject);
begin
  if dlgOpen.Execute then
  begin
    FInfo.ExeOrLibFile := dlgOpen.FileName;
    Caption := FInfo.FileDescription;
  end;
end;