Форум: "WinAPI";
Текущий архив: 2006.03.05;
Скачать: [xml.tar.bz2];
ВнизИнформация о версии в результирующем екзешнике... Найти похожие ветки
← →
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 вся ветка
Форум: "WinAPI";
Текущий архив: 2006.03.05;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.013 c