2009-11-11 5 views
25

Хотите получить Delphi номер сборки приложений и разместить в строке заголовкаКак определить Delphi Application Version

+3

Я вижу большинство предложенных ответов использовать GetFileVersion. Есть проблемы с этим вариантом, я разместил детали в своем ответе. –

ответ

2

От http://www.martinstoeckli.ch/delphi/delphi.html#AppVersion

С помощью этой функции вы можете получить версию файла, который содержит версию ресурс. Таким образом вы можете отобразить номер версии вашего приложения в информационном диалоговом окне. Чтобы включить ресурс версии в приложение Delphi, установите «Versioninfo» в параметрах проекта.

+7

Хорошая ссылка, но паршивый ответ.Просьба обобщить содержание ссылки: какое решение мы должны найти, следуя ссылке, и каковы важные функции, на которые следует обратить внимание? –

10

Передайте полное имя вашего EXE этой функции, и оно вернет строку, например: 2.1.5.9, или любую вашу версию #.

function GetFileVersion(exeName : string): string; 
const 
    c_StringInfo = 'StringFileInfo\040904E4\FileVersion'; 
var 
    n, Len : cardinal; 
    Buf, Value : PChar; 
begin 
    Result := ''; 
    n := GetFileVersionInfoSize(PChar(exeName),n); 
    if n > 0 then begin 
    Buf := AllocMem(n); 
    try 
     GetFileVersionInfo(PChar(exeName),0,n,Buf); 
     if VerQueryValue(Buf,PChar(c_StringInfo),Pointer(Value),Len) then begin 
     Result := Trim(Value); 
     end; 
    finally 
     FreeMem(Buf,n); 
    end; 
    end; 
end; 

После определения того, вы можете использовать его, чтобы установить заголовок вашей формы, как так:

procedure TForm1.FormShow(Sender: TObject); 
begin 
    //ParamStr(0) is the full path and file name of the current application 
    Form1.Caption := Form1.Caption + ' version ' + GetFileVersion(ParamStr(0)); 
end; 
+2

Джозеф, вы должны защитить свой AllocMem с помощью попытки ... наконец –

+0

Правильно, вы сделали. – JosephStyons

+0

Джозеф, ваша версия не работает в Delphi 2007. – Wodzu

23

Вот как я это делаю. Я положил это в почти всех моих небольших утилит:

procedure GetBuildInfo(var V1, V2, V3, V4: word); 
var 
    VerInfoSize, VerValueSize, Dummy: DWORD; 
    VerInfo: Pointer; 
    VerValue: PVSFixedFileInfo; 
begin 
    VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy); 
    if VerInfoSize > 0 then 
    begin 
     GetMem(VerInfo, VerInfoSize); 
     try 
     if GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo) then 
     begin 
      VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); 
      with VerValue^ do 
      begin 
      V1 := dwFileVersionMS shr 16; 
      V2 := dwFileVersionMS and $FFFF; 
      V3 := dwFileVersionLS shr 16; 
      V4 := dwFileVersionLS and $FFFF; 
      end; 
     end; 
     finally 
     FreeMem(VerInfo, VerInfoSize); 
     end; 
    end; 
end; 

function GetBuildInfoAsString: string; 
var 
    V1, V2, V3, V4: word; 
begin 
    GetBuildInfo(V1, V2, V3, V4); 
    Result := IntToStr(V1) + '.' + IntToStr(V2) + '.' + 
    IntToStr(V3) + '.' + IntToStr(V4); 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    Form1.Caption := Form1.Caption + ' - v' + GetBuildInfoAsString; 
end; 
+0

Это очень хорошо – JosephStyons

+1

Мик, вы должны проверить вернувшийся VerInfoSize, как и Джозеф, и продолжать преследовать if> 0, так как у него может не быть информации о версии файла. –

+1

Попробуйте ... наконец, не будет плохо для GetMem/FreeMem –

21

я наиболее настоятельно рекомендуем не использовать GetFileVersion, если вы хотите узнать версию исполняемого файла, который в настоящее время работает! У меня есть две очень веские причины, чтобы сделать это:

  1. Исполняемый могут быть недоступны (отключенный диск/акция), или изменить (.exe переименован в .bak и заменен на новый EXE-файл без запущенного процесса остановки).
  2. Данные версии, которые вы пытаетесь прочитать, на самом деле уже загружены в память и доступны вам при загрузке этого ресурса, что всегда лучше, чем выполнять дополнительные (относительно медленные) операции с дисками.

Чтобы загрузить версию ресурса в Delphi Я использую такой код:

uses Windows,Classes,SysUtils; 
var 
    verblock:PVSFIXEDFILEINFO; 
    versionMS,versionLS:cardinal; 
    verlen:cardinal; 
    rs:TResourceStream; 
    m:TMemoryStream; 
    p:pointer; 
    s:cardinal; 
