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

unit rpVersionInfo; //версия 1.0 3/8/98 записана и проверена в Delphi 3.
(*Автор Rick Peterson, данный компонент распространяется свободно
и освобожден от платы за использование. В случае измененияавторского кода просьба прислать измененный код. Сообщайте пожалуйстаобо всех найденных ошибках. Адрес для писем - rickpet@airmail.net. *)
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) (* Данный компонент позволяет получать информацию о версии вашего приложения
во время его выполенния *)privateFVersionInfo : Array [0 .. ord(high(TVersionType))] of string;protectedfunction 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;publicconstructor 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 thenbeginpcBuf := AllocMem(iAppSize);GetFileVersionInfo(PChar(sAppName),0,iAppSize,pcBuf);for i := 0 to Ord(High(TVersionType)) dobeginsVersionType := GetEnumName(TypeInfo(TVersionType),i);sVersionType := Copy(sVersionType,3,length(sVersionType));if VerQueryValue(pcBuf,PChar('StringFileInfo\040904E4\'+sVersionType), Pointer(pcValue),iLenOfValue)thenFVersionInfo[i] := pcValue;end;FreeMem(pcBuf,iAppSize);end;end;

procedure Register;
begin
RegisterComponents('FreeWare', [TrpVersionInfo]);end;

end.

[000267]

Содержание раздела