(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTVersionDetails;

interface

uses Classes,AHMSystemClass,AHMSystemConst;

type
  TAHMVersionDetails = class(TAHMSystemsComponent)
  private
    FCompanyName, FFileDescription, FFileVersion,
    FInternalName, FLegalCopyright, FOriginalFilename,
    FProductName, FProductVersion: string;
    FFilename: String;
    FOnUpdate: TNotifyEvent;
    procedure SetDesign(const DesignString: string);
    function GetCompanyName: string;
    function GetFileDescription: string;
    function GetFileVersion: string;
    function GetInternalName: string;
    function GetLegalCopyright: string;
    function GetOriginalFilename: string;
    function GetProductName: string;
    function GetProductVersion: string;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    destructor Destroy; override;
    Procedure SetVersionDetails(NewFile : String);
    function GetValue(Value : String) : String;
  published
    property About;
    property AboutFile : String read FFilename write SetVersionDetails stored False;
    property CompanyName: string read GetCompanyName write SetDesign stored false;
    property FileDescription: string read GetFileDescription write SetDesign stored false;
    property FileVersion: string read GetFileVersion write SetDesign stored false;
    property InternalName: string read GetInternalName write SetDesign stored false;
    property LegalCopyright: string read GetLegalCopyright write SetDesign stored false;
    property OriginalFilename: string read GetOriginalFilename write SetDesign stored false;
    property ProductName: string read GetProductName write SetDesign stored false;
    property ProductVersion: string read GetProductVersion write SetDesign stored false;
    property OnUpdate : TNotifyEvent read FOnUpdate write FOnUpdate;
  end;

implementation
uses Forms,SysUtils,Windows;

constructor TAHMVersionDetails.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetVersionDetails(Application.Exename);
end;

destructor TAHMVersionDetails.Destroy;
begin
  inherited Destroy;
end;

procedure TAHMVersionDetails.SetDesign(const DesignString: string);
begin
  { enables viewing of properties in Design}
end;

Procedure TAHMVersionDetails.SetVersionDetails(NewFile: String);
Var
  VersionSize : Longint;
  VNHandle : DWord;
  Vinfo     : PChar;
  Vitem     : Pointer;
  Rc        : Boolean;
  PFileName      : array [0..255] of Char;
  Ne, L : Integer;
  LenRes : DWord;
  Lang,Code : Word;
  Xlate     : String;
begin
  if FileExists(NewFile) then FFilename := NewFile else FFilename:=Application.ExeName;
  FCompanyName := ahmscNoVersionDetails;
  FFileDescription := ahmscNoVersionDetails;
  FFileVersion := ahmscNoVersionDetails;
  FInternalName := ahmscNoVersionDetails;
  FLegalCopyRight := ahmscNoVersionDetails;
  FOriginalFileName := ahmscNoVersionDetails;
  FProductName := ahmscNoVersionDetails;
  FProductVersion := ahmscNoVersionDetails;
  StrPCopy(PFileName,FFilename);
  Vitem := @PFileName;
  VersionSize := GetFileVersionInfoSize(VItem,VNHandle);
  if VersionSize = 0 then Exit;
  GetMem(Vinfo,Word(VersionSize));
  RC:=GetFileVersionInfo(PFileName,VNhandle,VersionSize,Vinfo);
  if Not Rc then
  begin
    FreeMem(Vinfo,VersionSize);
    Exit;
  end;
  VerQueryValue(Vinfo,StrPCopy(PFileName,ahmscvarfile),Vitem,LenRes);
  Lang := $409;
  Code := 0;
  if Rc then
  begin
    Ne := LenRes Div 4;
    For L := 1 to ne do
    begin
      Lang := LOWORD(LongInt(Vitem^));
      Code := HIWORD(LongInt(Vitem^));
      if Lang = $409 then break;
    end;
  end;
  Xlate := ahmscStringFileInfo + IntToHex(Lang,4) +IntToHex(Code,4) + '\';
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'CompanyName'),Vitem,LenRes)<>False then FCompanyName := StrPas(Vitem);
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'FileDescription'),Vitem,LenRes)<>False then FFileDescription := StrPas(Vitem);
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'FileVersion'),Vitem,LenRes)<>False then FFileVersion := StrPas(Vitem);
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'InternalName'),Vitem,LenRes)<>False then FInternalName := StrPas(Vitem);
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'LegalCopyRight'),Vitem,LenRes)<>False then FLegalCopyRight := StrPas(Vitem);
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'OriginalFileName'),Vitem,LenRes)<>False then FOriginalFileName := StrPas(Vitem);
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'ProductName'),Vitem,LenRes)<>False then FProductName := StrPas(Vitem);
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate+'ProductVersion'),Vitem,LenRes)<>False then FProductVersion := StrPas(Vitem);
  FreeMem(Vinfo,VersionSize);
  if assigned(FOnUpdate) then FOnUpdate(Self);
end;

function TAHMVersionDetails.GetCompanyName: string;
begin
  result:=FCompanyName;
end;

function TAHMVersionDetails.GetFileDescription: string;
begin
  result:=FFileDescription;
end;

function TAHMVersionDetails.GetFileVersion: string;
begin
  result:=FFileVersion;
end;

function TAHMVersionDetails.GetInternalName: string;
begin
  result:=FInternalName;
end;

function TAHMVersionDetails.GetLegalCopyright: string;
begin
  result:=FLegalCopyright;
end;

function TAHMVersionDetails.GetOriginalFilename: string;
begin
  result:=FOriginalFilename;
end;

function TAHMVersionDetails.GetProductName: string;
begin
  result:=FProductName;
end;

function TAHMVersionDetails.GetProductVersion: string;
begin
  result:=FProductVersion;
end;


function TAHMVersionDetails.GetValue(Value: String): String;
Var
  VersionSize : Longint;
  VNHandle : DWord;
  Vinfo     : PChar;
  Vitem     : Pointer;
  Rc        : Boolean;
  PFileName      : array [0..255] of Char;
  Ne, L : Integer;
  LenRes : DWord;
  Lang,Code : Word;
  Xlate     : String;
begin
  Result:=ahmscNoVersionDetails;
  StrPCopy(PFileName,FFilename);
  Vitem := @PFileName;
  VersionSize := GetFileVersionInfoSize(VItem,VNHandle);
  if VersionSize = 0 then Exit;
  GetMem(Vinfo,Word(VersionSize));
  RC:=GetFileVersionInfo(PFileName,VNhandle,VersionSize,Vinfo);
  if Not Rc then
  begin
    FreeMem(Vinfo,VersionSize);
    Exit;
  end;
  VerQueryValue(Vinfo,'\',Vitem,LenRes);
  VerQueryValue(Vinfo,StrPCopy(PFileName,ahmscvarfile),Vitem,LenRes);
  Lang := $409;
  Code := 0;
  if Rc then
  begin
    Ne := LenRes Div 4;
    For L := 1 to ne do
    begin
      Lang := LOWORD(LongInt(Vitem^));
      Code := HIWORD(LongInt(Vitem^));
      if Lang = $409 then break;
    end;
  end;
  Xlate := ahmscStringFileInfo + IntToHex(Lang,4) +IntToHex(Code,4) + '\';
  if VerQueryValue(Vinfo,StrPcopy(PFileName,Xlate + Value),Vitem,LenRes)<>False then result := StrPas(Vitem);
  FreeMem(Vinfo,VersionSize);
  if assigned(FOnUpdate) then FOnUpdate(Self);
end;

procedure TAHMVersionDetails.Loaded;
begin
  inherited Loaded;
  SetVersionDetails(FFilename);
end;

end.
