バージョン情報を取得する（RTTI使ってみた）

バージョン情報を取得する処理を書いてみました。
RTTIを使う為に バージョン情報を保持するクラスを作ってます。
RTTIはフィールドというかプロパティに対するアクセスしかしてませんが、中々面白いですね。プロパティへのアクセスをループで回せるので処理をコンパクトに出来ました。

uses Classes, StrUtils, Types, Windows, SysUtils, Rtti;

type
  TVersionInfo = class
  private
    FComments: String;
    FInternalName: String;
    FProductName: String;
    FCompanyName: String;
    FLegalCopyright: String;
    FProductVersion: String;
    FFileDescription: String;
    FLegalTrademarks: String;
    FPrivateBuild: String;
    FFileVersion: String;
    FOriginalFilename: String;
    FSpecialBuild: String;

  public
    property Comments: String read FComments write FComments;
    property InternalName: String read FInternalName write FInternalName;
    property ProductName: String read FProductName write FProductName;
    property CompanyName: String read FCompanyName write FCompanyName;
    property LegalCopyright: String read FLegalCopyright write FLegalCopyright;
    property ProductVersion: String read FProductVersion write FProductVersion;
    property FileDescription: String read FFileDescription write FFileDescription;
    property LegalTrademarks: String read FLegalTrademarks write FLegalTrademarks;
    property PrivateBuild: String read FPrivateBuild write FPrivateBuild;
    property FileVersion: String read FFileVersion write FFileVersion;
    property OriginalFilename: String read FOriginalFilename write FOriginalFilename;
    property SpecialBuild: String read FSpecialBuild write FSpecialBuild;
  end;

// Name にバージョン情報を取得したいファイルのファイル名
// LangCode にロケールIDを指定する 日本語の場合は$0411
// バージョン情報の保持用クラス
function GetVersionResourceInfo(const Name: String; const LangCode: WORD;
  var VersionInfo: TVersionInfo): Boolean;

implementation

type
  PLangAndCodePage = ^TLangAndCodePage;
  TLangAndCodePage = record
    wLanguage: WORD;
    wCodePage: WORD;
  end;

function GetVersionResourceInfo(const Name: String; const LangCode: WORD;
  var VersionInfo: TVersionInfo): Boolean;
const
  CS_VERSION_RES: Array[0..11] of String = ('Comments','InternalName'
    ,'ProductName','CompanyName','LegalCopyright','ProductVersion'
    ,'FileDescription','LegalTrademarks','PrivateBuild','FileVersion:'
    ,'OriginalFilename','SpecialBuild');
var
  nSize, nRead: DWORD;
  pBuffer: PByte;
  pValue: PChar;
  pLang: Array of TLangAndCodePage;
  cbTranslate: Cardinal;
  I,J: Integer;
  SubBlock: String;

  LContext: TRttiContext;
  LClass: TRttiInstanceType;
  sVal: String;
begin
  Result := False;

  nSize := GetFileVersionInfoSize(PChar(Name), nSize);
  Language := 0;
  CodePage := 0;

  if nSize > 0 then
  begin
    pBuffer := AllocMem(nSize+1);
    try
      GetFileVersionInfo(PChar(Name), 0, nSize, pBuffer);
      VerQueryValue(pBuffer, '\VarFileInfo\Translation', Pointer(pLang), &cbTranslate);
      for I := 0 to cbTranslate div SizeOf(TLangAndCodePage) - 1 do
      begin
        if pLang[I].wLanguage = LangCode then
        begin
          LContext := TRttiContext.Create;
          LClass := LContext.GetType(TVersionInfo) as TRttiInstanceType;

          for J := Low(CS_VERSION_RES) to High(CS_VERSION_RES) do
          begin
            SubBlock := Format('StringFileInfo\%.4x%.4x\%s'
              , [pLang[I].wLanguage, pLang[I].wCodePage, CS_VERSION_RES[J]]);
            if VerQueryValue(pBuffer, PChar(SubBlock), Pointer(pValue), nRead) then
            begin
              if nRead > 0 then
              begin
                sVal := AnsiLeftStr(pValue, nRead);
                LClass.GetProperty(CS_VERSION_RES[J]).SetValue(VersionInfo, sVal);
              end;
            end;
          end;
          FreeAndNil(LClass);
          LContext.Free;

          Result := True;
      end;
    finally
      FreeMem(pBuffer, nSize);
    end;
  end;
end;