unit VersionInfo;
{.$DEFINE USEARRAY}
interface
uses
Windows, SysUtils;
type
TVersionInfo=class
private
FInfo : PVSFixedFileInfo;
{$IFDEF USEARRAY}
FInfoKeys :
array[0..9]
of string;
{$ELSE}
FCompanyName,
FFileDescription,
FFileVersion,
FInternalName,
FCopyright,
FTrademarks,
FOriginalFileName,
FProductName,
FProductVersion,
FComments,
{$ENDIF}
FVersionNumber :
string;
function FormatVersionNumber:
string;
{$IFDEF USEARRAY}
function GetKey(Idx: integer):
string;
{$ENDIF}
public
constructor Create(
const SourceFile:
string);
procedure LoadProperties(
const SourceFile:
string);
{$IFDEF USEARRAY}
property CompanyName:
string index 0
read GetKey;
property FileDescription:
string index 1
read GetKey;
property FileVersion:
string index 2
read GetKey;
property InternalName:
string index 3
read GetKey;
property Copyright:
string index 4read GetKey;
property Trademarks:
string index 5
read GetKey;
property OriginalFileName:
string index 6
read GetKey;
property ProductName:
string index 7
read GetKey;
property ProductVersion:
string index 8
read GetKey;
property Comments:
string index 9
read GetKey;
{$ELSE}
property CompanyName:
string read FCompanyName;
property FileDescription:
string read FFileDescription;
property FileVersion:
string read FFileVersion;
property InternalName:
string read FInternalName;
property Copyright:
string read FCopyright;
property Trademarks:
string read FTrademarks;
property OriginalFileName:
string read FOriginalFileName;
property ProductName:
string read FProductName;
property ProductVersion:
string read FProductVersion;
property Comments:
string read FComments;
{$ENDIF}
property VersionNumber:
string read FVersionNumber;
end;
implementation
{$IFNDEF USEARRAY}
function GetFileInfo(
const FileName, BlockKey:
string):
string;
var
vis,
dummy : dword;
vi,
translation,
ip : pointer;
begin
Result := '
';
vis := GetFileVersionInfoSize(pchar(FileName),dummy);
if(vis > 0)
then
begin
GetMem(vi,vis);
try
GetFileVersionInfo(pchar(Filename),0,vis,vi);
if(vi =
nil)
then exit;
// get language code
VerQueryValue(vi,'
\\VarFileInfo\\Translation',translation,vis);
if(translation =
nil)
then exit;
ip :=
nil;
VerQueryValue(vi,
pchar(Format('
\\StringFileInfo\\%.4x%.4x\\%s',
[LOWORD(longint(translation^)),HIWORD(longint(translation^)),
BlockKey])),
ip,vis);
if(
ip =
nil)
then exit;
SetString(Result,pchar(
ip),vis - 1);
finally
FreeMem(vi);
end;
end;
end;
{$ENDIF}
function GetDefaultFileInfo(
const FileName:
string): PVSFixedFileInfo;
var
vis,
dummy : dword;
vi : pointer;
begin
Result :=
nil;
vis := GetFileVersionInfoSize(pchar(FileName),dummy);
if(vis > 0)
then
begin
GetMem(vi,vis);
try
GetFileVersionInfo(pchar(FileName),0,vis,vi);
if(vi =
nil)
then exit;
VerQueryValue(vi,'
\\',pointer(Result),dummy);
finally
FreeMem(vi);
end;
end;
end;
// -- TVersionInfo -------------------------------------------------------------
constructor TVersionInfo.Create(
const SourceFile:
string);
begin
inherited Create;
self.LoadProperties(SourceFile);
end;
procedure TVersionInfo.LoadProperties(
const SourceFile:
string);
{$IFDEF USEARRAY}
const
DefaultInfoKey :
array[0..9]
of string =
('
CompanyName','
FileDescription','
FileVersion','
InternalName',
'
LegalCopyright','
TradeMarks','
OriginalFileName','
ProductName',
'
ProductVersion','
Comments');
var
vis,
dummy : dword;
vi,
translation,
ip : pointer;
i : integer;
{$ENDIF}
begin
{$IFDEF USEARRAY}
vis := GetFileVersionInfoSize(pchar(SourceFile),dummy);
if(vis > 0)
then
begin
GetMem(vi,vis);
try
GetFileVersionInfo(pchar(SourceFile),0,vis,vi);
if(vi =
nil)
then exit;
// get language code
VerQueryValue(vi,'
\\VarFileInfo\\Translation',translation,vis);
if(translation =
nil)
then exit;
for i := low(DefaultInfoKey)
to high(DefaultInfoKey)
do
begin
ip :=
nil;
VerQueryValue(vi,
pchar(Format('
\\StringFileInfo\\%.4x%.4x\\%s',
[LOWORD(longint(translation^)),HIWORD(longint(translation^)),
DefaultInfoKey[i]])),
ip,vis);
if(
ip =
nil)
then FInfoKeys[i] := '
'
else SetString(FInfoKeys[i],pchar(
ip),vis - 1);
end;
finally
FreeMem(vi);
end;
end;
{$ELSE}
// fill properties
FCompanyName := GetFileInfo(SourceFile,'
CompanyName');
FFileDescription := GetFileInfo(SourceFile,'
FileDescription');
FFileVersion := GetFileInfo(SourceFile,'
FileVersion');
FInternalName := GetFileInfo(SourceFile,'
InternalName');
FCopyright := GetFileInfo(SourceFile,'
LegalCopyright');
FTrademarks := GetFileInfo(SourceFile,'
TradeMarks');
FOriginalFileName := GetFileInfo(SourceFile,'
OriginalFileName');
FProductName := GetFileInfo(SourceFile,'
ProductName');
FProductVersion := GetFileInfo(SourceFile,'
ProductVersion');
FComments := GetFileInfo(SourceFile,'
Comments');
{$ENDIF}
FInfo := GetDefaultFileInfo(SourceFile);
FVersionNumber := self.FormatVersionNumber;
end;
function TVersionInfo.FormatVersionNumber:
string;
const
FormatStr = '
%d.%d.%d.%d';
begin
Result := Format(FormatStr,
[(FInfo^.dwFileVersionMS
and $FFFF0000)
shr 16,
FInfo^.dwFileVersionMS
and $0000FFFF,
(FInfo^.dwFileVersionLS
and $FFFF0000)
shr 16,
FInfo^.dwFileVersionLS
and $0000FFFF]);
end;
{$IFDEF USEARRAY}
function TVersionInfo.GetKey(Idx: integer):
string;
begin
Result := FInfoKeys[Idx];
end;
{$ENDIF}
end.