Информация о версии (Version Info) в Delphi EXE

unit rpVersionInfo; //версия 1.0 3/8/98 записана и проверена в Delphi 3.

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

TypInfo;

 

 

type

{$M }

(* Видели директиву $M ??? Это заставляет Delphi включать в код RTTI-информацию для

 

перечислимых типов. В основном допускает работу с перечислимыми типами как

со строками с помощью GetEnumName *)

TVersionType = (vtCompanyName, vtFileDescription, vtFileVersion,

vtInternalName,

vtLegalCopyright, vtLegalTradeMark, vtOriginalFileName,

vtProductName, vtProductVersion, vtComments);

{$M-}

 

TrpVersionInfo = class(TComponent)

(* Данный компонент позволяет получать информацию о версии вашего приложения

 

во время его выполенния *)

private

FVersionInfo: array[0..ord(high(TVersionType))] of string;

protected

function GetCompanyName: string;

function GetFileDescription: string;

function GetFileVersion: string;

function GetInternalName: string;

function GetLegalCopyright: string;

function GetLegalTradeMark: string;

function GetOriginalFileName: string;

function GetProductName: string;

function GetProductVersion: string;

function GetComments: string;

function GetVersionInfo(VersionType: TVersionType): string; virtual;

procedure SetVersionInfo; virtual;

public

constructor Create(AOwner: TComponent); override;

published

(* Использовать это очень просто — Label1.Caption := VersionInfo1.FileVersion

 

Примечание: Все свойства — только для чтения, поэтому они недоступны в

Инспекторе Объектов *)

property CompanyName: string read GetCompanyName;

property FileDescription: string read GetFileDescription;

property FileVersion: string read GetFileVersion;

property InternalName: string read GetInternalName;

property LegalCopyright: string read GetLegalCopyright;

property LegalTradeMark: string read GetLegalTradeMark;

property OriginalFileName: string read GetOriginalFileName;

property ProductName: string read GetProductName;

property ProductVersion: string read GetProductVersion;

property Comments: string read GetComments;

end;

 

procedure Register;

 

implementation

 

constructor TrpVersionInfo.Create(AOwner: TComponent);

begin

 

inherited Create(AOwner);

SetVersionInfo;

end;

 

function TrpVersionInfo.GetCompanyName: string;

begin

 

result := GeTVersionInfo(vtCompanyName);

end;

 

function TrpVersionInfo.GetFileDescription: string;

begin

 

result := GeTVersionInfo(vtFileDescription);

end;

 

function TrpVersionInfo.GetFileVersion: string;

begin

 

result := GeTVersionInfo(vtFileVersion);

end;

 

function TrpVersionInfo.GetInternalName: string;

begin

 

result := GeTVersionInfo(vtInternalName);

end;

 

function TrpVersionInfo.GetLegalCopyright: string;

begin

 

result := GeTVersionInfo(vtLegalCopyright);

end;

 

function TrpVersionInfo.GetLegalTradeMark: string;

begin

 

result := GeTVersionInfo(vtLegalTradeMark);

end;

 

function TrpVersionInfo.GetOriginalFileName: string;

begin

result := GeTVersionInfo(vtOriginalFileName);

end;

 

function TrpVersionInfo.GetProductName: string;

begin

result := GeTVersionInfo(vtProductName);

end;

 

function TrpVersionInfo.GetProductVersion: string;

begin

result := GeTVersionInfo(vtProductVersion);

end;

 

function TrpVersionInfo.GetComments: string;

begin

result := GeTVersionInfo(vtComments);

end;

 

function TrpVersionInfo.GeTVersionInfo(VersionType: TVersionType): string;

begin

result := FVersionInfo[ord(VersionType)];

end;

 

procedure TrpVersionInfo.SeTVersionInfo;

var

sAppName, sVersionType: string;

iAppSize, iLenOfValue, i: integer;

pcBuf, pcValue: PChar;

begin

sAppName := Application.ExeName;

iAppSize := GetFileVersionInfoSize(PChar(sAppName), iAppSize);

if iAppSize > 0 then

begin

pcBuf := AllocMem(iAppSize);

GetFileVersionInfo(PChar(sAppName), 0, iAppSize, pcBuf);

for i := 0 to Ord(High(TVersionType)) do

begin

sVersionType := GetEnumName(TypeInfo(TVersionType), i);

sVersionType := Copy(sVersionType, 3, length(sVersionType));

if VerQueryValue(pcBuf, PChar(‘StringFileInfo\040904E4\’

sVersionType), Pointer(pcValue), iLenOfValue) then

FVersionInfo[i] := pcValue;

end;

FreeMem(pcBuf, iAppSize);

end;

end;

 

procedure Register;

begin

RegisterComponents(‘FreeWare’, [TrpVersionInfo]);

end;

 

end.

Добавить комментарий