| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Информация о версии в результирующем екзешнике... [D6]

Alex_1234 ©   (2005-12-15 09:07:00) 

Господа, а есть-ли возможность сделать так:
делаю форму About.
На ней Label с текстом:Версия № 3.0.0.23
где 23 берется из "Project"-"Options" вкладка "Version info". А еще хочется, что бы "Build" само увеличивалось на еденицу при каждой компиляции проекта....

---

Alex_1234   (2005-12-15 09:45:00) [1]

Спасибо. Все прекрасно работает (по крайне мере на моей машине:-) )

---

zorik   (2005-12-15 09:24:00) [2]

<<А еще хочется, что бы "Build" само увеличивалось на еденицу при каждой компиляции проекта....

Включи опцию Auto increment build number в  "Project"-"Options"

<<Господа, а есть-ли возможность сделать так:
<<делаю форму About.
<<На ней Label с текстом:Версия № 3.0.0.23
<<где 23 берется из "Project"-"Options" вкладка "Version info".

Вот тебе компонент для извлечения версии из екзешника. Думаю разберешся


unit gsFVersion;

//**! ------------------------------------------------------------------
//**! This unit is a part of GSPackage project (Gregory Sitnin's Delphi
//**! Components Package).
//**! ------------------------------------------------------------------
//**! You may use or redistribute this unit for your purposes while
//**! unit's code and this copyright notice is unchanged and exists.
//**! ------------------------------------------------------------------
//**! (c) Gregory Sitnin, 2001-2002. All rights reserved.
//**! ------------------------------------------------------------------

interface

uses
 Windows, Messages, SysUtils, Classes;

type
 TgsFVersion = class(TComponent)
 private
   FFilename: TFilename;
   FVersionInfoSize: cardinal;
   FFileVersion: string;
   FFileDescription: string;
   FInternalName: string;
   FOriginalFilename: string;
   FCompanyName: string;
   FProductVersion: string;
   FProductName: string;
   FLegalCopyright: string;
   FLanguageInfo: string;
   FComments: string;
   procedure SetFilename(const Value: TFilename);
   { Private declarations }
 protected
   { Protected declarations }
   property VersionInfoSize: cardinal read FVersionInfoSize;
   procedure LoadFromFile;
   procedure ClearAll;
 public
   { Public declarations }
 published
   { Published declarations }
   function GetBuildOnly: string;
   property Filename: TFilename read FFilename write SetFilename;
   property LanguageInfo: string read FLanguageInfo;
   property CompanyName: string read FCompanyName;
   property FileDescription: string read FFileDescription;
   property FileVersion: string read FFileVersion;
   property InternalName: string read FInternalName;
   property LegalCopyright: string read FLegalCopyright;
   property OriginalFilename: string read FOriginalFilename;
   property ProductName: string read FProductName;
   property ProductVersion: string read FProductVersion;
   property Comments: string read FComments;
 end;

procedure Register;

implementation
uses dialogs;

procedure Register;
begin
 RegisterComponents('BBIC', [TgsFVersion]);
end;

procedure TgsFVersion.ClearAll;
begin
 FVersionInfoSize:= 0;
 FCompanyName := '';
 FFileDescription := '';
 FFileVersion := '';
 FInternalName := '';
 FLegalCopyright := '';
 FOriginalFilename := '';
 FProductName := '';
 FProductVersion := '';
 FComments := '';
end;

function TgsFVersion.GetBuildOnly: string;
var p: integer;
   s: string;
begin
 s := FileVersion;
 p := LastDelimiter('.',s);
 Result := copy(s,p+1,length(s)-p);
end;

