Composant tdbpversioninfo

Description

Ce compo donne les infos de la version du logiciel.
ex: 2.1.12.1979
ou en plus propre
ex: Version 2.1 (build 21.1979)
Voyez la source pour mieux comprendre.

Source / Exemple :


{
################################################################################
# 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.

Conclusion :


ps : StrManager est necessaire ! (StrMan.pas)

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.