バージョン情報取得についてさらに・・ (ID：15460)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

私も日本語環境でしか確認していませんがPEさんあげられたコードのような場合、
Office97等のDLL(言語がニュートラルとなっている)で言語情報の取得に失敗していました。
その為、先に述べたような処理を何処かで見つけて解決しました。
一部、省かしてもらいますが下記のような感じです。

function GetFileVersionInfoString(const FileName, KeyName: String): String;
var
  dwHandle, dwSize, dwLen: DWORD;
  pVerInfo, pLocale: Pointer;
  dwLCID: LCID;

function GetKeyRecord(LocaleID: LCID): String;
  var
    Buffer : Pointer;
    Mapping: String;
  begin
    Result := '';
    Buffer := nil;
    dwLen  := 0;
    Mapping:= Format('\StringFileInfo\%0.4x%0.4x\%s', [LOWORD(LocaleID), HIWORD(LocaleID), KeyName]);
    VerQueryValue(pVerInfo, PChar(Mapping), Buffer, dwLen);
    if (dwLen <> 0) then SetString(Result, PChar(Buffer), StrLen(PChar(Buffer)));
  end;

function UnknownLCIDAsString: String;
  var
    I, J: Integer;
    Buffer: String;
    wLng  : TLanguages;
    wCP   : TCodePages; // 自作クラス 生成時に EnumSystemCodePages を実行しリスト化
  begin
    Result:= '';
    wLng:= TLanguages.Create; // ロケール情報リスト作成
    wCP := TCodePages.Create; // コードページ情報リスト作成
    try
	    for I:= 0 to wCP.Count - 1 do
	      for J:= 0 to wLng.Count - 1 do
	      begin
	        Buffer:= GetKeyRecord(wCP.CodePageID[I] shl 16 or wLng.LocaleID[J]);
	        if (Buffer <> '') then
	        begin
	          Result:= Buffer;
	          Exit;
	        end;
	      end;
    finally
      wCP.Free;
      wLng.Free;
    end;
  end;

begin

//
  // バージョン情報リソース取得迄の処理がここに入ります
  //

// 言語情報の取得
  if VerQueryValue(pVerInfo, '\VarFileInfo\Translation', pLocale, dwLen) then
      CopyMemory(@dwLCID, pLocale, dwLen) else
      dwLCID:= 0;

// バージョン情報取得処理呼出
  if (dwLCID = 0) then
    Result:= UnknownLCIDAsString else
    Result:= GetKeyRecord(dwLCID);

//
  // 確保したメモリの後始末がここに入ります
  //

end;

後述ですが、PEさんのソースコードの戻り値の代入部分は間違いではないでしょうか？
コンパイラに怒られそうです。

>            tsStrings := TStringList.Create;
>            try
>              ExtractStrings(['.'], [], pRead, tsStrings);
>              Result := pRead; //← ここ
>            finally
>              tsStrings.Free;
>            end;

←解決時は質問者本人がここをチェックしてください。

戻る