procedure TgsFVersion.LoadFromFile;
var VISize:   cardinal;
   VIBuff:   pointer;
   trans:    pointer;
   buffsize: cardinal;
   temp: integer;
   str: pchar;
   LangCharSet: string;

 function GetStringValue(const From: string): string;
 begin
   VerQueryValue(VIBuff,pchar('\StringFileInfo\'+LanguageInfo+'\'+From), pointer(str),
                 buffsize);
   if buffsize > 0 then Result := str else Result := 'n/a';
 end;

begin
 ClearAll;
 VIBuff := nil;
 if not fileexists(Filename) then raise EFilerError.Create('File not found: '+Filename);
 VISize := GetFileVersionInfoSize(pchar(Filename),buffsize);
 FVersionInfoSize := VISize;
 if VISize < 1 then raise EReadError.Create('Invalid version info record in file '+Filename);
 VIBuff := AllocMem(VISize);
 GetFileVersionInfo(pchar(Filename),cardinal(0),VISize,VIBuff);

 VerQueryValue(VIBuff,'\VarFileInfo\Translation',Trans,buffsize);
 if buffsize >= 4 then
 begin
   temp:=0;
   StrLCopy(@temp, pchar(Trans), 2);
   LangCharSet:=IntToHex(temp, 4);
   StrLCopy(@temp, pchar(Trans)+2, 2);
   FLanguageInfo := LangCharSet+IntToHex(temp, 4);
 end else raise EReadError.Create('Invalid language info in file '+Filename);

 FCompanyName := GetStringValue('CompanyName');
 FFileDescription := GetStringValue('FileDescription');
 FFileVersion := GetStringValue('FileVersion');
 FInternalName := GetStringValue('InternalName');
 FLegalCopyright := GetStringValue('LegalCopyright');
 FOriginalFilename := GetStringValue('OriginalFilename');
 FProductName := GetStringValue('ProductName');
 FProductVersion := GetStringValue('ProductVersion');
 FComments := GetStringValue('Comments');

 FreeMem(VIBuff,VISize);
end;

procedure TgsFVersion.SetFilename(const Value: TFilename);
begin
 FFilename := Value;
 LoadFromFile;
end;

end.



---

begin...end   (2005-12-15 09:20:00) [3]

К [2]: ошибся, имел в виду Get FileVersionInfoSize и Get FileVersionInfo.

Впрочем, в [1] уже всё написано.
:-)

---

begin...end   (2005-12-15 09:19:00) [4]

> Alex_1234 ©   (15.12.05 09:07)

> На ней Label с текстом:Версия № 3.0.0.23
> где 23 берется из "Project"-"Options" вкладка "Version info".

См. API-функции: GetVersionInfoSize -> GetVersionInfo -> VerQueryValue.

> А еще хочется, что бы "Build" само увеличивалось на еденицу
> при каждой компиляции проекта....

См. настройки проекта: Project -> Options -> Version Info -> Auto-increment build number. Только номер будет увеличиваться не при компиляции, а при очередной сборке (build).

---

Rouse_   (2005-12-15 09:18:00) [5]

Автоинкремент при билде галочку включи...
А версию брать вот так:
function CurrentVersion: String;
var
 VerInfoSize, Dummy: DWORD;
 PVerBbuff, PFixed : Pointer;
 FlName : PChar;
 FixLength : UINT;
 FVersionMS : Cardinal;
 FVersionLS : Cardinal;
begin
 Result := '';
 FlName := PChar(Application.ExeName);
 VerInfoSize := GetFileVersionInfoSize(FlName, Dummy);
 if VerInfoSize = 0 then Exit;
 GetMem(PVerBbuff, VerInfoSize);
 try
   if GetFileVersionInfo(FlName, 0, VerInfoSize, PVerBbuff) then
   begin
     if VerQueryValue(PVerBbuff, '\', PFixed, FixLength) then
     begin
       FVersionMS := PVSFixedFileInfo(PFixed)^.dwFileVersionMS;
       FVersionLS := PVSFixedFileInfo(PFixed)^.dwFileVersionLS;
       Result :=
         Format('%s %d.%d.%d.%d', [' Текущая версия: ', LongRec(FVersionMS).Hi,
         LongRec(FVersionMS).Lo, LongRec(FVersionLS).Hi, LongRec(FVersionLS).Lo]);
     end;
   end;
 finally
   FreeMem(PVerBbuff);
 end;
end;

---

Наверх