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

Вниз

Информация о версии в результирующем екзешнике...   Найти похожие ветки 

← →
Alex_1234 ©   (2005-12-15 09:07) [0]

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

---

← →
Rouse_ ©   (2005-12-15 09:18) [1]

Автоинкремент при билде галочку включи...
А версию брать вот так:
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;

---

← →
begin...end ©   (2005-12-15 09:19) [2]

> 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).

---

← →
begin...end ©   (2005-12-15 09:20) [3]

К [2]: ошибся, имел в виду GetFileVersionInfoSize и GetFileVersionInfo.

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

---

← →
zorik ©   (2005-12-15 09:24) [4]

<<А еще хочется, что бы "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.



---

← →
Alex_1234 ©   (2005-12-15 09:45) [5]

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

---

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

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

Наверх

Память: 0.49 MB
Время: 0.049 c