How to retrieve the version stamp of a file

Problem/Question/Abstract:

How do you retrieve the version stamp of a file? I'm getting real tired of setting versions in the Delphi Project | Options dialog box and then defining a (redundant) constant for use in my Help | About boxes !

Answer:

Solve 1:

procedure TfrmSplash.GetBuildInfo(var v1, v2, v3, v4: Word);
var
  VerInfoSize: DWord;
  VerInfo: Pointer;
  VerValueSize: DWord;
  VerValue: PVSFixedFileInfo;
  Dummy: DWord;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName), dummy);
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(Application.ExeName), 0, VerInfoSize, VerInfo);
  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;
  FreeMem(VerInfo, VerInfoSize);
end;

function TfrmSplash.GetBuildInfoString: string;
var
  v1, v2, v3, v4: Word;
begin
  GetBuildInfo(v1, v2, v3, v4);
  Result := Format('%d.%d.%d  (Build %d)', [v1, v2, v3, v4]);
end;


Solve 2:

This function should do it.

uses
  Windows, SysUtils, { ... };

function GetFileVersion(const Filename: string): string;
var
  VerInfSize, Sz: Cardinal;
  VerInfo: Pointer;
  FxFileInfo: PVSFixedFileInfo;

  function MSLSToString(MS, LS: DWORD): string;
  begin
    Result := Format('%d.%d.%d.%d', [MS shr 16, MS and $FFFF, LS shr 16, LS and
      $FFFF]);
  end;

begin
  Result := '';
  if FileExists(Filename) then
  begin
    VerInfSize := GetFileVersionInfoSize(PCHAR(Filename), Sz);
    if VerInfSize > 0 then
    begin
      VerInfo := Allocmem(VerInfSize);
      try
        GetFileVersionInfo(PCHAR(Filename), 0, VerInfSize, VerInfo);
        VerQueryValue(VerInfo, '\\', POINTER(FxFileInfo), Sz);
        if Sz > 0 then
          Result := MSLSToString(FxFileInfo^.dwFileVersionMS,
            FxFileInfo^.dwFileVersionLS);
      finally
        FreeMem(VerInfo);
      end;
    end;
  end;
end;


Solve 3:

type
  TFileVersionInfo = record
    fCompanyName,
      fFileDescription,
      fFileVersion,
      fInternalName,
      fLegalCopyRight,
      fLegalTradeMark,
      fOriginalFileName,
      fProductName,
      fProductVersion,
      fComments: string;
  end;

var
  FileVersionInfo: TFileVersionInfo

