unit VersionInfo;
{
 [VersionInfo] [1.2]
Delphi 2005
June 2008

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[VersionInfo.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005, 2006 Martin Holmes
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
 Written by Martin Holmes, 2003-5, based on various examples and tutorials
 from the WWW. Currently written for Delpi 2005, and only tested with
 Delphi 2005.

 This is a general-purpose reflective class that queries the
 Windows API for information about the running application, retrieving the
 kind of info which is set in the Project Options dialog box.

 The class also has functions for constructing useful Windows Registry paths
 which might be used for storing state information. These will likely be
 expanded to include functions for constructing paths to Application Data
 folders etc.

 Any app can use this class to get information about itself; it's also used
 by the TSplashAbout object to retrieve the data necessary to complete an
 About box, so any app which has instantiated a TSplashAbout object can use
 its AppVersionInfo member instead of instantiating a new copy. The FormState
 library also instantiates its own a TAppVersionInfo object, which is redundant
 when an app uses both SplashAbout and FormState, but enables portability of
 those two libraries.

 Dependencies:
  None.

}

interface

uses
  Classes, Graphics, Forms, Windows, SysUtils;

type

 TAppVersionInfo = class(TObject)
 private
   FTranslation: Cardinal;
   FTranslationString: string;
   FCompanyName: string;
   FFileDescription: string;
   FFileVersion: string;
   FInternalName: string;
   FLegalCopyright: string;
   FOriginalFilename: string;
   FProductName: string;
   FProductVersion: string;
   FComments: string;
   FURL: string;
   FV1: integer;
   FV2: integer;
   FV3: integer;
   FV4: integer;
   FDottedVersion: string;
   FFullVersionString: string;
   function GetAppRegPath: string;
   function GetSuiteRegPath: string;
   function GetShortSuiteName: string;

 public
   constructor Create;

   property Translation: Cardinal read FTranslation;
   property TranslationString: string read FTranslationString;
   property CompanyName: string read FCompanyName;
   property FileDescription: string read FFileDescription;
   property FileVersion: string read FFileVersion;
   property InternalName: string read FInternalName;
   property LegalCopyright: string read FLegalCopyright;
   property OriginalFilename: string read FOriginalFilename;
   property ProductName: string read FProductName;
   property ProductVersion: string read FProductVersion;
   property Comments: string read FComments;
   property V1: integer read FV1;
   property V2: integer read FV2;
   property V3: integer read FV3;
   property V4: integer read FV4;
   property DottedVersion: string read FDottedVersion;
   property FullVersionString: string read FFullVersionString;
   property URL: string read FURL;
   property AppRegPath: string read GetAppRegPath;
   property SuiteRegPath: string read GetSuiteRegPath;
   property ShortSuiteName: string read GetShortSuiteName;
 end;

implementation

{TAppVersionInfo}


constructor TAppVersionInfo.Create;
var
 VerInfoSize: DWord;
 VerInfo: Pointer;
 VerValueSize: DWord;
 VerValue: PVSFixedFileInfo;
 verString: Pointer;
 Dummy: DWord;
 Path: string;
begin
 VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName),Dummy);
 if ( VerInfoSize<>0 ) then
 begin
   GetMem(VerInfo,VerInfoSize);
   try
     GetFileVersionInfo(PChar(Application.ExeName),0,VerInfoSize,VerInfo);
     if ( VerInfo <> nil ) then
     begin
       VerQueryValue(VerInfo,'\',Pointer(VerValue),VerValueSize);
       FV1 := VerValue.dwFileVersionMS shr 16;
       FV2 := VerValue.dwFileVersionMS and $FFFF;
       FV3 := VerValue.dwFileVersionLS shr 16;
       FV4 := VerValue.dwFileVersionLS and $FFFF;
     end;

     VerQueryValue(VerInfo,'\\VarFileInfo\\Translation',verString,VerValueSize);
     if ( verValueSize>0 ) then
     begin
       FTranslation := Cardinal(VerString^);
       FTranslationString := Format('%4.4x%4.4x',[(FTranslation and $0000FFFF),((FTranslation shr 16) and $0000FFFF)]);
     end;

     Path := Format('\StringFileInfo\%s\CompanyName',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FCompanyName := PChar(VerString);

     Path := Format('\StringFileInfo\%s\FileDescription',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FFileDescription := PChar(VerString);

     Path := Format('\StringFileInfo\%s\FileVersion',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FFileVersion := PChar(VerString);

     Path := Format('\StringFileInfo\%s\InternalName',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FInternalName := PChar(VerString);

     Path := Format('\StringFileInfo\%s\LegalCopyright',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FLegalCopyright := PChar(VerString);

     Path := Format('\StringFileInfo\%s\OriginalFilename',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FOriginalFilename := PChar(VerString);

     Path := Format('\StringFileInfo\%s\ProductName',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FProductName := PChar(VerString)
//We must use something here, because other libraries build file paths based on this.
     else
       FProductName := ExtractFileName(Application.ExeName);

     Path := Format('\StringFileInfo\%s\ProductVersion',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FProductVersion := PChar(VerString);

     Path := Format('\StringFileInfo\%s\Comments',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FComments := PChar(VerString);

     Path := Format('\StringFileInfo\%s\URL',[FTranslationString]);
     VerQueryValue(VerInfo,PChar(Path),verString,VerValueSize);
     if ( verValueSize>0 ) then
       FURL := PChar(VerString);

     FDottedVersion := IntToStr(V1) + '.' + IntToStr(V2) + '.' +
                         IntToStr(V3) + '.' + IntToStr(V4);

     FFullVersionString := ProductName + ': ' + Application.Title + ' Version ' +
                         IntToStr(V1) + '.' + IntToStr(V2) + ' Release ' +
                         IntToStr(V3) + ' Build ' + IntToStr(V4);
   finally
     FreeMem(VerInfo,VerInfoSize);
   end;
 end;
end;

function TAppVersionInfo.GetAppRegPath: string;
begin
  Result := 'Software\';
  if Length(Trim(CompanyName)) > 0 then
     Result := Result + CompanyName + '\';
  if Length(Trim(ProductName)) > 0 then //this is part of a suite
     begin
        Result := Result + ProductName + '\';
        Result := Result + IntToStr(V1) + '\';
        Result := Result + Application.Title;
     end
  else //this is a standalone app
     begin
        Result := Result + Application.Title + '\';
        Result := Result + IntToStr(V1);
     end;
end;

function TAppVersionInfo.GetShortSuiteName: string;
begin
  Result := InternalName;
end;

function TAppVersionInfo.GetSuiteRegPath: string;
begin
  Result := 'Software\';
  if Length(Trim(CompanyName)) > 0 then
     Result := Result + CompanyName + '\';
  if Length(Trim(ProductName)) > 0 then //this is part of a suite
     begin
        Result := Result + ProductName + '\';
        Result := Result + IntToStr(V1);
     end
  else //this is a standalone app
     begin
        Result := Result + Application.Title + '\';
        Result := Result + IntToStr(V1);
     end;
end;

end.