{-----------------------------------------------------------------------------
 Unit Name: VersionInfo
 Author:    Jari Kettunen <jari03@nohotmail.com>
 Purpose:   Show version info
 History:
-----------------------------------------------------------------------------}


unit VersionInfo;

interface
uses Classes;
type
CInfo= (CompanyName,FileDescription,FileVersion,
        InternalName,LegalCopyright,LegalTradeMarks,
        OriginalFilename,ProductName,ProductVersion,
        Comments, NetSite, Email);

const

  CInfoCount = 12;
  CInfoStr: array[0..CInfoCount-1] of string =
  ('CompanyName', 'FileDescription', 'FileVersion',
    'InternalName', 'LegalCopyright', 'LegalTradeMarks',
    'OriginalFilename', 'ProductName', 'ProductVersion',
    'Comments', 'NetSite', 'EMail');

type
  TVersionInfo = class
  private
    InfoList: TStringlist;
  protected
    function GetKeyName(Key: CInfo): string; virtual;
    function GetKeyNameI(i: integer): string; virtual;
    function GetKeyValue(Key:CInfo): string; virtual;
    function GetKeyValueI(i: integer): string; virtual;
    function GetCount: integer; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure FillList(st:TStrings; sep:string=': '); virtual;

    property KeyValue[Key:CInfo] : string read GetKeyValue;
    property KeyValueI[i:integer] : string read GetKeyValueI;
    property KeyName[Key:CInfo] : string read GetKeyName;
    property KeyNameI[i:integer] : string read GetKeyNameI;
    property Count : integer read GetCount;
  end;

// var  GlobalVersionInfo: TVersionInfo;
  procedure VersionInfoFillList(st:TStrings;sep:string=': ');

implementation
uses Windows, SysUtils;

constructor TVersionInfo.Create;
type
  PTransBuffer = ^TTransBuffer;
  TTransBuffer = array[1..4] of smallint;

var
  verBuf: pointer;
  ptrans: PTransBuffer;
  transStr: string;

  infoSize: DWORD;
  wnd: DWORD;
  verSize: DWORD;
  i: integer;
  typeStr: string;
  value: PChar;
begin
  InfoList:=TStringlist.Create;
  infoSize:=GetFileVersioninfoSize(PChar(ParamStr(0)), wnd);
  if infoSize <> 0 then  begin
    GetMem(verBuf, infoSize);
    try
      if GetFileVersionInfo(PChar(ParamStr(0)), wnd, infoSize, verBuf) then begin
        VerQueryvalue(verBuf, PChar('\VarFileInfo\Translation'),pointer(ptrans), verSize);

        transStr:=IntToHex(ptrans^[1], 4) + IntToHex(ptrans^[2], 4);

        for i:=Low(CInfoStr) to High(CInfoStr) do begin
          typeStr:= 'StringFileInfo\' + transStr + '\' + CInfoStr[i];

          if VerQueryvalue(verBuf, PChar(typeStr), pointer(value), verSize) then
            InfoList.Add(string(value))
          else
            InfoList.Add('')
        end;
      end
    finally
      FreeMem(verBuf);
    end;
  end;
end;

destructor TVersionInfo.Destroy;
begin
  InfoList.Free;
end;

procedure TVersionInfo.FillList(st: TStrings;sep:string);
var i : integer; s: string;
begin
  for i := 0 to Count-1 do begin
    s := KeyValueI[i];
    if ( s = '' ) then continue;
    st.Add(KeyNameI[i] + sep + s);
  end;
end;

function TVersionInfo.GetCount: integer;
begin
  Result := InfoList.Count;
end;

function TVersionInfo.GetKeyName(Key: CInfo): string;
begin
  Result := GetKeyNameI(Ord(Key));
end;

function TVersionInfo.GetKeyNameI(i: integer): string;
begin
  Result := '';
  if ( i < 0 ) or ( Count <= i ) then exit;
  Result := CInfoStr[i];
end;

function TVersionInfo.GetKeyValue(Key:CInfo):String;
begin
  result:=GetKeyValueI(Ord(Key));
end;


function TVersionInfo.GetKeyValueI(i: integer): string;
begin
  Result := '';
  if ( i < 0 ) or ( Count <= i ) then exit;
  Result:=InfoList[i];
end;

procedure VersionInfoFillList(st:TStrings;sep:string);
var info : TVersionInfo;
begin
  info := TVersionInfo.Create;
  info.FillList(st,sep);
  info.Free;
end;


(*
initialization
  GlobalVersionInfo := TVersionInfo.Create;
finalization
  try
    GlobalVersionInfo.Free;
  except
  end;
*)
end.