COMPOSANT TDBPVERSIONINFO

{
################################################################################
# DBPVERSIONIFO                                                                #
################################################################################
#                                                                              #
# VERSION       : 1.2                                                          #
# FICHIERS      : dbpVersionInfo.pas,.dcu,.dcr,.bmp,ReadMe.htm                 #
# AUTEUR        : Julio P. (Diabloporc)                                        #
# CREATION      : 20 Jul 2004                                                  #
# MODIFIEE      : 27 Jul 2004                                                  #
# SITE WEB      : http://diabloporc.free.fr                                    #
# MAIL          : diabloporc@laposte.net                                       #
# LEGAL         : Free sous Licence GNU/GPL                                    #
# INFOS         : Retrouvez moi sur www.delphifr.com : "JulioDelphi"           #
#                 Lisez le ReadMe.htm !                                        #
#                                                                              #
################################################################################
}
unit dbpVersionInfo;

interface

uses
  dialogs, windows, forms, Strman, SysUtils, Classes;

type
  TdbpVersionInfo = class(TComponent)
  private
    FAbout: string;

    function GetAbout: string;
    function GetVersion: string;
    function GetCN: string;
    function GetFD: string;
    function GetLC: string;
    function GetIN: string;
    function GetLT: string;
    function GetOF: string;
    function GetPN: string;
    function GetC: string;
    function GetPV: string;
    function LectureVersion(index: word;Value: string): string;
    function GetMajor: string;
    function GetMinor: string;
    function GetRelease: string;
    function GetBuild: string;
  protected
  public
    property Major:        string   read GetMajor;
    property Minor:        string   read GetMinor;
    property Release:      string   read GetRelease;
    property Build:        string   read GetBuild;
    property CompanyName:     string   read GetCN;
    property FileDescription: string   read GetFD;
    property FileVersion:     string   read GetVersion;
    property InternalName:    string   read GetIN;
    property LegalCopyright:  string   read GetLC;
    property LegalTradeMarks: string   read GetLT;
    property OriginalFileName:string   read GetOF;
    property ProductName:     string   read GetPN;
    property ProductVersion:  string   read GetPV;
    property Comments:        string   read GetC;
    function FileVersionFmt:      String;
    function Lire(Value: String): string;

  published
    property About:        String   read GetAbout     write FAbout;
  end;

procedure Register;

implementation

{$R DBPVERSIONINFO.dcr}


// fonction de lecture des infos du fichier (voir aide delphi :p)
function TdbpVersionInfo.LectureVersion(index: word;Value: string):String;
Var
  S         : String;
  Taille    : DWord;
  Buffer    : PChar;
  Autre     : PChar;
  VersionL  : DWord;
  FTruc     : string[16];
Begin
  Result:='';
  S := Application.ExeName;
  Taille := GetFileVersionInfoSize(PChar(S), Taille);
  If Taille>0
  Then Try
    Buffer := AllocMem(Taille);
    GetFileVersionInfo(PChar(S), 0, Taille, Buffer);
    case index of
     10: FTruc := Value;
     0: FTruc := 'FileVersion';
     1: FTruc := 'CompanyName';
     2: FTruc := 'FileDescription';
     3: FTruc := 'InternalName';
     4: FTruc := 'LegalCopyright';
     5: FTruc := 'LegalTradeMarks';
     6: FTruc := 'OriginalFilename';
     7: FTruc := 'ProductName';
     8: FTruc := 'ProductVersion';
     9: FTruc := 'Comments';
    end;
    If VerQueryValue(Buffer, PChar(format('\StringFileInfo\040C04E4\%s',[FTruc])), Pointer(Autre), VersionL)
      Then Result := Autre;

  Finally
    FreeMem(Buffer, Taille);
  End;
End;

function TdbpVersionInfo.Lire(Value: string): string;
begin
 result := LectureVersion(10,Value);
end;

function TdbpVersionInfo.GetAbout: string;
begin
 Result := 'v1.2 par Julio P. (Diabloporc)';
end;

function TdbpVersionInfo.GetVersion: string;
begin
 Result := LectureVersion(0,'');
end;

function TdbpVersionInfo.GetCN: string;
begin
 Result := LectureVersion(1,'');
end;

function TdbpVersionInfo.GetFD: string;
begin
 Result := LectureVersion(2,'');
end;

function TdbpVersionInfo.GetIN: string;
begin
 Result := LectureVersion(3,'');
end;

function TdbpVersionInfo.GetLC: string;
begin
 Result := LectureVersion(4,'');
end;

function TdbpVersionInfo.GetLT: string;
begin
 Result := LectureVersion(5,'');
end;

function TdbpVersionInfo.GetOF: string;
begin
 Result := LectureVersion(6,'');
end;

function TdbpVersionInfo.GetPN: string;
begin
 Result := LectureVersion(7,'');
end;

function TdbpVersionInfo.GetPV: string;
begin
 Result := LectureVersion(8,'');
end;

function TdbpVersionInfo.GetC: string;
begin
 Result := LectureVersion(9,'');
end;

// petite fonction pour une sortie plus belle et rapide, ex: "Version 2.0 (build 21.12)"
function TdbpVersionInfo.FileVersionFmt: string;
begin
 Result := Format('Version %s.%s (build %s.%s)',[GetMajor,GetMinor,GetRelease,GetBuild]);
end;

function TdbpVersionInfo.GetMajor: string;
begin
  Result   := sm.Before('.',LectureVersion(0,''));
end;

function TdbpVersionInfo.GetMinor: string;
begin
  Result   := sm.Between('.','.',LectureVersion(0,''));
end;

function TdbpVersionInfo.GetRelease: string;
begin
  Result   := sm.BetweenRev('.','.',LectureVersion(0,''));
end;

function TdbpVersionInfo.GetBuild: string;
begin
  Result   := sm.AfterRev('.',LectureVersion(0,''));
end;

procedure Register;
begin
  RegisterComponents('Diabloporc', [TdbpVersionInfo]);
end;

end.

Télécharger le zip