Delphi XE6でバージョン情報を取得, GetFileVersionInfo

Delphi XE2に乗り換えてから、既存のコードでバージョン情報が取れなくなりました。気合を入れなおして、サンプルコードを探し出して修正しました。XE6でも動作確認取れました。

unit version;

interface

type
  TEXEVersionData = record
    CompanyName,
    FileDescription,
    FileVersion,
    InternalName,
    LegalCopyright,
    LegalTrademarks,
    OriginalFileName,
    ProductName,
    ProductVersion,
    Comments,
    PrivateBuild,
    SpecialBuild: string;
  end;

var
  theVersion: TEXEVersionData;

implementation

uses Windows, SysUtils, Forms;

procedure LoadVersionInfo;
type
  PLandCodepage = ^TLandCodepage;
  TLandCodepage = record
    wLanguage,
    wCodePage: word;
  end;
var
  dummy,
  len: cardinal;
  buf, pntr: pointer;
  lang, key: string;
begin
  len := GetFileVersionInfoSize(PChar(Application.ExeName), dummy);
  if len = 0 then
    RaiseLastOSError;
  GetMem(buf, len);
  try
    if not GetFileVersionInfo(PChar(Application.ExeName), 0, len, buf) then
      RaiseLastOSError;

    if not VerQueryValue(buf, '\VarFileInfo\Translation\', pntr, len) then
      RaiseLastOSError;

    lang := Format('%.4x%.4x', [PLandCodepage(pntr)^.wLanguage, PLandCodepage(pntr)^.wCodePage]);

    key := '\StringFileInfo\' + lang + '\CompanyName';
    if VerQueryValue(buf, PChar(Key), pntr, len) then
      theVersion.CompanyName := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\FileDescription';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.FileDescription := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\FileVersion';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.FileVersion := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\InternalName';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.InternalName := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\LegalCopyright';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.LegalCopyright := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\LegalTrademarks';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.LegalTrademarks := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\OriginalFileName';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.OriginalFileName := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\ProductName';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.ProductName := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\ProductVersion';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.ProductVersion := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\Comments';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.Comments := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\PrivateBuild';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.PrivateBuild := PChar(pntr);
    key := '\StringFileInfo\' + lang + '\SpecialBuild';
    if VerQueryValue(buf, PChar(key), pntr, len) then
      theVersion.SpecialBuild := PChar(pntr);
  finally
    FreeMem(buf);
  end;
end;

initialization
  LoadVersionInfo;

end.