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.

procedure TForm1.Button1Click(Sender: TObject);
var
  vi : TVersionInfo;
begin
  vi := TVersionInfo.Create('c:\pctools\smc.exe');
  try
    Memo1.Lines.Add(vi.CompanyName);
    Memo1.Lines.Add(vi.VersionNumber);
    Memo1.Lines.Add('');

    vi.LoadProperties('c:\pctools\hed.exe');
    Memo1.Lines.Add(vi.ProductName);
    Memo1.Lines.Add(vi.Copyright);
  finally
    FreeAndNil(vi);
  end;
end;