Текущий архив: 2008.08.03;
Скачать: CL | DM;

Вниз

Версия проекта   Найти похожие ветки 

← →
AlexeyMir   (2008-07-01 00:49) [0]

Подскажите, пожалуйста, как можно чтобы программа показывала свою версию, т.е. версию проекта, которая задается в Delphi ->Project->Options->Version Info->Module version number ?

---

← →
KilkennyCat ©   (2008-07-01 00:56) [1]

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.

---

← →
Игорь Шевченко ©   (2008-07-01 00:59) [2]

KilkennyCat ©   (01.07.08 00:56) [1]

" - А у Пети дела хорошо идут? - спросила Люся.
- Дела что надо. Он недавно сконструировал МУКУ-1. Это светлое дерзание технической мысли.
- А что это за МУКА?
- Это Механический Универсальный Консервооткрывающий Агрегат - вот это что! Теперь домашние хозяйки и холостяки будут избавлены от возни с открыванием консервов.
- У тебя нет этого агрегата? - спросила Люся. - Интересно бы посмотреть.
- У меня его нет и не будет. Он ведь должен весить пять тонн, под него нужен бетонный фундамент. И стоить он будет четыреста тысяч новыми.
- Какая же хозяйка сможет купить эту МУКУ? - удивилась Люся.
- Господи, какая же ты непонятливая! - воскликнула Светлана. - Каждой хозяйке и не надо покупать этот агрегат. Его одного на весь город хватит. Он будет установлен где-нибудь в центре города, скажем на Невском. И там будет оборудован ЕГКОЦ - Единый Городской Консервооткрывательный Центр. Это очень удобно. Вот, скажем, пришли к тебе гости, надо для них шпроты открыть. Не надо ни консервного ножа, ни физических усилий. Ты просто берешь свою консервную банку, быстренько выходишь на улицу, едешь в ЕГКОЦ. Там сдаешь банку приемщице, платишь пять копеек новыми и получаешь квитанцию. Приемщица наклеивает на банку ярлычок и ставит ее на конвейер. А ты идешь себе в зал ожидания, садишься в кресло и смотришь короткометражный фильм на консервную тему. Вскоре тебя вызывают к окошечку, ты предъявляешь квитанцию, получаешь открытую банку и спокойно едешь домой на Васильевский. Удобно, правда?
"
(c) Вадим Шефнер, "Скромный гений"

Навеяло...

---

← →
Германн ©   (2008-07-01 01:06) [3]

> Игорь Шевченко ©   (01.07.08 00:59) [2]

Повторяешься. :)

Хотя цитата стоит того!

---

← →
KilkennyCat ©   (2008-07-01 01:45) [4]

:) я тоже Гений, но - нескромный.
Но кто обещал легкую и удобную жизнь?

---

← →
Джо ©   (2008-07-01 03:22) [5]

{***********************************************************
 Класс-обертка для функций:
 Wrapper for API functions:
   GetFileVersionInfo,GetFileVersionInfoSize,VerQueryValue

 E-mail: sergeybox@gmail.com

 Последнее изменение/Last modified: 20:56 03.08.2004

 ПРИМЕРЫ ИСПОЛЬЗОВАНИЯ/USAGE SAMPLES:

 -----------------------------------------------------------
  Пример 1:
  var
    FileInfo: TFileVersionInfo;
    VerInfo: TFileVersion;
  begin
    // file name passed to constructor
    FileInfo := TFileVersionInfo.Create ("c:\prog.exe");
    try
      if FileInfo.HasInfo then
      begin
        Label1.Caption := FileInfo.GetString (INFO_CompanyName);
        Label2.Caption := FileInfo.GetString (INFO_FileDescription);

        VerInfo := FileInfo.GetVersion;
        Label3.Caption := Format ("%d.%d",[VerInfo.Minor,VerInfo.Major]);
      end;
    finally
      FileInfo.Free;
    end;
  end;
 
 -----------------------------------------------------------
  Пример 2:
  var
    FileInfo: TFileVersionInfo;
    VerInfo: TFileVersion;

  begin
    // no file name passed to constructor
    FileInfo := TFileVersionInfo.Create;
    try

      FileInfo.FileName := "c:\myprog1.Exe";  // specify file
      if FileInfo.HasInfo then
      begin
        Label1.Caption := FileInfo.GetString (INFO_CompanyName);
        Label2.Caption := FileInfo.GetString (INFO_FileDescription);

        VerInfo := FileInfo.GetVersion;
        Label3.Caption := Format ("%d.%d",[VerInfo.Minor,VerInfo.Major]);
      end;

      FileInfo.FileName := "c:\myprog2.Exe";  // specify file
      if FileInfo.HasInfo then
      begin
        Label4.Caption := FileInfo.GetString (INFO_CompanyName);
        Label5.Caption := FileInfo.GetString (INFO_FileDescription);

        VerInfo := FileInfo.GetVersion;
        Label6.Caption := Format ("%d.%d",[VerInfo.Minor,VerInfo.Major]);
      end;

    finally
      FileInfo.Free;
    end;
  end;
************************************************************}

unit VerInfo;