begin 
    m:=TMemoryStream.Create; 
    try 
    rs:=TResourceStream.CreateFromID(HInstance,1,RT_VERSION); 
    try 
     m.CopyFrom(rs,rs.Size); 
    finally 
     rs.Free; 
    end; 
    m.Position:=0; 
    if VerQueryValue(m.Memory,'\',pointer(verblock),verlen) then 
     begin 
     VersionMS:=verblock.dwFileVersionMS; 
     VersionLS:=verblock.dwFileVersionLS; 
     AppVersionString:=Application.Title+' '+ 
      IntToStr(versionMS shr 16)+'.'+ 
      IntToStr(versionMS and $FFFF)+'.'+ 
      IntToStr(VersionLS shr 16)+'.'+ 
      IntToStr(VersionLS and $FFFF); 
     end; 
    if VerQueryValue(m.Memory,PChar('\\StringFileInfo\\'+ 
     IntToHex(GetThreadLocale,4)+IntToHex(GetACP,4)+'\\FileDescription'),p,s) or 
     VerQueryValue(m.Memory,'\\StringFileInfo\\040904E4\\FileDescription',p,s) then //en-us 
      AppVersionString:=PChar(p)+' '+AppVersionString; 
    finally 
    m.Free; 
    end; 
end; 
+0

Я проголосую за это, если вы сделаете код безопасным с точки зрения памяти и распределения ресурсов. – mghie

+1

Я добавил try-finally, должен сделать трюк. В случае, если вам интересно, что TMemoryStream для: VerQueryValue не удалось прочитать из каталога rs.Memory ... –

+0

Если ресурсы были такими, как они были в мои дни API, они еще не в памяти, а извлечены из файла. Кроме того, было бы необычно делать подкачку под приложением, поэтому я не думаю, что это стоит беспокоиться о большинстве людей. – mj2008

1

Мы делаем это для всех наших приложений, но мы используем Raize компонент RzVersioninfo. работает достаточно хорошо просто нужно использовать следующий код

на форме создания

Caption: = RzVersioninfo1.filedescripion + ':' + RzVersionInfo1.FileVersion;

Очевидно, что если вы не хотите, чтобы какой-либо из других компонентов из рейза использовал один из вышеперечисленных вариантов, так как стоимость компонентов увеличивается.

7

Благодаря сообщениям выше, я создал свою собственную библиотеку для этой цели.

Я считаю, что это немного более правильно, чем все другие решения здесь, так что я разделяю его - не стесняйтесь использовать его ...

unit KkVersion; 

interface 

function FileDescription: String; 
function LegalCopyright: String; 
function DateOfRelease: String; // Proprietary 
function ProductVersion: String; 
function FileVersion: String; 

implementation 

uses 
    Winapi.Windows, System.SysUtils, System.Classes, Math; 

(* 
    function GetHeader(out AHdr: TVSFixedFileInfo): Boolean; 

    var 
    BFixedFileInfo: PVSFixedFileInfo; 
    RM: TMemoryStream; 
    RS: TResourceStream; 
    BL: Cardinal; 

    begin 
    Result := False; 
    RM := TMemoryStream.Create; 
    try 
    RS := TResourceStream.CreateFromID(HInstance, 1, RT_VERSION); 
    try 
    RM.CopyFrom(RS, RS.Size); 
    finally 
    FreeAndNil(RS); 
    end; 

    // Extract header 
    if not VerQueryValue(RM.Memory, '\\', Pointer(BFixedFileInfo), BL) then 
    Exit; 

    // Prepare result 
    CopyMemory(@AHdr, BFixedFileInfo, Math.Min(sizeof(AHdr), BL)); 
    Result := True; 
    finally 
    FreeAndNil(RM); 
    end; 
    end; 
*) 

function GetVersionInfo(AIdent: String): String; 

type 
    TLang = packed record 
    Lng, Page: WORD; 
    end; 

    TLangs = array [0 .. 10000] of TLang; 

    PLangs = ^TLangs; 

var 
    BLngs: PLangs; 
    BLngsCnt: Cardinal; 
    BLangId: String; 
    RM: TMemoryStream; 
    RS: TResourceStream; 
    BP: PChar; 
    BL: Cardinal; 
    BId: String; 

begin 
    // Assume error 
    Result := ''; 

    RM := TMemoryStream.Create; 
    try 
    // Load the version resource into memory 
    RS := TResourceStream.CreateFromID(HInstance, 1, RT_VERSION); 
    try 
     RM.CopyFrom(RS, RS.Size); 
    finally 
     FreeAndNil(RS); 
    end; 

    // Extract the translations list 
    if not VerQueryValue(RM.Memory, '\\VarFileInfo\\Translation', Pointer(BLngs), BL) then 
     Exit; // Failed to parse the translations table 
    BLngsCnt := BL div sizeof(TLang); 
    if BLngsCnt <= 0 then 
     Exit; // No translations available 

    // Use the first translation from the table (in most cases will be OK) 
    with BLngs[0] do 
     BLangId := IntToHex(Lng, 4) + IntToHex(Page, 4); 

    // Extract field by parameter 
    BId := '\\StringFileInfo\\' + BLangId + '\\' + AIdent; 
    if not VerQueryValue(RM.Memory, PChar(BId), Pointer(BP), BL) then 
     Exit; // No such field 

    // Prepare result 
    Result := BP; 
    finally 
    FreeAndNil(RM); 
    end; 
end; 

function FileDescription: String; 
begin 
    Result := GetVersionInfo('FileDescription'); 
end; 

function LegalCopyright: String; 
begin 
    Result := GetVersionInfo('LegalCopyright'); 
end; 

function DateOfRelease: String; 
begin 
    Result := GetVersionInfo('DateOfRelease'); 
end; 

function ProductVersion: String; 
begin 
    Result := GetVersionInfo('ProductVersion'); 
end; 

function FileVersion: String; 
begin 
    Result := GetVersionInfo('FileVersion'); 
end; 

end. 
+1

Спасибо. Я проголосовал за вас, потому что вы не попали в ловушку, предполагая, что локаль составляет 0409 долларов США (United States English). Это не на моем Delphi XE7, и я уверен, что большинство разработчиков Delphi – DaveBoltman

Смежные вопросы