RAD Studio Версия exe

[Горячий шоколад]

При разработке ПО, включающее в себя несколько подпрограмм (в частности dll) бывает необходимо проверять версию подключенного плагина dll к основной программе. Для этого я использую функцию, представленную ниже в спойлере. Она очень простая, но в отличие от некоторых остальных выводит версии не exe файла, а именно версию dll, откуда запрашивается функция.

Использование (параметры можно выводить не все): ShowMessage(GetVersion('%0:d %1:d %2:d %3:d %4:s'));

Спойлер: Source

unit NSGetVersion;

interface

uses
  Winapi.Windows,

  System.SysUtils,
  System.Classes;

function GetVersion(const AFormatString: string): string;

implementation

function GetVersion(const AFormatString: string): string;
type
  TVerInfo = packed record
    Arr: array [0 .. 47] of byte; // ненужные нам 48 байт
    Minor, Major, Build, Release: word; // а тут версия
  end;
var
  LStream: TResourceStream;
  LVersion: TVerInfo;
begin
  Result := '';
  try
    LStream := TResourceStream.Create(HInstance, '#1', RT_VERSION); // достаём ресурс
    if LStream.Size > 0 then
    begin
      LStream.Read(LVersion, SizeOf(LVersion)); // читаем нужные нам байты

      var LBuild := '' {$IFDEF WIN32} + '(x86)'{$ENDIF}
                       {$IFDEF WIN64} + '(x64)'{$ENDIF}
                       {$IFDEF DEBUG} + ' DEBUG'{$ENDIF};

      Result := Format(AFormatString, [LVersion.Major, LVersion.Minor, LVersion.Release, LVersion.Build, LBuild]);
    end;
    FreeAndNil(LStream);
  except
  end;
end;

end.

 

[FireWind]

Идея интересная, но не работающая (добавил в GetVersion вывод ошибки):

function GetVersion(const AFormatString: string): string;
type
  TVerInfo = packed record
    Arr: array [0 .. 47] of byte; // ненужные нам 48 байт
    Minor, Major, Build, Release: word; // а тут версия
  end;
var
  LStream: TResourceStream;
  LVersion: TVerInfo;
begin
  Result := '';
  try
    LStream := TResourceStream.Create(HInstance, '#1', RT_VERSION); // достаём ресурс
    if LStream.Size > 0 then
    begin
      LStream.Read(LVersion, SizeOf(LVersion)); // читаем нужные нам байты

      var LBuild := '' {$IFDEF WIN32} + '(x86)'{$ENDIF}
                       {$IFDEF WIN64} + '(x64)'{$ENDIF}
                       {$IFDEF DEBUG} + ' DEBUG'{$ENDIF};

      Result := Format(AFormatString, [LVersion.Major, LVersion.Minor, LVersion.Release, LVersion.Build, LBuild]);
    end;
    FreeAndNil(LStream);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end;

begin
  WriteLn(GetVersion('%d.%d.%d.%d %s'));
  readln;
end.

 

[Горячий шоколад]

но не работающая

Код был взят из реального моего проекта. Для работы я не указал, к сожалению, нужна включенная опция Version Info - Include version information in project. Если расчитывать на консольные приложения (в которых указанная опция по умолчанию отключена) можно обработать исключение (или включить опцию):

Спойлер: Source

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

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


function GetVersion(const AFormatString: string): string;
type
  TVerInfo = packed record
    Arr: array [0 .. 47] of byte; // ненужные нам 48 байт
    Minor, Major, Build, Release: word; // а тут версия
  end;
var
  LStream: TResourceStream;
  LVersion: TVerInfo;
begin
  Result := '';
  try
    LStream := TResourceStream.Create(HInstance, '#1', RT_VERSION); // достаём ресурс
    try
      if LStream.Size > 0 then
      begin
        LStream.Read(LVersion, SizeOf(LVersion)); // читаем нужные нам байты

        var LBuild := '' {$IFDEF WIN32} + '(x86)'{$ENDIF}
                         {$IFDEF WIN64} + '(x64)'{$ENDIF}
                         {$IFDEF DEBUG} + ' DEBUG'{$ENDIF};

        Result := Format(AFormatString, [LVersion.Major, LVersion.Minor, LVersion.Release, LVersion.Build, LBuild]);
      end;
    finally
      FreeAndNil(LStream);
    end;
  except
    on E: EResNotFound do
      Result := '';
  end;
end;

begin
  try
    WriteLn(GetVersion('%0:d %1:d %2:d %3:d %4:s'));
    ReadLn;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

 

[FireWind]

Код был взят из реального моего проекта. Для работы я не указал, к сожалению, нужна включенная опция Version Info - Include version information in project

Беру свои слова обратно я не внимательно посмотрел на ваш код. Добавил Version Info:


Если взять GetFileVersion из System.SysUtils и немного поменять результат, то функция будет более универсальной:

function GetFileVersion(const AFileName: string): String;
var
  FileName: string;
  InfoSize, Wnd: DWORD;
  VerBuf: Pointer;
  FI: PVSFixedFileInfo;
  VerSize: DWORD;
begin
  Result := '';
  FileName := AFileName;
  UniqueString(FileName);
  InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
  if InfoSize <> 0 then
  begin
    GetMem(VerBuf, InfoSize);
    try
      if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
        if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
          Result := Format('%d.%d.%d.%d', [HiWord(FI.dwFileVersionMS), LoWord(FI.dwFileVersionMS), HiWord(FI.dwFileVersionLS), LoWord(FI.dwFileVersionLS)])
    finally
      FreeMem(VerBuf);
    end;
  end;
end;

 

[Plomba]

Я использую так:

Function  TDM.GetFileVersion    (AFileName: UnicodeString): UnicodeString;
Var
  VerBlk          : VS_FIXEDFILEINFO;
  InfoSize, puLen : DWord;
  Pt, InfoPtr     : Pointer;
begin
  InfoSize := GetFileVersionInfoSize(PChar(AFilename), puLen);

  FillChar(VerBlk, SizeOf(VS_FIXEDFILEINFO),0);

  If InfoSize > 0 Then
  Begin
      GetMem(Pt, InfoSize);
      GetFileVersionInfo(PChar(AFilename), 0, InfoSize, Pt);
      VerQueryValue(Pt, '\', InfoPtr, puLen);
      Move(InfoPtr^, VerBlk, SizeOf(VS_FIXEDFILEINFO));

      Result := Format('%d.%d.%d.%d',[VerBlk.dwFileVersionMS shr 16,
                                      VerBlk.dwFileVersionMS and 65535,
                                      VerBlk.dwFileVersionLS shr 16,
                                      VerBlk.dwFileVersionLS and 65535]);
      FreeMem(Pt);
  End Else Result := '';
end;

 

[Plomba]

Тю, не обратил внимание, на то что такое уже есть