Информация о версии (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) (* Данный компонент позволяет получать информацию о версии вашего приложения
во время его выполенния *) 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.

[000267]

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