interface
uses Windows;

const
 MaxInfoStrings = 7;

 INFO_CompanyName = "CompanyName";
 INFO_FileDescription = "FileDescription";
 INFO_FileVersion = "FileVersion";
 INFO_InternalName = "InternalName";
 INFO_LegalCopyright = "LegalCopyright";
 INFO_OriginalFileName = "OriginalFileName";
 INFO_ProductName = "ProductName";
 INFO_ProductVersion = "ProductVersion";

 VersionInfoStrings: array [0..MaxInfoStrings] of string =
 (
   INFO_CompanyName,
   INFO_FileDescription,
   INFO_FileVersion,
   INFO_InternalName,
   INFO_LegalCopyright,
   INFO_OriginalFileName,
   INFO_ProductName,
   INFO_ProductVersion
 );

type
 TFileVersion = record
   Minor,
   Major,
   Build,
   Release: WORD;
 end;

 TFileVersionInfo = class
 private
   FFileName: string;
   FBuffer: PChar;
   FBuffLen: Cardinal;
   FLocale: string;
   procedure SetFileName(const Value: string);
   procedure LoadFile (AFileName: string);
   procedure UnloadFile;
   function GetHasInfo: Boolean;
 public
   constructor Create (AFileName: string);
   destructor Destroy; override;

   property HasInfo: Boolean read GetHasInfo;
   property FileName: string read FFileName write SetFileName;
   property Locale: string read FLocale;

   function GetString (AString: string): string;
   function GetVersion: TFileVersion;

 end;

implementation
uses SysUtils;

{ TFileVersionInfo }

type
 TVer1 = record
   Minor: Word;
   Major: Word;
 end;
 TVer2 = record
   Build: Word;
   Release: Word;
 end;

constructor TFileVersionInfo.Create(AFileName: string);
begin
 FFileName := AFileName;
 LoadFile(AFileName);
end;

destructor TFileVersionInfo.Destroy;
begin
 UnloadFile;
 inherited;
end;

function TFileVersionInfo.GetHasInfo: Boolean;
begin
 Result := (FFileName <> "") and (FBuffLen <> 0);
end;

function TFileVersionInfo.GetString(AString: string): string;
var
 InfoLen: Cardinal;
 PInfo: PChar;
begin
 if VerQueryValue(
   FBuffer,
   PChar("\StringFileInfo\" + FLocale + "\"+AString),
   Pointer(PInfo),
   InfoLen
 ) then
 begin
   Result := PInfo;
 end
 else
   Result := ""
end;

function TFileVersionInfo.GetVersion: TFileVersion;
var
 FI: PVSFixedFileInfo;
 VerSize: Cardinal;
 Ver1: TVer1;
 Ver2: TVer2;
begin
 if VerQueryValue(FBuffer,"\",Pointer(FI),VerSize) then
 begin
   Ver1 := TVer1(FI.dwFileVersionMS);
   Ver2 := TVer2(FI.dwFileVersionLS);

   Result.Minor := Ver1.Minor;
   Result.Major := Ver1.Major;
   Result.Build := Ver2.Build;
   Result.Release := Ver2.Release;
 end;
end;

procedure TFileVersionInfo.LoadFile(AFileName: string);
var
 Dummy,LangLen: Cardinal;
 LangBuff: PChar;
begin
 UnloadFile;

 FBuffLen := 0;

 // Buffer size
 FBuffLen := GetFileVersionInfoSize(
   PChar(AFileName),
   Dummy
 );

 if FBuffLen <> 0 then
 begin
   GetMem (FBuffer,FBuffLen);

   // read resource data
   GetFileVersionInfo(
     PChar(FileName),
     0,
     FBuffLen,
     FBuffer
   );

   // check string locale
   VerQueryValue(FBuffer, "\VarFileInfo\Translation", pointer(LangBuff), LangLen);
   if langLen >= 4 then // if specified
   begin
     StrLCopy(@Dummy, LangBuff, 2);
     FLocale:= Format("%4.4x", [Dummy]);
     StrLCopy(@Dummy, LangBuff+2, 2);
     FLocale := FLocale + Format("%4.4x", [Dummy]);
   end
   else
     // use Amer. Engl, ANSI
     FLocale := "040904E4";
 end;
end;

procedure TFileVersionInfo.SetFileName(const Value: string);
begin
 FFileName := Value;
 LoadFile(Value);
end;

procedure TFileVersionInfo.UnloadFile;
begin
 FreeMem (FBuffer);
end;

end.


И я тоже, понимаешь, не в лаптях! :D

---

← →
Anatoly Podgoretsky ©   (2008-07-01 09:16) [6]

> Джо  (01.07.2008 3:22:05)  [5]

А где шифрования, так же любой кульхацкер прочитает.

---

← →
Игорь Шевченко ©   (2008-07-01 13:19) [7]

Джо ©   (01.07.08 03:22) [5]

У кого код длиннее, меряемся ?
IncDay все равно непобедим

---

Страницы: 1 вся ветка

Текущий архив: 2008.08.03;
Скачать: CL | DM;

Наверх

Память: 0.51 MB
Время: 0.018 c