procedure GetAllFileVersionInfo(FileName: string);
{ proc to get all version info from a file. }
var
  Buf: PChar;
  fInfoSize: DWord;

  procedure InitVersion;
  var
    FileNamePtr: PChar;
  begin
    with FileVersionInfo do
    begin
      FileNamePtr := PChar(FileName);
      fInfoSize := GetFileVersionInfoSize(FileNamePtr, fInfoSize);
      if fInfoSize > 0 then
      begin
        ReAllocMem(Buf, fInfoSize);
        GetFileVersionInfo(FileNamePtr, 0, fInfoSize, Buf);
      end;
    end;
  end;

  function GetVersion(What: string): string;
  var
    tmpVersion: string;
    Len: Dword;
    Value: PChar;
  begin
    Result := 'Not defined';
    if fInfoSize > 0 then
    begin
      SetLength(tmpVersion, 200);
      Value := @tmpVersion;
      { If you are not using an English OS, then replace the language and
                        codepage identifier with the correct one. English (U.S.) is 0409 (language)
                        and 04E4 (codepage). See CodePage Identifiers and Language Identifiers in
                        the Win32 help file for info. }
      if VerQueryValue(Buf, PChar('StringFileInfo\040904E4\' + What), Pointer(Value),
        Len) then
        Result := Value;
    end;
  end;

begin
  Buf := nil;
  with FileVersionInfo do
  begin
    InitVersion;
    fCompanyName := GetVersion('CompanyName');
    fFileDescription := GetVersion('FileDescription');
    fFileVersion := GetVersion('FileVersion');
    fInternalName := GetVersion('InternalName');
    fLegalCopyRight := GetVersion('LegalCopyRight');
    fLegalTradeMark := GetVersion('LegalTradeMark');
    fOriginalFileName := GetVersion('OriginalFileName');
    fProductName := GetVersion('ProductName');
    fProductVersion := GetVersion('ProductVersion');
    fComments := GetVersion('Comments');
  end;
  if Buf <> nil then
    FreeMem(Buf);
end;

To use it just call it like

GetAllFileVersionInfo(ParamStr(0));


Solve 4:

Call GetVersionDetails and specify the filename.

{ ... }

type
  pTransArrar = ^TTransArrar;
  TTransArrar = record
    wLanugageID: Word;
    wCharacterSet: Word;
  end;

function DecodeTranslationInfo(Buffer: TTransArrar): string;
begin
  Result := IntToHex(Buffer.wLanugageID, 4) + IntToHex(Buffer.wCharacterSet, 4);
end;

function GetVersionDetails(Filename: string; const LookupString: string =
  'FileVersion'): string;
var
  ID: DWord;
  iStructSize: DWord;
  p: PChar;
  pbuf: Pointer;
  plen: DWord;
  ResponseString: string;
begin
  {get the size of the fileinfo structure}
  iStructSize := GetFileVersionInfoSize(PChar(Filename), ID);
  {allocate memory to hold file info data structure}
  p := stralloc(iStructSize);
  {retrieve file version details}
  ResponseString := '';
  if GetFileVersionInfo(PChar(Filename), 0, istructSize, p) then
  begin
    if VerQueryValue(p, pchar('\VarFileInfo\Translation'), pbuf, plen) then
    begin
      if VerQueryValue(p, pchar('\StringFileInfo\' +
        DecodeTranslationInfo(pTransArrar(pbuf)^)
        + '\' + LookupString), pbuf, plen) then
        ResponseString := PChar(pbuf);
    end;
  end;
  strdispose(p);
  Result := ResponseString;
end;


Solve 5:

This functions returns the version as a string.

function GetFileVersion(FileName: string): string;
var
  ResourceSize: Integer;
  ResourceBuffer: PChar;
  GetData: Boolean;
  Ignore: THandle;
  InfoPtr: Pointer;
  VerSize: Cardinal;
  FileInfo: VS_FIXEDFILEINFO;
  Major, Minor, Rleas, Build, Hex: string;
begin
  ResourceSize := GetFileVersionInfoSize(PChar(FileName), Ignore);
  if ResourceSize > 0 then
  begin
    {You need to allocate the ResourceBuffer before you can fillchar it}
    GetMem(ResourceBuffer, ResourceSize);
    GetData := GetFileVersionInfo(PChar(FileName), Ignore, ResourceSize,
      ResourceBuffer);
    if GetData then
    begin
      GetData := VerQueryValue(ResourceBuffer, '\', InfoPtr, VerSize);
      if GetData then
      begin
        Move(InfoPtr^, FileInfo, sizeof(VS_FIXEDFILEINFO));
        Hex := IntToHex(FileInfo.dwFileVersionMS, 8) +
          IntToHex(FileInfo.dwFileVersionLS, 8);
        Major := '$' + Copy(Hex, 1, 4);
        Minor := '$' + Copy(Hex, 5, 4);
        Rleas := '$' + Copy(Hex, 9, 4);
        Build := '$' + Copy(Hex, 13, 4);
        Result := IntToStr(StrToInt(Major)) + '.' + IntToStr(StrToInt(Minor)) + '.'
          + IntToStr(StrToInt(Rleas)) + '.' + IntToStr(StrToInt(Build));
      end
      else
      begin
        Result := '';
      end;
    end
    else
    begin
      Result := '';
    end;
    {need this because you allocated it up above}
    FreeMem(ResourceBuffer);
  end
  else
  begin
    Result := '';
  end;
end;