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;